Cleanup internal functions

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.9000
+Version: 2.7.22
 Authors@R: c(
     person("Laura", "DeCicco", role = c("aut","cre"),
             email = "[email protected]",
@@ -29,7 +29,7 @@ Authors@R: c(
     person("Joeseph", "Zemmels", role="ctb",
             email = "[email protected]",
             comment=c(ORCID = "0009-0008-1463-6313")),
-    person("Elise", "Hinman", role="ctb",
+    person("Elise", "Hinman", role="aut",
             email = "[email protected]",
             comment=c(ORCID = "0000-0001-5396-1583")),  
     person("Michael", "Mahoney", role="ctb",

NEWS

@@ -3,8 +3,10 @@ dataRetrieval 2.7.22
 * Added read_waterdata_latest_daily to access latest daily USGS water data.
 * Added read_waterdata_continuous to access continuous USGS water data.
 * Added state_name and hydrologic_unit_code to read_waterdata_ts_meta
-* Removed daily_id from read_waterdata_daily output. Currently it
-is not stable over time. 
+* Removed daily_id from read_waterdata_daily output since it
+is not stable over time. Moved other "id" columns to end of returned data frames.
+* Changed examples for stateCd, countyCd, and parameterCdFile. Users are
+encouraged to migreate to the "read_waterdata_metadata" functions.
 
 dataRetrieval 2.7.21
 ===================

R/AAA.R

@@ -12,7 +12,8 @@ pkg.env <- new.env()
                "continuous")
   collections <- c("parameter-codes", "agency-codes", "altitude-datums", "aquifer-codes",
                    "aquifer-types", "coordinate-accuracy-codes", "coordinate-datum-codes",
-                   "coordinate-method-codes", "medium-codes", 
+                   "coordinate-method-codes", "medium-codes", "counties",
+                   "hydrologic-unit-codes", "states",
                    "national-aquifer-codes", "reliability-codes", "site-types", "statistic-codes",
                    "topographic-codes", "time-zone-codes")
 

R/construct_api_requests.R

@@ -109,6 +109,17 @@ construct_api_requests <- function(service,
   }
 
   if(!all(is.na(properties))){
+    available_properties <- property_list[[service]]
+
+    if(!all(properties %in% available_properties)){
+      # Check again:
+      schema <- check_OGC_requests(endpoint = service, type = "schema")
+      properties_fresh <- names(schema$properties)
+      if(!all(properties %in% properties_fresh)){
+        stop("Invalid properties requested.")
+      }
+    }
+
     baseURL <- httr2::req_url_query(baseURL,
                                     properties = properties,
                                     .multi = "comma")    
@@ -209,74 +220,94 @@ switch_arg_id <- function(ls, id_name, service){
 
 #' Switch properties id
 #' 
+#' If a user asks for either "id" or "output_id", it is only included in the 
+#' properties if that's the only column requested. "id" will always come back,
+#' so it is not needed in the properties call.
+#' 
 #' @noRd
 #' @return list
 #' @examples
 #' 
 #' properties <- c("id", "state_name", "country_name")
 #' dataRetrieval:::switch_properties_id(properties, 
-#'                               id_name = "monitoring_location_id",
-#'                               service = "monitoring-locations")
+#'                               id = "monitoring_location_id")
 #'                               
 #' properties2 <- c("monitoring_location_id", "state_name", "country_name")
 #' dataRetrieval:::switch_properties_id(properties2, 
-#'                               id_name = "monitoring_location_id",
-#'                               service = "monitoring-locations")
+#'                               id = "monitoring_location_id")
 #'                               
 #' properties3 <- c("monitoring_locations_id", "state_name", "country_name")
 #' dataRetrieval:::switch_properties_id(properties3, 
-#'                               id_name = "monitoring_location_id",
-#'                               service = "monitoring-locations")
-switch_properties_id <- function(properties, id_name, service){
-
-  service_id <- paste0(gsub("-", "_", service), "_id")
-
-  last_letter <- substr(service, nchar(service), nchar(service))
-  if(last_letter == "s"){
-    service_singluar <- substr(service,1, nchar(service)-1)
-    service_id_singular <- paste0(gsub("-", "_", service_singluar), "_id")
-  } else {
-    service_id_singular <- ""
-  }
-
-  if(!"id" %in% properties){
-    if(service_id %in% properties){
-      properties[properties == service_id] <- "id"
-
-    } else if(service_id_singular %in% properties) {
-      properties[properties == service_id_singular] <- "id"
-    } else {
-      properties[properties == id_name] <- "id"
-    }
-  }
+#'                               id = "monitoring_location_id")
+#'                               
+#' properties4 <- c("monitoring_location_id")
+#' dataRetrieval:::switch_properties_id(properties4, 
+#'                               id = "monitoring_location_id")
+#'                               
+#' properties5 <- c("monitoring_location_id", "geometry")
+#' dataRetrieval:::switch_properties_id(properties5, 
+#'                               id = "monitoring_location_id")
+#'
+switch_properties_id <- function(properties, id){
 
+  orig_properties <- properties
   if(!all(is.na(properties))){
-
-    schema <- check_OGC_requests(endpoint = service,
-                                 type = "schema")
-    all_properties <- names(schema$properties)
-
-    if(all(all_properties[!all_properties %in% c("id", "geometry")] %in% properties)) {
-      # Cleans up URL if we're asking for everything
-      properties <- NA_character_
-    } else {
-      properties <- gsub("-", "_", properties)
-      properties <- properties[!properties %in% c("id", 
-                                                  "geometry",
-                                                  paste0(gsub("-", "_", service), "_id"))]
+    if("id" %in% properties){
+      properties <- properties[properties != "id"]
+    } else if (id %in% properties){
+      properties <- properties[properties != id]
+    }
 
+    if("geometry" %in% properties){
+      properties <- properties[properties != "geometry"]
     }
 
-    if(!all(is.na(properties))){
-      match.arg(properties, choices = all_properties,
-                several.ok = TRUE)    
+    if(length(properties) == 0){
+      # If a user requested only id and/or geometry, properties would now be empty
+      # geometry is taken care of with skipGeometry
+      properties <- "id"
     }
   }
 
   return(properties)
 }
 
 
+order_results <- function(df){
+
+  if(all(c("time", "monitoring_location_id") %in% names(df))){
+    df <- df[order(df$time, 
+                   df$monitoring_location_id), ]
+  } else if ("time" %in% names(df)) {
+    df <- df[order(df$time), ]    
+  }
+
+  return(df)
+}
+
+move_id_col <- function(df, output_id){
+  # attributes get dropped 
+  req <- attr(df, "request")
+  queryTime <- attr(df, "queryTime")
+
+  df <- df[, names(df)[names(df)!= output_id]]
+  if("time_series_id" %in% names(df)){
+    df <- df[, c(names(df)[names(df)!= "time_series_id"],
+                 "time_series_id")]
+  }
+
+  if("field_visit_id" %in% names(df)){
+    df <- df[, c(names(df)[names(df)!= "field_visit_id"],
+                 "field_visit_id")]
+  }
+
+  attr(df, "request") <- req
+  attr(df, "queryTime") <- queryTime
+
+  return(df)
+}
+
+
 #' Format the date request
 #' 
 #' Users will want to give either start/end dates or 
@@ -617,3 +648,30 @@ get_params <- function(service){
   params <- sapply(query_ret$properties, function(x) x[["description"]]) 
 
 }
+
+
+#' Get property list
+#' 
+#' This function gets a list of available properties, and
+#' renames the id column to what is used in dataRetrieval.
+#' 
+#' @param service Character, can be any of the endpoints
+#' @param output_id Character, dataRetrieval output name
+#' @return list
+#' @noRd
+#' @examplesIf is_dataRetrieval_user()
+#' 
+#' \donttest{
+#' dataRetrieval:::get_properties_for_docs("monitoring-locations",
+#'                                         "monitoring_location_id")
+#' 
+#' }
+#' 
+get_properties_for_docs <- function(service, output_id){
+
+  schema <- check_OGC_requests(endpoint = service, type = "schema")
+  properties <- names(schema$properties)
+  properties[properties == "id"] <- output_id
+  return(paste(properties, collapse = ", "))
+
+}

R/dataRetrievals-package.R

@@ -58,8 +58,13 @@ token_message)
 #'
 #' @docType data
 #' @export parameterCdFile
-#' @examples
-#' head(parameterCdFile[, 1:2])
+#' @examplesIf is_dataRetrieval_user()
+#' 
+#' \donttest{
+#' # Please migrate to:
+#' parameterCds <- read_waterdata_metadata("parameter-codes")
+#' 
+#' }
 NULL
 
 
@@ -113,8 +118,13 @@ NULL
 #' @docType data
 #' @export stateCd
 #' @keywords USGS stateCd
-#' @examples
-#' head(stateCd)
+#' @examplesIf is_dataRetrieval_user()
+#' 
+#' \donttest{
+#' # Please migrate to:
+#' stateCd <- read_waterdata_metadata("states")
+#' 
+#' }
 NULL
 
 #' US County Code Lookup Table
@@ -136,8 +146,13 @@ NULL
 #' @docType data
 #' @export countyCd
 #' @keywords USGS countyCd
-#' @examples
-#' head(countyCd)
+#' @examplesIf is_dataRetrieval_user()
+#' 
+#' \donttest{
+#' # Please migrate to:
+#' countyCd <- read_waterdata_metadata("counties")
+#' 
+#' }
 NULL
 
 # nolint start: commented_code_linter
@@ -190,4 +205,21 @@ NULL
 # 
 # save(countyCd, stateCd, parameterCdFile, pCodeToName,
 #      file = "R/sysdata.rda", compress = "xz")
-# nolint end
+# 
+# services <- c("daily", "time-series-metadata",
+#               "monitoring-locations", "latest-continuous",
+#               "field-measurements", "latest-daily",
+#               "continuous")
+# 
+# property_list <- list()
+# 
+# for(i in services){
+#   schema <- check_OGC_requests(endpoint = i, type = "schema")
+#   properties <- names(schema$properties)
+#   property_list[[i]] <- properties
+# }
+# rm(schema, i, services, properties)
+# save(countyCd, stateCd, parameterCdFile, pCodeToName, property_list, offsetLibrary,
+#      file = "R/sysdata.rda", compress = "xz")
+# 
+# # nolint end

R/readNWISunit.R

@@ -91,9 +91,9 @@ readNWISuv <- function(siteNumbers, parameterCd, startDate = "", endDate = "", t
     service <- "iv_recent"
   }
 
-  .Deprecated(new = "read_waterdata_continuous",
-              package = "dataRetrieval", 
-              msg = "NWIS servers are slated for decommission. Please begin to migrate to read_waterdata_continuous.")
+  # .Deprecated(new = "read_waterdata_continuous",
+  #             package = "dataRetrieval", 
+  #             msg = "NWIS servers are slated for decommission. Please begin to migrate to read_waterdata_continuous.")
 
 
   url <- constructNWISURL(siteNumbers,

R/read_waterdata_continuous.R

@@ -23,7 +23,8 @@
 #' Requesting anything else will most-likely cause a timeout. 
 #' @param properties A vector of requested columns to be returned from the query.
 #' Available options are: 
-#' `r schema <- check_OGC_requests(endpoint = "continuous", type = "schema"); paste(names(schema$properties)[!names(schema$properties) %in% c("id", "internal_id")], collapse = ", ")`
+#' `r dataRetrieval:::get_properties_for_docs("continuous", "continuous_id")`.
+#' The default (`NA`) will return all columns of the data.
 #' @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 50000. It may be beneficial to set this number lower if your internet
@@ -87,27 +88,12 @@ read_waterdata_continuous <- function(monitoring_location_id = NA_character_,
                               service)
 
   if(convertType){
-    return_list <- order_results(return_list, properties)
-    return_list <- return_list[, names(return_list)[names(return_list)!= output_id]]
-    if("time_series_id" %in% names(return_list)){
-      return_list <- return_list[, c( names(return_list)[names(return_list)!= "time_series_id"],
-                                      "time_series_id")]
-    }
+    return_list <- order_results(return_list)
+    return_list <- move_id_col(return_list, output_id)
   }
 
   return(return_list)
 }
 
-order_results <- function(return_list, properties){
-
-  if(all(is.na(properties)) | 
-                    all(c("time", "monitoring_location_id") %in% properties)){
-    return_list <- return_list[order(return_list$time, 
-                                     return_list$monitoring_location_id), ]
-  } else if ("time" %in% properties) {
-    return_list <- return_list[order(return_list$time), ]    
-  }
-
-  return(return_list)
-}
+
 

R/read_waterdata_daily.R

@@ -15,7 +15,8 @@
 #' @param qualifier `r get_params("daily")$qualifier`
 #' @param properties A vector of requested columns to be returned from the query.
 #' Available options are: 
-#' `r schema <- check_OGC_requests(endpoint = "daily", type = "schema"); paste(names(schema$properties)[!names(schema$properties) %in% c("id")], collapse = ", ")`
+#' `r dataRetrieval:::get_properties_for_docs("daily", "daily_id")`.
+#' The default (`NA`) will return all columns of the data.
 #' @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
@@ -93,12 +94,8 @@ read_waterdata_daily <- function(monitoring_location_id = NA_character_,
                               service)
 
   if(convertType){
-    return_list <- order_results(return_list, properties)
-    return_list <- return_list[,names(return_list)[names(return_list)!= output_id]]
-    if("time_series_id" %in% names(return_list)){
-      return_list <- return_list[, c( names(return_list)[names(return_list)!= "time_series_id"],
-                                      "time_series_id")]
-    }
+    return_list <- order_results(return_list)
+    return_list <- move_id_col(return_list, output_id)
   }
 
   return(return_list)