Maintenance scheduled for Thursday, November 21st at 15:00 MDT. Expected downtime <1 hour.

...
 
Commits (129)
^Meta$
^doc$
.Rhistory
vignettes/figures
appveyor.yml
......@@ -17,4 +19,17 @@ README.md
^\.Rproj\.travis.yml
^\.Rproj\appveyor.yml
CONDUCT.md
DISCLAIMER.md
code.json
docs
pkgdown
_pkgdown.yml
hexSticker.R
vignettes/earthquake.Rmd
vignettes/statsServiceMap.Rmd
vignettes/usMaps.Rmd
vignettes/usMaps_cache
vignettes/movingAverages.Rmd
man/figures/highrezlogo-01.png
man/figures/USGS_R.png
playing_with_post.R
Meta
doc
.Rproj.user
.Rhistory
.RData
.Ruserdata
dataRetrieval.Rproj
.gitignore
vignettes/usMaps_cache
......@@ -6,7 +6,7 @@
language: r
cache: packages
dist: trusty
dist: bionic
matrix:
include:
......@@ -23,20 +23,22 @@ addons:
env:
global:
- R_BUILD_ARGS="--no-build-vignettes --no-manual"
- R_CHECK_ARGS="--no-build-vignettes --no-manual --as-cran"
- NOT_CRAN="true"
- _R_CHECK_FORCE_SUGGESTS_=false
r_build_args: --no-build-vignettes --no-manual --no-resave-data
r_check_args: --no-build-vignettes --no-manual --as-cran
warnings_are_errors: true
r_github_packages:
- jimhester/covr
- tidyverse/readr
script:
- |
R CMD build .
travis_wait 20 R CMD check dataRetrieval*tar.gz
R CMD build .
travis_wait 60 R CMD check dataRetrieval*tar.gz --as-cran --run-donttest
r_github_packages:
- jimhester/covr
after_success:
- if [[ "${R_CODECOV}" ]]; then R -e 'covr::coveralls()'; fi
......
Package: dataRetrieval
Type: Package
Title: Retrieval Functions for USGS and EPA Hydrologic and Water Quality Data
Version: 2.7.4
Date: 2017-09-27
Authors@R: c(person("Robert", "Hirsch", role = c("aut"),
email = "rhirsch@usgs.gov"),
Version: 2.7.5
Authors@R: c(
person("Laura", "DeCicco", role = c("aut","cre"),
email = "ldecicco@usgs.gov"),
email = "ldecicco@usgs.gov",
comment=c(ORCID="0000-0002-3915-9487")),
person("Robert", "Hirsch", role = c("aut"),
email = "rhirsch@usgs.gov",
comment=c(ORCID="0000-0002-4534-075X")),
person("David","Lorenz", role=c("aut")),
person("Jordan", "Read", role = c("ctb"),
email = "jread@usgs.gov"),
......@@ -15,7 +17,8 @@ Authors@R: c(person("Robert", "Hirsch", role = c("aut"),
person("Lindsay","Carr", role=c("ctb"),
email = "lcarr@usgs.gov"),
person("David","Watkins", role=c("aut"),
email = "wwatkins@usgs.gov"))
email = "wwatkins@usgs.gov",
comment=c(ORCID="0000-0002-7544-0700")))
Description: Collection of functions to help retrieve U.S. Geological Survey
(USGS) and U.S. Environmental Protection Agency (EPA) water quality and
hydrology data from web services. USGS web services are discovered from
......@@ -30,11 +33,9 @@ Depends:
Imports:
httr (>= 1.0.0),
curl,
reshape2,
lubridate (>= 1.5.0),
stats,
utils,
dplyr,
xml2,
readr (>= 1.0.0),
jsonlite
......@@ -46,4 +47,4 @@ BuildVignettes: true
VignetteBuilder: knitr
BugReports: https://github.com/USGS-R/dataRetrieval/issues
URL: https://pubs.usgs.gov/tm/04/a10/
RoxygenNote: 6.0.1
RoxygenNote: 6.1.1
......@@ -33,6 +33,7 @@ export(readNWISuse)
export(readNWISuv)
export(readWQPdata)
export(readWQPqw)
export(readWQPsummary)
export(renameNWISColumns)
export(setAccess)
export(stateCd)
......@@ -46,42 +47,6 @@ export(whatWQPsites)
export(zeroPad)
import(stats)
import(utils)
importFrom(curl,curl_version)
importFrom(dplyr,arrange)
importFrom(dplyr,bind_cols)
importFrom(dplyr,bind_rows)
importFrom(dplyr,everything)
importFrom(dplyr,full_join)
importFrom(dplyr,left_join)
importFrom(dplyr,mutate)
importFrom(dplyr,mutate_)
importFrom(dplyr,mutate_each_)
importFrom(dplyr,select)
importFrom(dplyr,select_)
importFrom(httr,GET)
importFrom(httr,HEAD)
importFrom(httr,POST)
importFrom(httr,RETRY)
importFrom(httr,content)
importFrom(httr,content_type)
importFrom(httr,headers)
importFrom(httr,status_code)
importFrom(httr,stop_for_status)
importFrom(httr,user_agent)
importFrom(httr,write_disk)
importFrom(jsonlite,fromJSON)
importFrom(lubridate,fast_strptime)
importFrom(lubridate,parse_date_time)
importFrom(readr,col_character)
importFrom(readr,col_number)
importFrom(readr,cols)
importFrom(readr,problems)
importFrom(readr,read_delim)
importFrom(readr,read_lines)
importFrom(reshape2,dcast)
importFrom(reshape2,melt)
importFrom(stats,na.omit)
importFrom(tools,file_ext)
importFrom(xml2,read_xml)
importFrom(xml2,xml_attr)
importFrom(xml2,xml_attrs)
......
dataRetrieval 2.7.5
==========
* Fixed some time zone joining bugs that were happening if the timezone column had no information in the first ~100 returned rows.
* Changed WQP default behavior to a zip return
* Remove reshape2 and dplyr dependencies
* Added ability to customize user agent using options UA.dataRetrieval
dataRetrieval 2.7.3
==========
* Reworked whatNWISdata to allow the full flexibility of `...`
......
pkg.env <- new.env()
.onLoad = function(libname, pkgname){
suppressMessages(setAccess('public'))
options(Access.dataRetrieval = NULL)
suppressMessages(setAccess('public'))
}
......@@ -14,15 +14,13 @@
#' `ActivityEndDateWY`.
#' @export
#'
#' @importFrom dplyr select
#' @importFrom dplyr everything
#' @examples
#' \dontrun{
#' dataTemp <- readNWISdata(stateCd="OH",parameterCd="00010", service="dv")
#' dataTemp <- addWaterYear(dataTemp)
#' \donttest{
#' nwisData <- readNWISdv('04085427','00060','2012-01-01','2012-06-30')
#' nwisData <- addWaterYear(nwisData)
#'
#' pHData <- readWQPdata(siteid="USGS-04024315",characteristicName="pH")
#' pHData <- addWaterYear(pHData)
#' wqpData <- readWQPqw('USGS-01594440','01075', '', '')
#' wqpData <- addWaterYear(wqpData)
#' }
addWaterYear <- function(rawData){
......@@ -50,7 +48,10 @@ addWaterYear <- function(rawData){
# move waterYear so that it is always comes right after dateTime
dateCol_i <- which(names(rawData) == dateCol)
dateColWY_i <- which(names(rawData) == dateColWY)
rawData <- select(rawData, 1:dateCol_i, dateColWY_i, everything())
everything_else <- which(!(names(rawData) %in% c(dateCol,dateColWY)))
everything_else <- everything_else[!everything_else %in% c(1:dateCol_i, dateColWY_i)]
rawData <- rawData[, c(1:dateCol_i, dateColWY_i, everything_else)]
}
return(rawData)
......
......@@ -5,7 +5,6 @@
#'
#' @param values named list with arguments to send to the Water Quality Portal
#' @return values named list with corrected arguments to send to the Water Quality Portal
#' @importFrom lubridate parse_date_time
#' @export
#' @keywords internal
#' @examples
......@@ -30,7 +29,7 @@ checkWQPdates <- function(values){
splitDates <- unlist(strsplit(dateInput, "-"))
if(length(splitDates) == 3){
if(nchar(splitDates[1]) == 4){ #R object
dates <- as.Date(parse_date_time(dateInput, "%Y-%m-%d"))
dates <- as.Date(lubridate::parse_date_time(dateInput, "%Y-%m-%d"))
dates <- format(dates, format="%m-%d-%Y")
values[i] <- dates
} else if (nchar(splitDates[3]) != 4){ #The way WQP wants it == 4, so this is probably a 2 digit year or something
......
......@@ -200,16 +200,30 @@ constructNWISURL <- function(siteNumbers,parameterCd="00060",startDate="",endDat
format <- match.arg(format, c("xml","tsv","wml1","wml2","rdb"))
formatURL <- switch(format,
xml = {if ("gwlevels" == service) {
xml = {
if ("gwlevels" == service) {
"waterml"
} else {
"waterml,1.1"
}
},
rdb = "rdb,1.0",
tsv = "rdb,1.0",
rdb = {
if("gwlevels" == service){
"rdb"
} else {
"rdb,1.0"
}
},
tsv = {
if("gwlevels" == service){
"rdb"
} else {
"rdb,1.0"
}
},
wml2 = "waterml,2.0",
wml1 = {if ("gwlevels" == service) {
wml1 = {
if ("gwlevels" == service) {
"waterml"
} else {
"waterml,1.1"
......@@ -262,7 +276,7 @@ constructNWISURL <- function(siteNumbers,parameterCd="00060",startDate="",endDat
#' retrieval for the earliest possible record.
#' @param endDate character ending date for data retrieval in the form YYYY-MM-DD. Default is "" which indicates
#' retrieval for the latest possible record.
#' @param zip logical to request data via downloading zip file. Default set to FALSE.
#' @param zip logical to request data via downloading zip file. Default set to TRUE.
#' @keywords data import WQP web service
#' @return url string
#' @export
......@@ -274,7 +288,17 @@ constructNWISURL <- function(siteNumbers,parameterCd="00060",startDate="",endDat
#' url_wqp <- constructWQPURL(paste("USGS",site_id,sep="-"),
#' c('01075','00029','00453'),
#' startDate,endDate)
constructWQPURL <- function(siteNumbers,parameterCd,startDate,endDate,zip=FALSE){
#' url_wqp
#' charNames <- c("Temperature",
#' "Temperature, sample",
#' "Temperature, water",
#' "Temperature, water, deg F")
#' obs_url_orig <- constructWQPURL(siteNumbers = c("IIDFG-41WSSPAHS",
#' "USGS-02352560"),
#' parameterCd = charNames,
#' startDate,"")
#' obs_url_orig
constructWQPURL <- function(siteNumbers,parameterCd,startDate,endDate,zip=TRUE){
multipleSites <- length(siteNumbers) > 1
multiplePcodes <- length(parameterCd)>1
......@@ -284,7 +308,7 @@ constructWQPURL <- function(siteNumbers,parameterCd,startDate,endDate,zip=FALSE)
suppressWarnings(pCodeLogic <- all(!is.na(as.numeric(parameterCd))))
} else {
pCodeLogic <- FALSE
parameterCd <- URLencode(parameterCd, reserved = TRUE)
parameterCd <- sapply(parameterCd, URLencode, USE.NAMES = FALSE, reserved = TRUE)
}
if(multiplePcodes){
......@@ -306,10 +330,12 @@ constructWQPURL <- function(siteNumbers,parameterCd,startDate,endDate,zip=FALSE)
url <- paste0(url, "&startDateHi=",endDate)
}
url <- paste0(url,"&sorted=no&mimeType=tsv")
url <- paste0(url,"&mimeType=tsv")
if(zip){
url <- paste0(url,"&zip=yes")
} else {
url <- paste0(url,"&zip=no")
}
return(url)
......
......@@ -5,16 +5,6 @@
#'
#' @param obs_url character containing the url for the retrieval
#' @param \dots information to pass to header request
#' @importFrom httr GET
#' @importFrom httr POST
#' @importFrom httr RETRY
#' @importFrom httr user_agent
#' @importFrom httr stop_for_status
#' @importFrom httr status_code
#' @importFrom httr headers
#' @importFrom httr content
#' @importFrom httr content_type
#' @importFrom curl curl_version
#' @importFrom xml2 xml_text
#' @importFrom xml2 xml_child
#' @importFrom xml2 read_xml
......@@ -27,27 +17,26 @@
#' offering <- '00003'
#' property <- '00060'
#' obs_url <- constructNWISURL(siteNumber,property,startDate,endDate,'dv')
#' \dontrun{
#' \donttest{
#' rawData <- getWebServiceData(obs_url)
#' }
getWebServiceData <- function(obs_url, ...){
returnedList <- retryGetOrPost(obs_url, ...)
if(status_code(returnedList) == 400){
response400 <- content(returnedList, type="text", encoding = "UTF-8")
if(httr::status_code(returnedList) == 400){
response400 <- httr::content(returnedList, type="text", encoding = "UTF-8")
statusReport <- xml_text(xml_child(read_xml(response400), 2)) # making assumption that - body is second node
statusMsg <- gsub(pattern=", server=.*", replacement="", x = statusReport)
stop(statusMsg)
} else if(status_code(returnedList) != 200){
} else if(httr::status_code(returnedList) != 200){
message("For: ", obs_url,"\n")
stop_for_status(returnedList)
httr::stop_for_status(returnedList)
} else {
headerInfo <- headers(returnedList)
headerInfo <- httr::headers(returnedList)
if(headerInfo$`content-type` %in% c("text/tab-separated-values;charset=UTF-8")){
returnedDoc <- content(returnedList, type="text",encoding = "UTF-8")
returnedDoc <- httr::content(returnedList, type="text",encoding = "UTF-8")
} else if (headerInfo$`content-type` %in%
c("application/zip",
"application/zip;charset=UTF-8",
......@@ -58,10 +47,8 @@ getWebServiceData <- function(obs_url, ...){
txt <- readBin(returnedList$content, character())
message(txt)
return(txt)
} else {
returnedDoc <- content(returnedList,encoding = "UTF-8")
returnedDoc <- httr::content(returnedList,encoding = "UTF-8")
if(grepl("No sites/data found using the selection criteria specified", returnedDoc)){
message(returnedDoc)
}
......@@ -86,21 +73,26 @@ getWebServiceData <- function(obs_url, ...){
default_ua <- function() {
versions <- c(
libcurl = curl_version()$version,
libcurl = curl::curl_version()$version,
httr = as.character(packageVersion("httr")),
dataRetrieval = as.character(packageVersion("dataRetrieval"))
)
paste0(names(versions), "/", versions, collapse = " ")
ua <- paste0(names(versions), "/", versions, collapse = " ")
if("UA.dataRetrieval" %in% names(options)){
ua <- paste0(ua, "/", options()[["UA.dataRetrieval"]])
}
return(ua)
}
#' getting header information from a WQP query
#'
#'@param url the query url
#'@importFrom httr HEAD
#'@importFrom httr headers
getQuerySummary <- function(url){
queryHEAD <- HEAD(url)
retquery <- headers(queryHEAD)
queryHEAD <- httr::HEAD(url)
retquery <- httr::headers(queryHEAD)
retquery[grep("-count",names(retquery))] <- as.numeric(retquery[grep("-count",names(retquery))])
......@@ -114,13 +106,17 @@ getQuerySummary <- function(url){
retryGetOrPost <- function(obs_url, ...) {
resp <- NULL
if (nchar(obs_url) < 2048 || grepl(pattern = "ngwmn", x = obs_url)) {
resp <- RETRY("GET", obs_url, ..., user_agent(default_ua()))
resp <- httr::RETRY("GET", obs_url, ..., httr::user_agent(default_ua()))
} else {
split <- strsplit(obs_url, "?", fixed=TRUE)
obs_url <- split[[1]][1]
query <- split[[1]][2]
resp <- RETRY("POST", obs_url, ..., body = query,
content_type("application/x-www-form-urlencoded"), user_agent(default_ua()))
resp <- httr::RETRY("POST", obs_url, ...,
body = query,
httr::content_type("application/x-www-form-urlencoded"),
httr::user_agent(default_ua()))
}
return(resp)
}
\ No newline at end of file
......@@ -18,9 +18,8 @@
#' @importFrom xml2 xml_text
#' @importFrom xml2 xml_attr
#' @importFrom xml2 xml_find_first
#' @importFrom lubridate parse_date_time
#' @examples
#' \dontrun{
#' \donttest{
#' obs_url <- paste("http://cida.usgs.gov/ngwmn_cache/sos?request=GetObservation",
#' "service=SOS","version=2.0.0",
#' "observedProperty=urn:ogc:def:property:OGC:GroundWaterLevel",
......@@ -28,12 +27,6 @@
#' "featureOfInterest=VW_GWDP_GEOSERVER.USGS.403836085374401",sep="&")
#' data <- importNGWMN(obs_url)
#'
#' obs_url <- paste("http://cida.usgs.gov/ngwmn_cache/sos?request=GetObservation",
#' "service=SOS","version=2.0.0",
#' "observedProperty=urn:ogc:def:property:OGC:GroundWaterLevel",
#' "responseFormat=text/xml",
#' "featureOfInterest=VW_GWDP_GEOSERVER.USGS.474011117072901",sep="&")
#' data <- importNGWMN(obs_url)
#' }
#'
importNGWMN <- function(input, asDateTime=FALSE, tz="UTC"){
......@@ -77,7 +70,10 @@ importNGWMN <- function(input, asDateTime=FALSE, tz="UTC"){
mergedDF <- df
} else {
similarNames <- intersect(colnames(mergedDF), colnames(df))
mergedDF <- full_join(mergedDF, df, by=similarNames)
mergedDF <- merge(x = mergedDF,
y = df,
by = similarNames,
all = TRUE)
}
}
......@@ -110,9 +106,9 @@ importNGWMN <- function(input, asDateTime=FALSE, tz="UTC"){
siteLocs <- strsplit(xml_text(xml_find_all(featureMembers, ".//gml:pos")), " ")
siteLocs <- data.frame(matrix(unlist(siteLocs), nrow=length(siteLocs), byrow=TRUE), stringsAsFactors = FALSE)
names(siteLocs) <- c("dec_lat_va", "dec_lon_va")
dec_lat_va <- "dplyr var"
dec_lon_va <- "dplyr var"
siteLocs <- mutate(siteLocs, dec_lat_va=as.numeric(dec_lat_va), dec_lon_va=as.numeric(dec_lon_va))
siteLocs$dec_lat_va <- as.numeric(siteLocs$dec_lat_va)
siteLocs$dec_lon_va <- as.numeric(siteLocs$dec_lon_va)
mergedDF <- cbind.data.frame(site, description = siteDesc, siteLocs, stringsAsFactors = FALSE)
} else if (response == "ExceptionReport"){
......@@ -136,8 +132,6 @@ importNGWMN <- function(input, asDateTime=FALSE, tz="UTC"){
#' Possible values are "America/New_York","America/Chicago", "America/Denver","America/Los_Angeles",
#' "America/Anchorage","America/Honolulu","America/Jamaica","America/Managua","America/Phoenix", and "America/Metlakatla"
#' @importFrom xml2 xml_attr xml_find_all xml_text
#' @importFrom dplyr mutate
#' @importFrom lubridate parse_date_time
#' @export
#' @examples
#' baseURL <- "https://waterservices.usgs.gov/nwis/dv/?format=waterml,2.0"
......@@ -146,7 +140,7 @@ importNGWMN <- function(input, asDateTime=FALSE, tz="UTC"){
#' "endDT=2014-09-08",
#' "statCd=00003",
#' "parameterCd=00060",sep="&")
#' \dontrun{
#' \donttest{
#' timesereies <- importWaterML2(URL, asDateTime=TRUE, tz="UTC")
#' }
importWaterML2 <- function(input, asDateTime=FALSE, tz="UTC") {
......@@ -161,9 +155,9 @@ importWaterML2 <- function(input, asDateTime=FALSE, tz="UTC") {
time = character(0), dateTime = character(0), value = numeric(0),
uom = character(0), comment = character(0), stringsAsFactors = FALSE))
}
rawTime <- xml_text(xml_find_all(returnedDoc, "./wml2:point/wml2:MeasurementTVP/wml2:time"))
rawTime <- xml_text(xml_find_all(returnedDoc, ".//wml2:MeasurementTVP/wml2:time"))
valueNodes <- xml_find_all(returnedDoc,"./wml2:point/wml2:MeasurementTVP/wml2:value")
valueNodes <- xml_find_all(returnedDoc, ".//wml2:MeasurementTVP/wml2:value")
charValues <- xml_text(valueNodes)
nilValues <- as.logical(xml_attr(valueNodes, "nil"))
charValues[nilValues] <- NA
......@@ -176,18 +170,19 @@ importWaterML2 <- function(input, asDateTime=FALSE, tz="UTC") {
splitTime <- data.frame(matrix(unlist(strsplit(rawTime, "T")), nrow=nVals, byrow = TRUE), stringsAsFactors=FALSE)
if(ncol(splitTime) > 1){ #some sites only have a date
names(splitTime) <- c("date", "time")
}else{
} else {
names(splitTime) <- "date"
splitTime <- mutate(splitTime, time = NA)
splitTime$time <- NA
}
timeDF <- mutate(splitTime, dateTime = NA)
timeDF <- splitTime
timeDF$dateTime <- NA
logicVec <- nchar(rawTime) > 19
if(!all(!logicVec)) { #otherwise sets it to char <NA>
timeDF$dateTime[logicVec] <- rawTime[logicVec]
}
if(asDateTime){
timeDF$dateTime <- parse_date_time(timeDF$dateTime, c("%Y","%Y-%m-%d","%Y-%m-%dT%H:%M","%Y-%m-%dT%H:%M:%S",
timeDF$dateTime <- lubridate::parse_date_time(timeDF$dateTime, c("%Y","%Y-%m-%d","%Y-%m-%dT%H:%M","%Y-%m-%dT%H:%M:%S",
"%Y-%m-%dT%H:%M:%OS","%Y-%m-%dT%H:%M:%OS%z"), exact = TRUE)
#^^setting tz in as.POSIXct just sets the attribute, does not convert the time!
attr(timeDF$dateTime, 'tzone') <- tz
......
......@@ -44,11 +44,6 @@
#' @export
#' @import utils
#' @import stats
#' @importFrom lubridate parse_date_time
#' @importFrom dplyr left_join
#' @importFrom readr read_lines
#' @importFrom readr read_delim
#' @importFrom readr problems
#' @examples
#' site_id <- "02177000"
#' startDate <- "2012-09-01"
......@@ -58,7 +53,7 @@
#'
#' obs_url <- constructNWISURL(site_id,property,
#' startDate,endDate,"dv",format="tsv")
#' \dontrun{
#' \donttest{
#' data <- importRDB1(obs_url)
#'
#' urlMultiPcodes <- constructNWISURL("04085427",c("00060","00010"),
......@@ -106,7 +101,7 @@ importRDB1 <- function(obs_url, asDateTime=TRUE, convertType = TRUE, tz="UTC"){
}
}
readr.total <- read_lines(doc)
readr.total <- readr::read_lines(doc)
total.rows <- length(readr.total)
readr.meta <- readr.total[grep("^#", readr.total)]
meta.rows <- length(readr.meta)
......@@ -132,7 +127,7 @@ importRDB1 <- function(obs_url, asDateTime=TRUE, convertType = TRUE, tz="UTC"){
} else {
readr.data <- read_delim_check_quote(file = doc,skip = (meta.rows+2),delim="\t",col_names = FALSE, col_types = cols(.default = "c"), total.rows = data.rows)
readr.data <- read_delim_check_quote(file = doc,skip = (meta.rows+2),delim="\t",col_names = FALSE, col_types = readr::cols(.default = "c"), total.rows = data.rows)
}
......@@ -142,6 +137,7 @@ importRDB1 <- function(obs_url, asDateTime=TRUE, convertType = TRUE, tz="UTC"){
char.names <- c(header.names[grep("_cd",header.names)],
header.names[grep("_id",header.names)],
header.names[grep("_tx",header.names)],
header.names[grep("_tm",header.names)],
header.names[header.names == "site_no"])
if(length(char.names) > 0){
......@@ -151,9 +147,9 @@ importRDB1 <- function(obs_url, asDateTime=TRUE, convertType = TRUE, tz="UTC"){
char.names <- NULL
}
if(nrow(problems(readr.data)) > 0 | length(char.names) > 0){
if(nrow(readr::problems(readr.data)) > 0 | length(char.names) > 0){
readr.data.char <- read_delim_check_quote(file = doc, skip = (meta.rows+2),delim="\t",col_names = FALSE,
col_types = cols(.default = "c"), total.rows = data.rows)
col_types = readr::cols(.default = "c"), total.rows = data.rows)
names(readr.data.char) <- header.names
}
......@@ -167,7 +163,7 @@ importRDB1 <- function(obs_url, asDateTime=TRUE, convertType = TRUE, tz="UTC"){
if(length(badCols) > 0){
readr.data <- fixErrors(readr.data, readr.data.char, "no trailing characters", as.numeric)
readr.data <- fixErrors(readr.data, readr.data.char, "date like", parse_date_time, c("%Y-%m-%d %H:%M:%S","%Y-%m-%d","%Y"))
readr.data <- fixErrors(readr.data, readr.data.char, "date like", lubridate::parse_date_time, c("%Y-%m-%d %H:%M:%S","%Y-%m-%d","%Y"))
}
if(length(grep("_va", names(readr.data))) > 0 &&
......@@ -197,7 +193,7 @@ importRDB1 <- function(obs_url, asDateTime=TRUE, convertType = TRUE, tz="UTC"){
}
comment(readr.data) <- readr.meta
problems.orig <- problems(readr.data)
problems.orig <- readr::problems(readr.data)
if (asDateTime & convertType){
......@@ -209,7 +205,7 @@ importRDB1 <- function(obs_url, asDateTime=TRUE, convertType = TRUE, tz="UTC"){
if(all(c(paste0(i,"_dt"),paste0(i,"_tm")) %in% header.names)){
varname <- paste0(i,"_dateTime")
varval <- suppressWarnings(parse_date_time(paste(readr.data[,paste0(i,"_dt")],readr.data[,paste0(i,"_tm")]), c("%Y-%m-%d %H:%M:%S","%Y-%m-%d %H:%M"), tz = "UTC"))
varval <- suppressWarnings(lubridate::parse_date_time(paste(readr.data[,paste0(i,"_dt")],readr.data[,paste0(i,"_tm")]), c("%Y-%m-%d %H:%M:%S","%Y-%m-%d %H:%M"), tz = "UTC"))
if(!all(is.na(varval))){
readr.data[,varname] <- varval
......@@ -236,12 +232,12 @@ importRDB1 <- function(obs_url, asDateTime=TRUE, convertType = TRUE, tz="UTC"){
}
if("DATE" %in% header.names){
readr.data[,"DATE"] <- parse_date_time(readr.data[,"DATE"], "Ymd")
readr.data[,"DATE"] <- lubridate::parse_date_time(readr.data[,"DATE"], "Ymd")
}
if(all(c("DATE","TIME","TZCD") %in% header.names)){
varname <- "DATETIME"
varval <- as.POSIXct(fast_strptime(paste(readr.data[,"DATE"],readr.data[,"TIME"]), "%Y-%m-%d %H%M%S", tz = "UTC"))
varval <- as.POSIXct(lubridate::fast_strptime(paste(readr.data[,"DATE"],readr.data[,"TIME"]), "%Y-%m-%d %H%M%S", tz = "UTC"))
readr.data[,varname] <- varval
readr.data <- convertTZ(readr.data,"TZCD",varname,tz, flip.cols=TRUE)
}
......@@ -287,11 +283,13 @@ importRDB1 <- function(obs_url, asDateTime=TRUE, convertType = TRUE, tz="UTC"){
convertTZ <- function(df, tz.name, date.time.cols, tz, flip.cols=TRUE){
offsetLibrary <- data.frame(offset=c(5, 4, 6, 5, 7, 6, 8, 7, 9, 8, 10, 10, 0, 0),
code=c("EST","EDT","CST","CDT","MST","MDT","PST","PDT","AKST","AKDT","HAST","HST","", NA),
offsetLibrary <- data.frame(offset=c(5, 4, 6, 5, 7, 6, 8, 7, 9, 8, 10, 10, 0, 0, 0, 0),
code=c("EST","EDT","CST","CDT","MST","MDT","PST","PDT","AKST","AKDT","HAST","HST","UTC","", NA, "GMT"),
stringsAsFactors = FALSE)
offset <- left_join(df[,tz.name,drop=FALSE],offsetLibrary, by=setNames("code",tz.name))
offset <- merge(x = df[,tz.name,drop=FALSE],
y = offsetLibrary, by.x=tz.name, by.y = "code",
all.x = TRUE)
offset <- offset$offset
df[,paste0(tz.name,"_reported")] <- df[,tz.name,drop=FALSE]
......@@ -345,10 +343,10 @@ fixErrors <- function(readr.data, readr.data.char, message.text, FUN, ...){
}
read_delim_check_quote <- function(..., total.rows){
rdb.data <- suppressWarnings(read_delim(...))
rdb.data <- suppressWarnings(readr::read_delim(...))
if(nrow(rdb.data) < total.rows){
rdb.data <- suppressWarnings(read_delim(..., quote = ""))
rdb.data <- suppressWarnings(readr::read_delim(..., quote = ""))
}
return(rdb.data)
......
......@@ -5,45 +5,34 @@
#' Imports data from the Water Quality Portal based on a specified url.
#'
#' @param obs_url character URL to Water Quality Portal#' @keywords data import USGS web service
#' @param zip logical to request data via downloading zip file. Default set to FALSE.
#' @param zip logical to request data via downloading zip file. Default set to TRUE.
#' @param tz character to set timezone attribute of datetime. Default is UTC (properly accounting for daylight savings times based on the data's provided tz_cd column).
#' Possible values include "America/New_York","America/Chicago", "America/Denver","America/Los_Angeles",
#' "America/Anchorage","America/Honolulu","America/Jamaica","America/Managua","America/Phoenix", and "America/Metlakatla"
#' @param csv logical. Is the data coming back with a csv or tsv format. Default is \code{FALSE}. Currently, the
#' summary service does not support tsv, for other services tsv is the safer choice.
#' @return retval dataframe raw data returned from the Water Quality Portal. Additionally, a POSIXct dateTime column is supplied for
#' start and end times, and converted to UTC. See \url{https://www.waterqualitydata.us/portal_userguide/} for more information.
#' @export
#' @seealso \code{\link{readWQPdata}}, \code{\link{readWQPqw}}, \code{\link{whatWQPsites}}
#' @import utils
#' @import stats
#' @importFrom readr read_delim
#' @importFrom readr col_character
#' @importFrom readr col_number
#' @importFrom readr cols
#' @importFrom dplyr mutate_
#' @importFrom dplyr mutate_each_
#' @importFrom dplyr select_
#' @importFrom dplyr left_join
#' @importFrom lubridate parse_date_time
#' @importFrom lubridate fast_strptime
#' @importFrom httr GET
#' @importFrom httr user_agent
#' @importFrom httr write_disk
#' @examples
#' # These examples require an internet connection to run
#'
#' ## Examples take longer than 5 seconds:
#' \dontrun{
#' \donttest{
#' rawSampleURL <- constructWQPURL('USGS-01594440','01075', '', '')
#'
#' rawSample <- importWQP(rawSampleURL)
#'
#' rawSampleURL_Zip <- constructWQPURL('USGS-01594440','01075', '', '', TRUE)
#' rawSample2 <- importWQP(rawSampleURL_Zip, zip=TRUE)
#' rawSampleURL_NoZip <- constructWQPURL('USGS-01594440','01075', '', '', zip=FALSE)
#' rawSample2 <- importWQP(rawSampleURL_NoZip, zip=FALSE)
#'
#' STORETex <- constructWQPURL('WIDNR_WQX-10032762','Specific conductance', '', '')
#' STORETdata <- importWQP(STORETex)
#' }
importWQP <- function(obs_url, zip=FALSE, tz="UTC"){
importWQP <- function(obs_url, zip=TRUE, tz="UTC", csv=FALSE){
if(tz != ""){
tz <- match.arg(tz, OlsonNames())
......@@ -54,22 +43,27 @@ importWQP <- function(obs_url, zip=FALSE, tz="UTC"){
if(!file.exists(obs_url)){
if(zip){
message("zip encoding access still in development")
temp <- tempfile()
temp <- paste0(temp,".zip")
doc <- getWebServiceData(obs_url, write_disk(temp))
headerInfo <- headers(doc)
doc <- unzip(temp, exdir=tempdir())
doc <- getWebServiceData(obs_url,
httr::write_disk(temp),
httr::accept("application/zip"))
headerInfo <- httr::headers(doc)
doc <- utils::unzip(temp, exdir=tempdir())
unlink(temp)
on.exit(unlink(doc))
} else {
doc <- getWebServiceData(obs_url)
doc <- getWebServiceData(obs_url,
httr::accept("text/tsv"))
headerInfo <- attr(doc, "headerInfo")
}
headerInfo[grep("-count",names(headerInfo))] <- as.numeric(headerInfo[grep("-count",names(headerInfo))])
totalPossible <- sum(unlist(headerInfo[grep("-count",names(headerInfo))]), na.rm = TRUE)
if(is.na(totalPossible) | totalPossible == 0){
for(i in grep("Warning",names(headerInfo))){
warning(headerInfo[i])
......@@ -85,21 +79,21 @@ importWQP <- function(obs_url, zip=FALSE, tz="UTC"){
} else {
doc <- obs_url
}
}
retval <- suppressWarnings(read_delim(doc,
col_types = cols(`ActivityStartTime/Time` = col_character(),
`ActivityEndTime/Time` = col_character(),
USGSPCode = col_character(),
ResultCommentText=col_character(),
`ActivityDepthHeightMeasure/MeasureValue` = col_number(),
`DetectionQuantitationLimitMeasure/MeasureValue` = col_number(),
ResultMeasureValue = col_number(),
`WellDepthMeasure/MeasureValue` = col_number(),
`WellHoleDepthMeasure/MeasureValue` = col_number(),
`HUCEightDigitCode` = col_character()),
quote = "", delim = "\t"))
retval <- suppressWarnings(readr::read_delim(doc,
col_types = readr::cols(`ActivityStartTime/Time` = readr::col_character(),
`ActivityEndTime/Time` = readr::col_character(),
USGSPCode = readr::col_character(),
ResultCommentText=readr::col_character(),
`ActivityDepthHeightMeasure/MeasureValue` = readr::col_number(),
`DetectionQuantitationLimitMeasure/MeasureValue` = readr::col_number(),
ResultMeasureValue = readr::col_number(),
`WellDepthMeasure/MeasureValue` = readr::col_number(),
`WellHoleDepthMeasure/MeasureValue` = readr::col_number(),
`HUCEightDigitCode` = readr::col_character(),
`ActivityEndTime/TimeZoneCode` = readr::col_character()),
quote = ifelse(csv,'\"',""), delim = ifelse(csv,",","\t")))
if(!file.exists(obs_url)){
actualNumReturned <- nrow(retval)
......@@ -111,34 +105,74 @@ importWQP <- function(obs_url, zip=FALSE, tz="UTC"){
if(length(grep("ActivityStartTime",names(retval))) > 0){
offsetLibrary <- data.frame(offset=c(5, 4, 6, 5, 7, 6, 8, 7, 9, 8, 10, 10, 0, 0),
code=c("EST","EDT","CST","CDT","MST","MDT","PST","PDT","AKST","AKDT","HAST","HST","", NA),
stringsAsFactors = FALSE)
#Time zones to characters:
if(length(grep("TimeZoneCode", names(retval))) > 0 &&
any(lapply(retval[,grep("TimeZoneCode", names(retval))], class) == "logical")) {
tzCols <- grep("TimeZoneCode", names(retval))
retval[,tzCols] <- sapply(retval[,tzCols], as.character)
}
retval <- left_join(retval, offsetLibrary, by=c("ActivityStartTime/TimeZoneCode"="code"))
offsetLibrary <- data.frame(offset=c(5, 4, 6, 5, 7, 6, 8, 7, 9, 8, 10, 10, 0, 0, NA, 0, 0),
code=c("EST","EDT","CST","CDT","MST","MDT","PST","PDT","AKST","AKDT","HAST","HST","", NA, NA, "UTC","GMT"),
stringsAsFactors = FALSE)
original_order <- names(retval)
retval <- merge(x = retval,
y = offsetLibrary,
by.x="ActivityStartTime/TimeZoneCode",
by.y = "code",
all.x = TRUE)
names(retval)[names(retval) == "offset"] <- "timeZoneStart"
retval <- left_join(retval, offsetLibrary, by=c("ActivityEndTime/TimeZoneCode"="code"))
retval <- retval[,c(original_order, "timeZoneStart")]
retval <- merge(x = retval,
y = offsetLibrary,
by.x="ActivityEndTime/TimeZoneCode",
by.y = "code",
all.x = TRUE)
names(retval)[names(retval) == "offset"] <- "timeZoneEnd"
retval <- retval[,c(original_order, "timeZoneStart", "timeZoneEnd")]
dateCols <- c("ActivityStartDate","ActivityEndDate","AnalysisStartDate","PreparationStartDate")
for(i in dateCols){
retval[,i] <- suppressWarnings(as.Date(parse_date_time(retval[[i]], c("Ymd", "mdY"))))
retval[,i] <- suppressWarnings(as.Date(lubridate::parse_date_time(retval[[i]], c("Ymd", "mdY"))))
}
retval <- mutate_(retval, ActivityStartDateTime=~paste(ActivityStartDate, `ActivityStartTime/Time`))
retval <- mutate_(retval, ActivityEndDateTime=~paste(ActivityEndDate, `ActivityEndTime/Time`))
retval$ActivityStartDateTime <- paste(retval$ActivityStartDate, retval$`ActivityStartTime/Time`)
retval$ActivityEndDateTime <- paste(retval$ActivityEndDate, retval$`ActivityEndTime/Time`)
retval <- mutate_(retval, ActivityStartDateTime=~fast_strptime(ActivityStartDateTime, '%Y-%m-%d %H:%M:%S')+60*60*timeZoneStart)
retval <- mutate_(retval, ActivityEndDateTime=~fast_strptime(ActivityEndDateTime, '%Y-%m-%d %H:%M:%S')+60*60*timeZoneStart)
retval$ActivityStartDateTime <- lubridate::fast_strptime(retval$ActivityStartDateTime, '%Y-%m-%d %H:%M:%S')+60*60*retval$timeZoneStart
retval$ActivityEndDateTime <- lubridate::fast_strptime(retval$ActivityEndDateTime, '%Y-%m-%d %H:%M:%S')+60*60*retval$timeZoneStart
retval <- select_(retval, ~-timeZoneEnd, ~-timeZoneStart)
retval <- retval[,names(retval)[!(names(retval) %in% c("timeZoneEnd", "timeZoneStart"))]]
}
names(retval)[grep("/",names(retval))] <- gsub("/",".",names(retval)[grep("/",names(retval))])
return(retval)
}
post_url <- function(obs_url, zip, csv=FALSE){
split <- strsplit(obs_url, "?", fixed=TRUE)
url <- split[[1]][1]
if(csv){
url <- paste0(url, "?mimeType=csv")
} else {
url <- paste0(url, "?mimeType=tsv")
}
if(grepl("sorted",split[[1]][2])){
url <- paste0(url, "&sorted=", strsplit(split[[1]][2], "sorted=", fixed=TRUE)[[1]][2])
}
if(zip){
url <- paste0(url, "&zip=yes")
}
return(url)
}
......@@ -41,10 +41,6 @@
#' @export
#' @import utils
#' @import stats
#' @importFrom lubridate parse_date_time
#' @importFrom dplyr full_join
#' @importFrom dplyr bind_rows
#' @importFrom dplyr arrange
#' @importFrom xml2 read_xml
#' @importFrom xml2 xml_find_all
#' @importFrom xml2 xml_children
......@@ -60,7 +56,7 @@
#' offering <- '00003'
#' property <- '00060'
#' obs_url <- constructNWISURL(site_id,property,startDate,endDate,'dv')
#' \dontrun{
#' \donttest{
#' data <- importWaterML1(obs_url, asDateTime=TRUE)
#'
#' groundWaterSite <- "431049071324301"
......@@ -93,14 +89,14 @@
#' inactiveAndAcitive <- constructNWISURL(inactiveAndAcitive, "00060", "2014-01-01", "2014-01-10",'dv')
#' inactiveAndAcitive <- importWaterML1(inactiveAndAcitive)
#'
#' Timezone change with specified local timezone:
#' # Timezone change with specified local timezone:
#' tzURL <- constructNWISURL("04027000", c("00300","63680"), "2011-11-05", "2011-11-07","uv")
#' tzIssue <- importWaterML1(tzURL, TRUE, "America/Chicago")
#'
#' #raw XML
#' # raw XML
#' url <- constructNWISURL(service = 'dv', siteNumber = '02319300', parameterCd = "00060",
#' startDate = "2014-01-01", endDate = "2014-01-01")
#' raw <- content(GET(url), as = 'raw')
#' raw <- httr::content(httr::GET(url), as = 'raw')
#' rawParsed <- importWaterML1(raw)
#' }
#' filePath <- system.file("extdata", package="dataRetrieval")
......@@ -186,7 +182,7 @@ importWaterML1 <- function(obs_url,asDateTime=FALSE, tz="UTC"){
dateTime <- xml_attr(obs,"dateTime")
if(asDateTime){
numChar <- nchar(dateTime)
dateTime <- parse_date_time(dateTime, c("%Y","%Y-%m-%d","%Y-%m-%dT%H:%M",
dateTime <- lubridate::parse_date_time(dateTime, c("%Y","%Y-%m-%d","%Y-%m-%dT%H:%M",
"%Y-%m-%dT%H:%M:%S","%Y-%m-%dT%H:%M:%OS",
"%Y-%m-%dT%H:%M:%OS%z"), exact = TRUE)
if(any(numChar < 20) & any(numChar > 16)){
......@@ -202,7 +198,7 @@ importWaterML1 <- function(obs_url,asDateTime=FALSE, tz="UTC"){
#^^setting tz in as.POSIXct just sets the attribute, does not convert the time!
attr(dateTime, 'tzone') <- tz
tzCol <- rep(tz,nObs)
}else{
} else {
tzCol <- rep(defaultTZ, nObs)
}
#create column names, addressing if methodDesc is needed
......@@ -231,10 +227,13 @@ importWaterML1 <- function(obs_url,asDateTime=FALSE, tz="UTC"){
if(nrow(valParentDF) > 0){
if(is.null(obsDF)){
obsDF <- valParentDF
}else{
obsDF <- full_join(obsDF, valParentDF, by = c("dateTime","tz_cd"))
} else {
obsDF <- merge(x = obsDF,
y = valParentDF,
by = c("dateTime","tz_cd"),
all = TRUE)
}
}else{
} else {
#need column names for joining later
# but don't overwrite:
if(is.null(obsDF)){
......@@ -295,17 +294,32 @@ importWaterML1 <- function(obs_url,asDateTime=FALSE, tz="UTC"){
deleteCols <- grepl(obsColName,colnames(sameSite))
sameSite <- sameSite[,!deleteCols]
sameSite_simNames <- intersect(colnames(sameSite), colnames(df))
sameSite <- full_join(sameSite, df, by = sameSite_simNames)
sameSite <- merge(x = sameSite,
y = df,
by = sameSite_simNames,
all=TRUE)
sameSite <- sameSite[order(as.Date(sameSite$dateTime)),]
mergedDF <- bind_rows(sameSite, diffSite)
}else{
mergedDF <- r_bind_dr(sameSite, diffSite)
} else {
similarNames <- intersect(colnames(mergedDF), colnames(df))
mergedDF <- full_join(mergedDF, df, by=similarNames)
mergedDF <- merge(x = mergedDF,
y = df,
by=similarNames,
all = TRUE)
}
}
mergedSite <- full_join(mergedSite, siteDF, by = colnames(mergedSite))
mergedVar <- full_join(mergedVar, varText, by = colnames(mergedVar))
mergedStat <- full_join(mergedStat, statDF, by = colnames(mergedStat))
mergedSite <- merge(x = mergedSite,
y = siteDF,
by = colnames(mergedSite),
all = TRUE)
mergedVar <- merge(x = mergedVar,
y = varText,
by = colnames(mergedVar),
all = TRUE)
mergedStat <- merge(x = mergedStat,
y = statDF,
by = colnames(mergedStat),
all = TRUE)
}
}
......@@ -323,8 +337,9 @@ importWaterML1 <- function(obs_url,asDateTime=FALSE, tz="UTC"){
mergedNames <- names(mergedDF)
tzLoc <- grep("tz_cd", names(mergedDF))
mergedDF <- mergedDF[c(mergedNames[-tzLoc],mergedNames[tzLoc])]
mergedDF <- arrange(mergedDF,site_no, dateTime)
mergedDF <- mergedDF[order(mergedDF$site_no, mergedDF$dateTime),]
###############################################################
names(mergedDF) <- make.names(names(mergedDF))
#attach other site info etc as attributes of mergedDF
......@@ -340,11 +355,59 @@ importWaterML1 <- function(obs_url,asDateTime=FALSE, tz="UTC"){
return (mergedDF)
}
r_bind_dr <- function(df1, df2){
# Note...this funciton doesn't retain factors/levels
# That is not a problem with any dataRetrieval function
# but, if this function gets used else-where,
# that should be addressed.
df1 <- add_empty_col(df1, df2, setdiff(names(df2), names(df1)))
df2 <- add_empty_col(df2, df1, setdiff(names(df1), names(df2)))
df3 <- rbind(df1, df2)
return(df3)
}
add_empty_col <- function(df, df_ref, col_names){
if(length(col_names) > 0){
if(nrow(df) > 0){
df[,col_names] <- NA
} else {
for(i in col_names){
column_type <- class(df_ref[[i]])
df[i] <- empty_col(column_type)
}
}
}
return(df)
}
empty_col <- function(column_type){
if(all(column_type %in% c("POSIXct","POSIXt" ))){
column_type <- "POSIXct"
}
col_return <- switch(column_type,
"numeric" = as.numeric(),
"factor" = as.factor(),
"list" = list(),
"integer" = as.integer(),
"Date" = as.Date(numeric(), origin = "1970-01-01"),
"POSIXct" = as.POSIXct(numeric(), origin = "1970-01-01"),
"POSIXlt" = as.POSIXlt(numeric(), origin = "1970-01-01"),
"character" = as.character())
return(col_return)
}
check_if_xml <- function(obs_url){
if(class(obs_url) == "character" && file.exists(obs_url)){
returnedDoc <- read_xml(obs_url)
}else if(class(obs_url) == 'raw'){
} else if(class(obs_url) == 'raw'){
returnedDoc <- read_xml(obs_url)
} else if(inherits(obs_url, c("xml_node", "xml_nodeset"))) {
returnedDoc <- obs_url
......
......@@ -12,36 +12,34 @@
#' "America/Jamaica","America/Managua","America/Phoenix", and "America/Metlakatla". See also \code{OlsonNames()}
#' for more information on time zones.
#' @import utils
#' @importFrom dplyr mutate
#' @importFrom dplyr bind_rows
#' @importFrom dplyr bind_cols
#' @importFrom stats na.omit
#' @export
#' @examples
#' \dontrun{
#' \donttest{
#' #one site
#' site <- "USGS.430427089284901"
#' oneSite <- readNGWMNdata(siteNumbers = site, service = "observation")
#' # oneSite <- readNGWMNdata(siteNumbers = site, service = "observation")
#'
#' #multiple sites
#' sites <- c("USGS.272838082142201","USGS.404159100494601", "USGS.401216080362703")
#' multiSiteData <- readNGWMNdata(siteNumbers = sites, service = "observation")
#' attributes(multiSiteData)
#' # Very slow:
#' # multiSiteData <- readNGWMNdata(siteNumbers = sites, service = "observation")
#' # attributes(multiSiteData)
#'
#' #non-USGS site
#' #accepts colon or period between agency and ID
#' site <- "MBMG:702934"
#' data <- readNGWMNdata(siteNumbers = site, service = "featureOfInterest")
#' # data <- readNGWMNdata(siteNumbers = site, service = "featureOfInterest")
#'
#' #site with no data returns empty data frame
#' noDataSite <- "UTGS.401544112060301"
#' noDataSite <- readNGWMNdata(siteNumbers = noDataSite, service = "observation")
#' # noDataSite <- readNGWMNdata(siteNumbers = noDataSite, service = "observation")
#'
#' #bounding box
#' bboxSites <- readNGWMNdata(service = "featureOfInterest", bbox = c(30, -102, 31, 99))
#' #bboxSites <- readNGWMNdata(service = "featureOfInterest", bbox = c(30, -102, 31, 99))
#' #retrieve sites. Set asDateTime to false since one site has an invalid date
#' bboxData <- readNGWMNdata(service = "observation", siteNumbers = bboxSites$site[1:3],
#' asDateTime = FALSE)
#' # Very slow:
#' #bboxData <- readNGWMNdata(service = "observation", siteNumbers = bboxSites$site[1:3],
#' #asDateTime = FALSE)
#' }
#'
readNGWMNdata <- function(service, ..., asDateTime = TRUE, tz = "UTC"){
......@@ -58,14 +56,14 @@ readNGWMNdata <- function(service, ..., asDateTime = TRUE, tz = "UTC"){
#these attributes are pulled out and saved when doing binds to be reattached
attrs <- c("url","gml:identifier","generationDate","responsibleParty", "contact")
featureID <- na.omit(gsub(":",".",dots[['siteNumbers']]))
featureID <- stats::na.omit(gsub(":",".",dots[['siteNumbers']]))
for(f in featureID){
obsFID <- retrieveObservation(featureID = f, asDateTime, attrs, tz = tz)
obsFIDattr <- saveAttrs(attrs, obsFID)
obsFID <- removeAttrs(attrs, obsFID)
allObs <- bind_rows(allObs, obsFID)
allAttrs <- bind_rows(allAttrs, obsFIDattr)
allObs <- r_bind_dr(allObs, obsFID)
allAttrs <- r_bind_dr(allAttrs, obsFIDattr)
}
......@@ -83,7 +81,7 @@ readNGWMNdata <- function(service, ..., asDateTime = TRUE, tz = "UTC"){
} else if (service == "featureOfInterest") {
if("siteNumbers" %in% names(dots)){
featureID <- na.omit(gsub(":",".",dots[['siteNumbers']]))
featureID <- stats::na.omit(gsub(":",".",dots[['siteNumbers']]))
allSites <- tryCatch({
retrieveFeatureOfInterest(featureID = featureID)
})
......@@ -117,22 +115,22 @@ readNGWMNdata <- function(service, ..., asDateTime = TRUE, tz = "UTC"){
#' @export
#'
#' @examples
#' \dontrun{
#' \donttest{
#' #one site
#' site <- "USGS.430427089284901"
#' oneSite <- readNGWMNlevels(siteNumbers = site)
#' #oneSite <- readNGWMNlevels(siteNumbers = site)
#'
#' #multiple sites
#' sites <- c("USGS:272838082142201","USGS:404159100494601", "USGS:401216080362703")
#' multiSiteData <- readNGWMNlevels(sites)
#' #multiSiteData <- readNGWMNlevels(sites)
#'
#' #non-USGS site
#' site <- "MBMG.892195"
#' data <- readNGWMNlevels(siteNumbers = site, asDateTime = FALSE)
#' site <- "MBMG.103306"
#' #data <- readNGWMNlevels(siteNumbers = site, asDateTime = FALSE)
#'
#' #site with no data returns empty data frame
#' noDataSite <- "UTGS.401544112060301"
#' noDataSite <- readNGWMNlevels(siteNumbers = noDataSite)
#' #noDataSite <- readNGWMNlevels(siteNumbers = noDataSite)
#' }
readNGWMNlevels <- function(siteNumbers, asDateTime = TRUE, tz = "UTC"){
data <- readNGWMNdata(siteNumbers = siteNumbers, service = "observation",
......@@ -154,17 +152,13 @@ readNGWMNlevels <- function(siteNumbers, asDateTime = TRUE, tz = "UTC"){
#' dec_lat_va, dec_lon_va \tab numeric \tab Site latitude and longitude \cr
#' }
#' @examples
#' \dontrun{
#' \donttest{
#' #one site
#' site <- "USGS.430427089284901"
#' oneSite <- readNGWMNsites(siteNumbers = site)
#'
#' #multiple sites
#' sites <- c("USGS:272838082142201","USGS:404159100494601", "USGS:401216080362703")
#' multiSiteInfo <- readNGWMNsites(sites)
#'
#' #non-USGS site
#' site <- "MBMG.892195"
#' site <- "MBMG.103306"
#' siteInfo <- readNGWMNsites(siteNumbers = site)
#'
#' }
......@@ -190,7 +184,7 @@ retrieveObservation <- function(featureID, asDateTime, attrs, tz){
if(nrow(returnData) > 0){
#tack on site number
siteNum <- rep(sub('.*\\.', '', featureID), nrow(returnData))
returnData <- mutate(returnData, site = siteNum)
returnData$site <- siteNum
numCol <- ncol(returnData)
returnData <- returnData[,c(numCol,1:(numCol - 1))] #move siteNum to the left
}
......
......@@ -56,7 +56,7 @@
#' @seealso \code{\link{renameNWISColumns}}, \code{\link{importWaterML1}}, \code{\link{importRDB1}}
#' @export
#' @examples
#' \dontrun{