Skip to content

Commit 6bf0c01

Browse files
ldecicco-USGSldecicco-USGS
authored
Merge pull request #771 from ldecicco-USGS/develop
Develop
2 parents 839969f + 41d3e1c commit 6bf0c01

File tree

10 files changed

+119
-100
lines changed

10 files changed

+119
-100
lines changed

‎R/constructNWISURL.R‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -79,7 +79,7 @@ constructNWISURL <- function(siteNumbers,
7979
service[service == "meas"] <- "measurements"
8080
service[service == "uv"] <- "iv"
8181

82-
POST = nchar(paste0(siteNumbers, parameterCd, collapse = "")) > 2048
82+
POST <- nchar(paste0(siteNumbers, parameterCd, collapse = "")) > 2048
8383

8484
baseURL <- httr2::request(pkg.env[[service]])
8585

‎R/readNWISdata.R‎

Lines changed: 8 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -224,17 +224,20 @@ https://cran.r-project.org/web/packages/dataRetrieval/vignettes/qwdata_changes.h
224224
}
225225

226226
baseURL <- httr2::request(pkg.env[[service]])
227-
if (service != "rating") {
228-
baseURL <- httr2::req_url_query(baseURL,
229-
format = format)
230-
}
231-
POST = nchar(paste0(unlist(values), collapse = "")) > 2048
227+
228+
POST <- nchar(paste0(unlist(values), collapse = "")) > 2048
232229

233230
baseURL <- get_or_post(baseURL,
234231
POST = POST,
235232
!!!values,
236233
.multi = "comma")
237234

235+
if (service != "rating") {
236+
baseURL <- get_or_post(baseURL,
237+
POST = POST,
238+
format = format)
239+
}
240+
238241
if (length(grep("rdb", format)) > 0) {
239242
retval <- importRDB1(baseURL, tz = tz, asDateTime = asDateTime, convertType = convertType)
240243
} else {

‎R/readWQPdata.R‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -269,7 +269,7 @@ readWQPdata <- function(...,
269269
values <- valuesList[["values"]]
270270

271271
baseURL <- httr2::request(pkg.env[[service]])
272-
POST = FALSE
272+
POST <- FALSE
273273

274274
if(!legacy){
275275
if(service == "ResultWQX3" & !"dataProfile" %in% names(values)){
@@ -282,7 +282,7 @@ readWQPdata <- function(...,
282282
if("siteid" %in% names(values)){
283283
if(length(values[["siteid"]]) > 1){
284284
sites <- values[["siteid"]]
285-
POST = nchar(paste0(sites, collapse = "")) > 2048
285+
POST <- nchar(paste0(sites, collapse = "")) > 2048
286286

287287
baseURL <- get_or_post(baseURL,
288288
POST = POST,

‎R/read_USGS_samples.R‎

Lines changed: 93 additions & 82 deletions
Original file line numberDiff line numberDiff line change
@@ -97,35 +97,35 @@
9797
#'
9898
#' }
9999
construct_USGS_sample_request <- function(monitoringLocationIdentifier = NA,
100-
siteTypeCode = NA,
101-
boundingBox = NA,
102-
hydrologicUnit = NA,
103-
activityMediaName = NA,
104-
characteristicGroup = NA,
105-
characteristic = NA,
106-
characteristicUserSupplied = NA,
107-
activityStartDateLower = NA,
108-
activityStartDateUpper = NA,
109-
countryFips = NA,
110-
stateFips = NA,
111-
countyFips = NA,
112-
projectIdentifier = NA,
113-
recordIdentifierUserSupplied = NA,
114-
siteTypeName = NA,
115-
usgsPCode = NA,
116-
pointLocationLatitude = NA,
117-
pointLocationLongitude = NA,
118-
pointLocationWithinMiles = NA,
119-
dataType = "results",
120-
dataProfile = NA){
100+
siteTypeCode = NA,
101+
boundingBox = NA,
102+
hydrologicUnit = NA,
103+
activityMediaName = NA,
104+
characteristicGroup = NA,
105+
characteristic = NA,
106+
characteristicUserSupplied = NA,
107+
activityStartDateLower = NA,
108+
activityStartDateUpper = NA,
109+
countryFips = NA,
110+
stateFips = NA,
111+
countyFips = NA,
112+
projectIdentifier = NA,
113+
recordIdentifierUserSupplied = NA,
114+
siteTypeName = NA,
115+
usgsPCode = NA,
116+
pointLocationLatitude = NA,
117+
pointLocationLongitude = NA,
118+
pointLocationWithinMiles = NA,
119+
dataType = "results",
120+
dataProfile = NA){
121121

122122
dataType <- match.arg(dataType, c("results",
123-
"locations",
124-
"activities",
125-
"projects",
126-
"organizations"),
127-
several.ok = FALSE)
128-
123+
"locations",
124+
"activities",
125+
"projects",
126+
"organizations"),
127+
several.ok = FALSE)
128+
129129
baseURL <- httr2::request("https://api.waterdata.usgs.gov") |>
130130
httr2::req_url_path_append("samples-data") |>
131131
httr2::req_url_query(mimeType = "text/csv")
@@ -141,13 +141,13 @@ construct_USGS_sample_request <- function(monitoringLocationIdentifier = NA,
141141
},
142142
locations = {
143143
available_profiles <- c("site", "count")
144-
144+
145145
baseURL <- httr2::req_url_path_append(baseURL,
146146
"locations")
147147
},
148148
activities = {
149149
available_profiles <- c("sampact", "actmetric", "actgroup", "count")
150-
150+
151151
baseURL <- httr2::req_url_path_append(baseURL,
152152
"activities")
153153
},
@@ -159,56 +159,56 @@ construct_USGS_sample_request <- function(monitoringLocationIdentifier = NA,
159159
},
160160
organizations = {
161161
available_profiles <- c("organization", "count")
162-
162+
163163
baseURL <- httr2::req_url_path_append(baseURL,
164164
"organizations")
165165
})
166-
166+
167167
dataProfile <- check_profile(dataProfile, available_profiles)
168168
dataProfile <- match.arg(dataProfile,
169169
available_profiles,
170170
several.ok = FALSE)
171171

172172
baseURL <- httr2::req_url_path_append(baseURL,
173173
dataProfile)
174-
174+
175175

176176
if(all(!is.na(siteTypeCode))){
177177
siteTypeCode <- match.arg(siteTypeCode,
178-
check_param("sitetype")$typeCode,
179-
several.ok = TRUE)
178+
check_param("sitetype")$typeCode,
179+
several.ok = TRUE)
180180
}
181-
181+
182182
if(all(!is.na(activityMediaName))){
183183
activityMediaName <- match.arg(activityMediaName,
184-
check_param("samplemedia")$activityMedia,
185-
several.ok = TRUE)
184+
check_param("samplemedia")$activityMedia,
185+
several.ok = TRUE)
186186
}
187187

188188
if(all(!is.na(characteristicGroup))){
189189
characteristicGroup <- match.arg(characteristicGroup,
190-
check_param("characteristicgroup")$characteristicGroup,
191-
several.ok = TRUE)
190+
check_param("characteristicgroup")$characteristicGroup,
191+
several.ok = TRUE)
192192
}
193193

194194
if(all(!is.na(countryFips))){
195195
countryFips <- match.arg(countryFips,
196-
check_param("countries")$countryCode,
197-
several.ok = TRUE)
196+
check_param("countries")$countryCode,
197+
several.ok = TRUE)
198198
}
199199

200200
if(all(!is.na(siteTypeName))){
201201
siteTypeName <- match.arg(siteTypeName,
202-
check_param("sitetype")$typeLongName,
203-
several.ok = TRUE)
202+
check_param("sitetype")$typeLongName,
203+
several.ok = TRUE)
204204
}
205205

206206
if(all(!is.na(stateFips))){
207207
states <- check_param("states")
208208
state_codes <- paste(states$countryCode,
209209
states$fipsCode, sep = ":")
210210
stateFips <- match.arg(stateFips, state_codes,
211-
several.ok = TRUE)
211+
several.ok = TRUE)
212212
}
213213

214214
if(all(!is.na(countyFips))){
@@ -223,19 +223,19 @@ construct_USGS_sample_request <- function(monitoringLocationIdentifier = NA,
223223
counties$countyCode, sep = ":")
224224

225225
countyFips <- match.arg(countyFips, county_codes,
226-
several.ok = TRUE)
226+
several.ok = TRUE)
227227
}
228228

229229
check_radius <- sum(is.na(c(pointLocationLatitude,
230230
pointLocationLongitude,
231231
pointLocationWithinMiles)))
232232

233233
if(!check_radius %in% c(3, 0)){
234-
stop("pointLocationLatitude, pointLocationLongitude, and pointLocationWithinMiles
234+
stop("pointLocationLatitude, pointLocationLongitude, and pointLocationWithinMiles
235235
must all be defined, or none defined.")
236236
}
237237

238-
baseURL <- explode_query(baseURL,
238+
baseURL <- explode_query(baseURL, POST = FALSE,
239239
list(hydrologicUnit = hydrologicUnit,
240240
projectIdentifier = projectIdentifier,
241241
recordIdentifierUserSupplied = recordIdentifierUserSupplied,
@@ -254,7 +254,7 @@ construct_USGS_sample_request <- function(monitoringLocationIdentifier = NA,
254254
pointLocationLongitude = pointLocationLongitude,
255255
pointLocationWithinMiles = pointLocationWithinMiles
256256
))
257-
257+
258258
if(all(!is.na(activityStartDateLower))){
259259
start <- checkWQPdates(list(activityStartDateLower = activityStartDateLower))
260260
start <- as.character(as.Date(start$activityStartDateLower, format = "%m-%d-%Y"))
@@ -269,7 +269,7 @@ construct_USGS_sample_request <- function(monitoringLocationIdentifier = NA,
269269
activityStartDateUpper = end)
270270
}
271271

272-
272+
273273
if(all(!is.na(boundingBox))){
274274
baseURL <- httr2::req_url_query(baseURL,
275275
boundingBox = boundingBox,
@@ -292,17 +292,23 @@ check_profile <- function(dataProfile, profile_convert){
292292
return(dataProfile)
293293
}
294294

295-
explode_query <- function(baseURL, x){
295+
explode_query <- function(baseURL, POST = FALSE, x){
296296

297297
if(!is.list(x)){
298298
return(baseURL)
299299
}
300300

301301
if(any(!is.na(x))){
302302
x <- Filter(Negate(anyNA), x)
303-
baseURL <- httr2::req_url_query(baseURL,
304-
!!!x,
305-
.multi = "explode")
303+
if(POST){
304+
baseURL <- httr2::req_body_json(req = baseURL,
305+
data = x)
306+
} else {
307+
baseURL <- httr2::req_url_query(baseURL,
308+
!!!x,
309+
.multi = "explode")
310+
}
311+
306312
}
307313
return(baseURL)
308314
}
@@ -349,7 +355,7 @@ check_param <- function(service = "characteristicgroup",
349355
service) |>
350356
httr2::req_user_agent(default_ua()) |>
351357
httr2::req_url_query(mimeType = "application/json")
352-
358+
353359
if (length(list(...)) > 0) {
354360
params <- list(...)
355361
extra_params <- c("group", "pageNumber", "pageSize",
@@ -358,11 +364,13 @@ check_param <- function(service = "characteristicgroup",
358364
check_group_req <- httr2::req_url_query(check_group_req,
359365
!!!params)
360366
}
361-
367+
368+
message("GET: ", check_group_req$url)
369+
362370
check_group <- httr2::req_perform(check_group_req) |>
363371
httr2::resp_body_string() |>
364372
jsonlite::fromJSON()
365-
373+
366374
return(check_group$data)
367375

368376
}
@@ -378,6 +386,9 @@ check_param <- function(service = "characteristicgroup",
378386
#' Possible values include "America/New_York","America/Chicago", "America/Denver","America/Los_Angeles",
379387
#' "America/Anchorage","America/Honolulu","America/Jamaica","America/Managua",
380388
#' "America/Phoenix", and "America/Metlakatla"
389+
#' @param convertType logical, defaults to \code{TRUE}. If \code{TRUE}, the function
390+
#' will convert the data to dates, datetimes,
391+
#' numerics based on a standard algorithm. If false, everything is returned as a character.
381392
#' @export
382393
#'
383394
#' @examplesIf is_dataRetrieval_user()
@@ -401,28 +412,29 @@ check_param <- function(service = "characteristicgroup",
401412
#'
402413
#' }
403414
read_USGS_samples <- function(monitoringLocationIdentifier = NA,
404-
siteTypeCode = NA,
405-
boundingBox = NA,
406-
hydrologicUnit = NA,
407-
activityMediaName = NA,
408-
characteristicGroup = NA,
409-
characteristic = NA,
410-
characteristicUserSupplied = NA,
411-
activityStartDateLower = NA,
412-
activityStartDateUpper = NA,
413-
countryFips = NA,
414-
stateFips = NA,
415-
countyFips = NA,
416-
projectIdentifier = NA,
417-
recordIdentifierUserSupplied = NA,
418-
siteTypeName = NA,
419-
usgsPCode = NA,
420-
pointLocationLatitude = NA,
421-
pointLocationLongitude = NA,
422-
pointLocationWithinMiles = NA,
423-
dataType = "results",
424-
dataProfile = NA,
425-
tz = "UTC"){
415+
siteTypeCode = NA,
416+
boundingBox = NA,
417+
hydrologicUnit = NA,
418+
activityMediaName = NA,
419+
characteristicGroup = NA,
420+
characteristic = NA,
421+
characteristicUserSupplied = NA,
422+
activityStartDateLower = NA,
423+
activityStartDateUpper = NA,
424+
countryFips = NA,
425+
stateFips = NA,
426+
countyFips = NA,
427+
projectIdentifier = NA,
428+
recordIdentifierUserSupplied = NA,
429+
siteTypeName = NA,
430+
usgsPCode = NA,
431+
pointLocationLatitude = NA,
432+
pointLocationLongitude = NA,
433+
pointLocationWithinMiles = NA,
434+
dataType = "results",
435+
dataProfile = NA,
436+
tz = "UTC",
437+
convertType = TRUE){
426438

427439
request_url <- construct_USGS_sample_request(monitoringLocationIdentifier = monitoringLocationIdentifier,
428440
siteTypeCode = siteTypeCode,
@@ -446,8 +458,8 @@ read_USGS_samples <- function(monitoringLocationIdentifier = NA,
446458
pointLocationWithinMiles = pointLocationWithinMiles,
447459
dataType = dataType,
448460
dataProfile = dataProfile)
449-
450-
df <- importWQP(request_url, tz = tz)
461+
462+
df <- importWQP(request_url, tz = tz, convertType = convertType)
451463
attr(df, "url") <- request_url$url
452464
attr(df, "queryTime") <- Sys.time()
453465
return(df)
@@ -475,8 +487,7 @@ read_USGS_samples <- function(monitoringLocationIdentifier = NA,
475487
#'
476488
#' }
477489
summarize_USGS_samples <- function(monitoringLocationIdentifier){
478-
message("Function in development, use at your own risk.")
479-
490+
480491
if(length(monitoringLocationIdentifier) > 1){
481492
stop("Summary service only available for one site at a time.")
482493
}

‎R/whatNWISdata.R‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -143,7 +143,7 @@ whatNWISdata <- function(..., convertType = TRUE) {
143143
values <- valuesList[["values"]]
144144
values <- values[names(values) != "format"]
145145

146-
POST = nchar(paste0(unlist(values), collapse = "")) > 2048
146+
POST <- nchar(paste0(unlist(values), collapse = "")) > 2048
147147

148148
urlSitefile <- httr2::request(pkg.env[["site"]])
149149
urlSitefile <- get_or_post(urlSitefile,

‎R/whatNWISsites.R‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -68,7 +68,7 @@ whatNWISsites <- function(...) {
6868
values[["hasDataTypeCd"]] <- service
6969
}
7070

71-
POST = nchar(paste0(unlist(values), collapse = "")) > 2048
71+
POST <- nchar(paste0(unlist(values), collapse = "")) > 2048
7272

7373
urlCall <- httr2::request(pkg.env[["site"]])
7474

0 commit comments

Comments
 (0)