From 44dd4da286c5732512c370d884db70ff3048245f Mon Sep 17 00:00:00 2001 From: wdwatkins Date: Fri, 16 Sep 2016 16:13:14 -0500 Subject: [PATCH 01/14] bbox working from retrieveFeatureOfInterest --- NAMESPACE | 4 +++ R/importNGWMN_wml2.R | 30 +++++++++++++-------- R/readNGWMNdata.R | 62 ++++++++++++++++++++++++++++++-------------- R/readNWISdata.r | 8 +++++- man/readNGWMNdata.Rd | 9 +++---- 5 files changed, 77 insertions(+), 36 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 6a2738c..53619e1 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -14,6 +14,7 @@ export(importWaterML1) export(importWaterML2) export(pCodeToName) export(parameterCdFile) +export(readNGWMNdata) export(readNGWMNlevels) export(readNGWMNsites) export(readNWISdata) @@ -31,6 +32,7 @@ export(readNWISuv) export(readWQPdata) export(readWQPqw) export(renameNWISColumns) +export(retrieveFeatureOfInterest) export(setAccess) export(stateCd) export(stateCdLookup) @@ -43,6 +45,7 @@ import(stats) import(utils) importFrom(curl,curl_version) importFrom(dplyr,arrange) +importFrom(dplyr,bind_cols) importFrom(dplyr,bind_rows) importFrom(dplyr,full_join) importFrom(dplyr,left_join) @@ -75,6 +78,7 @@ importFrom(xml2,xml_attr) importFrom(xml2,xml_attrs) importFrom(xml2,xml_children) importFrom(xml2,xml_find_all) +importFrom(xml2,xml_find_first) importFrom(xml2,xml_name) importFrom(xml2,xml_root) importFrom(xml2,xml_text) diff --git a/R/importNGWMN_wml2.R b/R/importNGWMN_wml2.R index 165df17..f053387 100644 --- a/R/importNGWMN_wml2.R +++ b/R/importNGWMN_wml2.R @@ -15,6 +15,7 @@ #' @importFrom xml2 xml_find_all #' @importFrom xml2 xml_text #' @importFrom xml2 xml_attr +#' @importFrom xml2 xml_find_first #' @importFrom lubridate parse_date_time #' @examples #' \dontrun{ @@ -120,23 +121,30 @@ importNGWMN_wml2 <- function(input, asDateTime=FALSE, tz=""){ mergedDF[nonDateCols][mergedDF[nonDateCols] == "" | mergedDF[nonDateCols]== -999999.0] <- NA attr(mergedDF, "gml:identifier") <- xml_text(xml_find_all(returnedDoc, ".//gml:identifier")) attr(mergedDF, "generationDate") <- xml_text(xml_find_all(returnedDoc, ".//wml2:generationDate")) - + meta <- xml_find_all(returnedDoc, ".//gmd:contact") + attr(mergedDF, "contact") <- xml_attr(meta, "href") + attr(mergedDF, "responsibleParty") <- xml_text(xml_find_all(meta, ".//gco:CharacterString")) + }else if(response == "GetFeatureOfInterestResponse"){ - site <- xml_text(xml_find_all(returnedDoc,".//gml:identifier")) + featureMembers <- xml_find_all(returnedDoc, ".//sos:featureMember") + site <- xml_text(xml_find_all(featureMembers,".//gml:identifier")) site <- substring(site, 8) - #bandaid to work with only single site calls #TODO: need better solution when bbox is added - #use number of children of right parent node? ie like xmlSize in XML - #and loop? - siteDesc <- xml_text(xml_find_all(returnedDoc, ".//gml:description")) - if(length(siteDesc) == 0){ - siteDesc <- NA - } + #some sites don't have a description + siteDesc <- xml_text(xml_find_first(featureMembers, ".//gml:description")) + #siteDesc <- xml_text(xml_find_all(returnedDoc, ".//gml:description")) + # if(length(siteDesc) == 0){ + # siteDesc <- NA + # } - siteLocs <- strsplit(xml_text(xml_find_all(returnedDoc, ".//gml:pos")), " ") - siteLocs <- data.frame(dec_lat_va=as.numeric(siteLocs[[1]][1]), dec_lon_va=as.numeric(siteLocs[[1]][2]), stringsAsFactors = FALSE) + siteLocs <- strsplit(xml_text(xml_find_all(featureMembers, ".//gml:pos")), " ") + #TODO: deal with multiple sites + siteLocs <- data.frame(matrix(unlist(siteLocs), nrow=length(siteLocs), byrow=TRUE), stringsAsFactors = FALSE) + names(siteLocs) <- c("dec_lat_va", "dec_lon_va") + siteLocs <- mutate(siteLocs, dec_lat_va=as.numeric(dec_lat_va), dec_lon_va=as.numeric(dec_lon_va)) + #siteLocs <- data.frame(dec_lat_va=as.numeric(siteLocs[[1]][1]), dec_lon_va=as.numeric(siteLocs[[1]][2]), stringsAsFactors = FALSE) mergedDF <- cbind.data.frame(site, description = siteDesc, siteLocs, stringsAsFactors = FALSE) } else{ diff --git a/R/readNGWMNdata.R b/R/readNGWMNdata.R index 77e981c..49b40e8 100644 --- a/R/readNGWMNdata.R +++ b/R/readNGWMNdata.R @@ -14,7 +14,8 @@ #' @import utils #' @importFrom dplyr mutate #' @importFrom dplyr bind_rows -#' +#' @importFrom dplyr bind_cols +#' @export #' @examples #' \dontrun{ #' #one site @@ -35,48 +36,56 @@ #' } #' -readNGWMNdata <- function(featureID, service = "observation", asDateTime = TRUE, tz = ""){ +readNGWMNdata <- function(..., service = "observation", asDateTime = TRUE, tz = ""){ message(" ******************************************************** DISCLAIMER: NGWMN retrieval functions are still in flux, and no future behavior or output is guaranteed *********************************************************") + #TODO: add getCapabilities match.arg(service, c("observation", "featureOfInterest")) - + dots <- list(...) if(service == "observation"){ allObs <- NULL allAttrs <- NULL allSites <- NULL #these attributes are pulled out and saved when doing binds to be reattached - attrs <- c("url","gml:identifier","generationDate") + attrs <- c("url","gml:identifier","generationDate","responsibleParty", "contact") for(f in featureID){ obsFID <- retrieveObservation(f, asDateTime, attrs) siteFID <- retrieveFeatureOfInterest(f, asDateTime) if(is.null(allObs)){ allObs <- obsFID - allSites <- siteFID allAttrs <- saveAttrs(attrs, allObs) + allSites <- bind_cols(siteFID,allAttrs) }else{ obsFIDatt <- saveAttrs(attrs, obsFID) obsFID <- removeAttrs(attrs, obsFID) - allAttrs <- bind_rows(allAttrs, obsFIDatt) allObs <- bind_rows(allObs, obsFID) - allSites <- bind_rows(allSites, siteFID) + obsSites <- bind_cols(siteFID, obsFIDatt) + allSites <- bind_rows(allSites, obsSites) } - attributes(allObs) <- c(attributes(allObs),as.list(allAttrs)) + attr(allObs, "siteInfo") <- allSites returnData <- allObs } }else if(service == "featureOfInterest"){ allSites <- NULL - for(f in featureID){ - siteFID <- retrieveFeatureOfInterest(f, asDateTime) - if(is.null(allSites)){ - allSites <- siteFID + if(exists("featureID")){ + #TODO: can do multi site calls with encoded comma + for(f in featureID){ + siteFID <- retrieveFeatureOfInterest(f, asDateTime) + if(is.null(allSites)){ + allSites <- siteFID }else{ - allSites <- bind_rows(allSites, siteFID) + allSites <- bind_rows(allSites, siteFID) + } } } + if(exists("bbox")){ + + } + returnData <- allSites }else{ stop("unrecognized service request") @@ -178,12 +187,27 @@ retrieveObservation <- function(featureID, asDateTime, attrs){ return(returnData) } -#retrieve feature of interest -#don't expose until can support bbox -#note: import function can only do single sites right now -retrieveFeatureOfInterest <- function(featureID, asDateTime){ - baseURL <- "http://cida.usgs.gov/ngwmn_cache/sos?request=GetFeatureOfInterest&service=SOS&version=2.0.0&observedProperty=urn:ogc:def:property:OGC:GroundWaterLevel&responseFormat=text/xml&featureOfInterest=VW_GWDP_GEOSERVER." - url <- paste0(baseURL, featureID) +#' retrieve feature of interest +#' +#' @export +#TODO: accomodate bbox +#TODO: can do multisite calls +retrieveFeatureOfInterest <- function(..., asDateTime, srsName="urn:ogc:def:crs:EPSG::4269"){ + baseURL <- "http://cida.usgs.gov/ngwmn_cache/sos?request=GetFeatureOfInterest&service=SOS&version=2.0.0" + dots <- list(...) + values <- convertDots(dots) + if("featureID" %in% names(values)){ + foiURL <- "&featureOfInterest=" + #paste on VW_GWDP.. to all foi + + + url <- paste0(baseURL, featureID) + }else if("bbox" %in% names(values)){ + bbox <- paste(values[['bbox']], collapse=",") + url <- paste0(baseURL, "&bbox=", bbox, "&srsName=",srsName) + }else{ + stop() + } siteDF <- importNGWMN_wml2(url, asDateTime) return(siteDF) } diff --git a/R/readNWISdata.r b/R/readNWISdata.r index b499cf7..042958e 100644 --- a/R/readNWISdata.r +++ b/R/readNWISdata.r @@ -118,7 +118,7 @@ readNWISdata <- function(service="dv", ..., asDateTime=TRUE,convertType=TRUE){ stop("Only one service call allowed.") } - values <- sapply(matchReturn, function(x) as.character(paste(eval(x),collapse=",",sep=""))) + values <- convertDots(matchReturn) names(values)[names(values) == "startDate"] <- "startDT" names(values)[names(values) == "endDate"] <- "endDT" @@ -323,5 +323,11 @@ countyCdLookup <- function(state, county, outputType = "id"){ fullEntry = countyCd[county,] ) + return(retVal) +} + +# convert variables in dots to usable format +convertDots <- function(matchReturn){ + retVal <- sapply(matchReturn, function(x) as.character(paste(eval(x),collapse=",",sep=""))) return(retVal) } \ No newline at end of file diff --git a/man/readNGWMNdata.Rd b/man/readNGWMNdata.Rd index a0d747e..588e361 100644 --- a/man/readNGWMNdata.Rd +++ b/man/readNGWMNdata.Rd @@ -4,13 +4,9 @@ \alias{readNGWMNdata} \title{import data from the National Groundwater Monitoring Network \url{http://cida.usgs.gov/ngwmn/}.} \usage{ -readNGWMNdata(featureID, service = "observation", asDateTime = TRUE, - tz = "") +readNGWMNdata(..., service = "observation", asDateTime = TRUE, tz = "") } \arguments{ -\item{featureID}{character Vector of feature IDs in the formatted with agency code and site number -separated by a period, e.g. \code{USGS.404159100494601}.} - \item{service}{character Identifies which web service to access. Only \code{observation} is currently supported, which retrieves all water level for each site.} @@ -21,6 +17,9 @@ supported, which retrieves all water level for each site.} datetimes to UTC (properly accounting for daylight savings times based on the data's provided time zone offset). Possible values to provide are "America/New_York","America/Chicago", "America/Denver","America/Los_Angeles", "America/Anchorage","America/Honolulu","America/Jamaica","America/Managua","America/Phoenix", and "America/Metlakatla"} + +\item{featureID}{character Vector of feature IDs in the formatted with agency code and site number +separated by a period, e.g. \code{USGS.404159100494601}.} } \description{ Only water level data is currently available through the web service. -- GitLab From b7d050206f2e3c74f0bb4f7a22e260a14b649364 Mon Sep 17 00:00:00 2001 From: wdwatkins Date: Mon, 26 Sep 2016 16:07:54 -0500 Subject: [PATCH 02/14] removed XML from description --- DESCRIPTION | 1 - 1 file changed, 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 7bf75bb..322de2b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -29,7 +29,6 @@ Copyright: This software is in the public domain because it contains materials Depends: R (>= 3.0) Imports: - XML, httr (>= 1.0.0), curl, reshape2, -- GitLab From 012f092298fa45ef3040de0bb19f5887c69b222c Mon Sep 17 00:00:00 2001 From: wdwatkins Date: Wed, 12 Oct 2016 16:01:56 -0500 Subject: [PATCH 03/14] featureOfInterest handles multi site and bbox --- R/importNGWMN_wml2.R | 6 ------ R/readNGWMNdata.R | 34 ++++++++++++-------------------- man/readNGWMNdata.Rd | 1 + man/retrieveFeatureOfInterest.Rd | 13 ++++++++++++ 4 files changed, 27 insertions(+), 27 deletions(-) create mode 100644 man/retrieveFeatureOfInterest.Rd diff --git a/R/importNGWMN_wml2.R b/R/importNGWMN_wml2.R index f053387..e34344a 100644 --- a/R/importNGWMN_wml2.R +++ b/R/importNGWMN_wml2.R @@ -131,16 +131,10 @@ importNGWMN_wml2 <- function(input, asDateTime=FALSE, tz=""){ site <- xml_text(xml_find_all(featureMembers,".//gml:identifier")) site <- substring(site, 8) - #TODO: need better solution when bbox is added #some sites don't have a description siteDesc <- xml_text(xml_find_first(featureMembers, ".//gml:description")) - #siteDesc <- xml_text(xml_find_all(returnedDoc, ".//gml:description")) - # if(length(siteDesc) == 0){ - # siteDesc <- NA - # } siteLocs <- strsplit(xml_text(xml_find_all(featureMembers, ".//gml:pos")), " ") - #TODO: deal with multiple sites siteLocs <- data.frame(matrix(unlist(siteLocs), nrow=length(siteLocs), byrow=TRUE), stringsAsFactors = FALSE) names(siteLocs) <- c("dec_lat_va", "dec_lon_va") siteLocs <- mutate(siteLocs, dec_lat_va=as.numeric(dec_lat_va), dec_lon_va=as.numeric(dec_lon_va)) diff --git a/R/readNGWMNdata.R b/R/readNGWMNdata.R index 49b40e8..96df3d7 100644 --- a/R/readNGWMNdata.R +++ b/R/readNGWMNdata.R @@ -26,6 +26,7 @@ #' sites <- c("USGS.272838082142201","USGS.404159100494601", "USGS.401216080362703") #' multiSiteData <- readNGWMNdata(sites) #' +#' #' #non-USGS site #' site <- "MBMG.892195" #' data <- readNGWMNdata(featureID = site) @@ -41,8 +42,8 @@ readNGWMNdata <- function(..., service = "observation", asDateTime = TRUE, tz = DISCLAIMER: NGWMN retrieval functions are still in flux, and no future behavior or output is guaranteed *********************************************************") - #TODO: add getCapabilities - match.arg(service, c("observation", "featureOfInterest")) + + match.arg(service, c("observation", "featureOfInterest", "getCapabilities")) dots <- list(...) if(service == "observation"){ @@ -70,27 +71,18 @@ readNGWMNdata <- function(..., service = "observation", asDateTime = TRUE, tz = returnData <- allObs } }else if(service == "featureOfInterest"){ - allSites <- NULL - if(exists("featureID")){ + if("featureID" %in% names(dots)){ #TODO: can do multi site calls with encoded comma - for(f in featureID){ - siteFID <- retrieveFeatureOfInterest(f, asDateTime) - if(is.null(allSites)){ - allSites <- siteFID - }else{ - allSites <- bind_rows(allSites, siteFID) - } - } + allSites <- retrieveFeatureOfInterest(featureID = dots[['featureID']], asDateTime=asDateTime) } - if(exists("bbox")){ - + if("bbox" %in% names(dots)){ + allSites <- retrieveFeatureOfInterest(bbox=dots[['bbox']]) } - returnData <- allSites }else{ - stop("unrecognized service request") + stop("getCapabilities is not yet implemented") + #TODO: fill in getCapabilites } - return(returnData) } @@ -190,18 +182,18 @@ retrieveObservation <- function(featureID, asDateTime, attrs){ #' retrieve feature of interest #' #' @export -#TODO: accomodate bbox #TODO: can do multisite calls +#TODO: allow pass through srsName retrieveFeatureOfInterest <- function(..., asDateTime, srsName="urn:ogc:def:crs:EPSG::4269"){ baseURL <- "http://cida.usgs.gov/ngwmn_cache/sos?request=GetFeatureOfInterest&service=SOS&version=2.0.0" dots <- list(...) values <- convertDots(dots) + if("featureID" %in% names(values)){ foiURL <- "&featureOfInterest=" - #paste on VW_GWDP.. to all foi - + fidURL <- paste("VW_GWDP_GEOSERVER", values[['featureID']], sep=".", collapse = "%2C") + url <- paste0(baseURL, foiURL, fidURL) - url <- paste0(baseURL, featureID) }else if("bbox" %in% names(values)){ bbox <- paste(values[['bbox']], collapse=",") url <- paste0(baseURL, "&bbox=", bbox, "&srsName=",srsName) diff --git a/man/readNGWMNdata.Rd b/man/readNGWMNdata.Rd index 588e361..5c72dcf 100644 --- a/man/readNGWMNdata.Rd +++ b/man/readNGWMNdata.Rd @@ -34,6 +34,7 @@ oneSite <- readNGWMNdata(featureID = site) sites <- c("USGS.272838082142201","USGS.404159100494601", "USGS.401216080362703") multiSiteData <- readNGWMNdata(sites) + #non-USGS site site <- "MBMG.892195" data <- readNGWMNdata(featureID = site) diff --git a/man/retrieveFeatureOfInterest.Rd b/man/retrieveFeatureOfInterest.Rd new file mode 100644 index 0000000..8bdf1e5 --- /dev/null +++ b/man/retrieveFeatureOfInterest.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/readNGWMNdata.R +\name{retrieveFeatureOfInterest} +\alias{retrieveFeatureOfInterest} +\title{retrieve feature of interest} +\usage{ +retrieveFeatureOfInterest(..., asDateTime, + srsName = "urn:ogc:def:crs:EPSG::4269") +} +\description{ +retrieve feature of interest +} + -- GitLab From ccaa1e0fb95c6815faca0f9326b8ff733c48c9fa Mon Sep 17 00:00:00 2001 From: wdwatkins Date: Fri, 21 Oct 2016 16:06:42 -0500 Subject: [PATCH 04/14] everything works for blog post --- R/readNGWMNdata.R | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/R/readNGWMNdata.R b/R/readNGWMNdata.R index 96df3d7..f6fc562 100644 --- a/R/readNGWMNdata.R +++ b/R/readNGWMNdata.R @@ -52,9 +52,11 @@ readNGWMNdata <- function(..., service = "observation", asDateTime = TRUE, tz = allSites <- NULL #these attributes are pulled out and saved when doing binds to be reattached attrs <- c("url","gml:identifier","generationDate","responsibleParty", "contact") + featureID <- as.vector(dots[['featureID']]) + #TODO: call featureOfInterest outside loop for(f in featureID){ - obsFID <- retrieveObservation(f, asDateTime, attrs) - siteFID <- retrieveFeatureOfInterest(f, asDateTime) + obsFID <- retrieveObservation(featureID = f, asDateTime, attrs) + siteFID <- retrieveFeatureOfInterest(featureID = f, asDateTime) if(is.null(allObs)){ allObs <- obsFID allAttrs <- saveAttrs(attrs, allObs) @@ -113,7 +115,7 @@ readNGWMNdata <- function(..., service = "observation", asDateTime = TRUE, tz = #' } readNGWMNlevels <- function(featureID){ - data <- readNGWMNdata(featureID, service = "observation") + data <- readNGWMNdata(featureID = featureID, service = "observation") return(data) } @@ -147,7 +149,7 @@ readNGWMNlevels <- function(featureID){ #' } readNGWMNsites <- function(featureID){ - sites <- readNGWMNdata(featureID, service = "featureOfInterest") + sites <- readNGWMNdata(featureID = featureID, service = "featureOfInterest") return(sites) } @@ -183,7 +185,7 @@ retrieveObservation <- function(featureID, asDateTime, attrs){ #' #' @export #TODO: can do multisite calls -#TODO: allow pass through srsName +#TODO: allow pass through srsName needs to be worked in higher-up in dots retrieveFeatureOfInterest <- function(..., asDateTime, srsName="urn:ogc:def:crs:EPSG::4269"){ baseURL <- "http://cida.usgs.gov/ngwmn_cache/sos?request=GetFeatureOfInterest&service=SOS&version=2.0.0" dots <- list(...) -- GitLab From b737c3a87b243d7e137c937f73620f150a720232 Mon Sep 17 00:00:00 2001 From: wdwatkins Date: Wed, 9 Nov 2016 11:40:41 -0600 Subject: [PATCH 05/14] small changes. Need to reorganize branches to split off NGWMN stuff --- NAMESPACE | 1 + R/importNGWMN_wml2.R | 2 ++ R/readNGWMNdata.R | 10 ++++++++-- man/importNGWMN_wml2.Rd | 1 + 4 files changed, 12 insertions(+), 2 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 53619e1..fbd0a1a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -73,6 +73,7 @@ importFrom(readr,read_delim) importFrom(readr,read_lines) importFrom(reshape2,dcast) importFrom(reshape2,melt) +importFrom(stats,na.omit) importFrom(xml2,read_xml) importFrom(xml2,xml_attr) importFrom(xml2,xml_attrs) diff --git a/R/importNGWMN_wml2.R b/R/importNGWMN_wml2.R index e34344a..1d5e71e 100644 --- a/R/importNGWMN_wml2.R +++ b/R/importNGWMN_wml2.R @@ -30,6 +30,8 @@ #' data <- importNGWMN_wml2(url) #' } #' +#' +#TODO: separate id and agency name, give also as separate dimensions importNGWMN_wml2 <- function(input, asDateTime=FALSE, tz=""){ if(tz != ""){ tz <- match.arg(tz, c("America/New_York","America/Chicago", diff --git a/R/readNGWMNdata.R b/R/readNGWMNdata.R index f6fc562..5d6f56b 100644 --- a/R/readNGWMNdata.R +++ b/R/readNGWMNdata.R @@ -15,6 +15,7 @@ #' @importFrom dplyr mutate #' @importFrom dplyr bind_rows #' @importFrom dplyr bind_cols +#' @importFrom stats na.omit #' @export #' @examples #' \dontrun{ @@ -36,7 +37,8 @@ #' noDataSite <- readNGWMNdata(featureID = noDataSite, service = "observation") #' } #' - +#TODO: accept colon or period! change examples +#TODO: deal with NA fIDs readNGWMNdata <- function(..., service = "observation", asDateTime = TRUE, tz = ""){ message(" ******************************************************** DISCLAIMER: NGWMN retrieval functions are still in flux, @@ -52,7 +54,11 @@ readNGWMNdata <- function(..., service = "observation", asDateTime = TRUE, tz = allSites <- NULL #these attributes are pulled out and saved when doing binds to be reattached attrs <- c("url","gml:identifier","generationDate","responsibleParty", "contact") - featureID <- as.vector(dots[['featureID']]) + featureID <- na.omit(gsub(":",".",dots[['featureID']])) + + #featureID <- na.omit(featureID) + #featureID <- featureID[!is.na(featureID)] + #featureID <- gsub(":",".",featureID) #getFeatureOfInterest returns with colons #TODO: call featureOfInterest outside loop for(f in featureID){ obsFID <- retrieveObservation(featureID = f, asDateTime, attrs) diff --git a/man/importNGWMN_wml2.Rd b/man/importNGWMN_wml2.Rd index 3c84af2..8dd6d64 100644 --- a/man/importNGWMN_wml2.Rd +++ b/man/importNGWMN_wml2.Rd @@ -36,5 +36,6 @@ Interest=VW_GWDP_GEOSERVER.USGS.474011117072901" data <- importNGWMN_wml2(url) } + } -- GitLab From 7151f7ff81ae585b5f5d5a1f8a44fcfcb4751faa Mon Sep 17 00:00:00 2001 From: wdwatkins Date: Mon, 28 Nov 2016 14:09:20 -0600 Subject: [PATCH 06/14] MBMG site wasn't working --- tests/testthat/tests_userFriendly_fxns.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/tests_userFriendly_fxns.R b/tests/testthat/tests_userFriendly_fxns.R index 9cb06f4..1925be3 100644 --- a/tests/testthat/tests_userFriendly_fxns.R +++ b/tests/testthat/tests_userFriendly_fxns.R @@ -233,7 +233,7 @@ test_that("NGWMN functions working", { expect_true(nrow(oneSite) > 0) #non-USGS site - data <- readNGWMNlevels(featureID = "MBMG.892195") + data <- readNGWMNlevels(featureID = "MBMG.1388") expect_true(nrow(data) > 1) expect_true(is.numeric(oneSite$value)) -- GitLab From 72317452af1db7c2ca2462baad3e71430d79d548 Mon Sep 17 00:00:00 2001 From: wdwatkins Date: Mon, 28 Nov 2016 13:32:43 -0600 Subject: [PATCH 07/14] changed Inst stat code --- R/renameColumns.R | 4 ++-- inst/extdata/WaterML1Example.xml | 2 +- man/renameNWISColumns.Rd | 2 +- tests/testthat/tests_userFriendly_fxns.R | 6 +++--- 4 files changed, 7 insertions(+), 7 deletions(-) diff --git a/R/renameColumns.R b/R/renameColumns.R index 0af8bcb..d062436 100644 --- a/R/renameColumns.R +++ b/R/renameColumns.R @@ -21,13 +21,13 @@ #' @return A dataset like \code{data} with selected columns renamed. #' @note The following statistics codes are converted by \code{renameNWISColumns}. #'\describe{ +#'\item{00000}{Instantaneous Value, suffix: Inst} #'\item{00001}{Maximum value, suffix: Max} #'\item{00002}{Minimum value, suffix: Min} #'\item{00003}{Mean value, no suffix} #'\item{00006}{Sum of values, suffix: Sum} #'\item{00007}{Modal value, suffix: Mode} #'\item{00008}{Median value, suffix: Median} -#'\item{00011}{Instantaneous Value, suffix: Inst} #'\item{00012}{Equivalent mean value, suffix: EqMean} #'\item{00021}{Tidal high-high value, suffix: HiHiTide} #'\item{00022}{Tidal low-high value, suffix: LoHiTide} @@ -69,13 +69,13 @@ renameNWISColumns <- function(rawData, p00010="Wtemp", p00045="Precip", Conv$p63680 <- p63680 Conv$p72019 <- p72019 + Conv$s00000<- "Inst" # Why is this in dv? Conv$s00001 <- "Max" Conv$s00002 <- "Min" Conv$s00003 <- "" Conv$s00006 <- "Sum" Conv$s00007 <- "Mode" Conv$s00008 <- "Median" - Conv$s00011<- "Inst" # Why is this in dv? Conv$s00012<- "EqMean" Conv$s00021<- "HiHiTide" Conv$s00022<- "LoHiTide" diff --git a/inst/extdata/WaterML1Example.xml b/inst/extdata/WaterML1Example.xml index 9799b97..4c461cc 100644 --- a/inst/extdata/WaterML1Example.xml +++ b/inst/extdata/WaterML1Example.xml @@ -1 +1 @@ -http://127.0.0.1:8080/nwis/iv/[ALL:01491000][00060]2012-05-12T00:00:00.0002012-05-13T23:59:59.000[ALL:01491000][mode=RANGE, modifiedSince=null] interval={INTERVAL[2012-05-12T00:00:00.000-04:00/2012-05-13T23:59:59.000Z]}methodIds=[ALL]2014-01-27T20:28:56.939Za5965f70-8791-11e3-a574-0010188f98a0Provisional data are subject to revision. Go to http://waterdata.usgs.gov/nwis/help/?provisional for more information.nadww01CHOPTANK RIVER NEAR GREENSBORO, MD0149100038.99719444-75.7858056ST02060005242401100060Streamflow, ft&#179;/sDischarge, cubic feet per secondDerived Valueft3/s-999999.0838383838583838383818181818181818179798179797979797977777777777777777777777775757575757577757575737573757573757373737173737573737373717173697371696971696969676767676767676767676767666966666666666666666666666666666666646464646464646466646666646464646464646464646464646464646464636464646364636464646363646363636363636363636364636462626363626362626161616362616262626261626262616161616060AApproved for publication -- Processing and review completed. +http://127.0.0.1:8080/nwis/iv/[ALL:01491000][00060]2012-05-12T00:00:00.0002012-05-13T23:59:59.000[ALL:01491000][mode=RANGE, modifiedSince=null] interval={INTERVAL[2012-05-12T00:00:00.000-04:00/2012-05-13T23:59:59.000Z]}methodIds=[ALL]2014-01-27T20:28:56.939Za5965f70-8791-11e3-a574-0010188f98a0Provisional data are subject to revision. Go to http://waterdata.usgs.gov/nwis/help/?provisional for more information.nadww01CHOPTANK RIVER NEAR GREENSBORO, MD0149100038.99719444-75.7858056ST02060005242401100060Streamflow, ft&#179;/sDischarge, cubic feet per secondDerived Valueft3/s-999999.0838383838583838383818181818181818179798179797979797977777777777777777777777775757575757577757575737573757573757373737173737573737373717173697371696971696969676767676767676767676767666966666666666666666666666666666666646464646464646466646666646464646464646464646464646464646464636464646364636464646363646363636363636363636364636462626363626362626161616362616262626261626262616161616060AApproved for publication -- Processing and review completed. diff --git a/man/renameNWISColumns.Rd b/man/renameNWISColumns.Rd index e877e04..ab2dcfe 100644 --- a/man/renameNWISColumns.Rd +++ b/man/renameNWISColumns.Rd @@ -46,13 +46,13 @@ to rename those columns. \note{ The following statistics codes are converted by \code{renameNWISColumns}. \describe{ +\item{00000}{Instantaneous Value, suffix: Inst} \item{00001}{Maximum value, suffix: Max} \item{00002}{Minimum value, suffix: Min} \item{00003}{Mean value, no suffix} \item{00006}{Sum of values, suffix: Sum} \item{00007}{Modal value, suffix: Mode} \item{00008}{Median value, suffix: Median} -\item{00011}{Instantaneous Value, suffix: Inst} \item{00012}{Equivalent mean value, suffix: EqMean} \item{00021}{Tidal high-high value, suffix: HiHiTide} \item{00022}{Tidal low-high value, suffix: LoHiTide} diff --git a/tests/testthat/tests_userFriendly_fxns.R b/tests/testthat/tests_userFriendly_fxns.R index 1925be3..2591453 100644 --- a/tests/testthat/tests_userFriendly_fxns.R +++ b/tests/testthat/tests_userFriendly_fxns.R @@ -31,9 +31,9 @@ test_that("Unit value data returns correct types", { endDate <- "2012-07-17" dd_2 <- readNWISuv(site, pCode, startDate, endDate) expect_true(all(names(dd_2) %in% c("agency_cd","site_no", - "dateTime","X_.YSI.6136.UP._63680_00011", - "X_YSI.6136.DOWN_63680_00011","X_.YSI.6136.UP._63680_00011_cd", - "X_YSI.6136.DOWN_63680_00011_cd","tz_cd"))) + "dateTime","X_.YSI.6136.UP._63680_00000", + "X_YSI.6136.DOWN_63680_00000","X_.YSI.6136.UP._63680_00000_cd", + "X_YSI.6136.DOWN_63680_00000_cd","tz_cd"))) }) -- GitLab From 246811f059b6cb05a33e24a9d719a472414295d6 Mon Sep 17 00:00:00 2001 From: wdwatkins Date: Thu, 2 Feb 2017 12:53:48 -0600 Subject: [PATCH 08/14] trying cida-test --- R/readNGWMNdata.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/readNGWMNdata.R b/R/readNGWMNdata.R index 5d6f56b..547c47a 100644 --- a/R/readNGWMNdata.R +++ b/R/readNGWMNdata.R @@ -163,7 +163,7 @@ readNGWMNsites <- function(featureID){ retrieveObservation <- function(featureID, asDateTime, attrs){ #will need to contruct this more piece by piece if other versions, properties are added - baseURL <- "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." + baseURL <- "http://cida-test.er.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." url <- paste0(baseURL, featureID) returnData <- importNGWMN_wml2(url, asDateTime) @@ -193,7 +193,7 @@ retrieveObservation <- function(featureID, asDateTime, attrs){ #TODO: can do multisite calls #TODO: allow pass through srsName needs to be worked in higher-up in dots retrieveFeatureOfInterest <- function(..., asDateTime, srsName="urn:ogc:def:crs:EPSG::4269"){ - baseURL <- "http://cida.usgs.gov/ngwmn_cache/sos?request=GetFeatureOfInterest&service=SOS&version=2.0.0" + baseURL <- "http://cida-test.usgs.gov/ngwmn_cache/sos?request=GetFeatureOfInterest&service=SOS&version=2.0.0" dots <- list(...) values <- convertDots(dots) -- GitLab From 1f6d8d01a9d7722e48621e4679a747c297f8a1b2 Mon Sep 17 00:00:00 2001 From: wdwatkins Date: Thu, 16 Feb 2017 16:35:17 -0600 Subject: [PATCH 09/14] big requests working on test --- DESCRIPTION | 2 +- R/readNGWMNdata.R | 36 +++++++++++------------- man/checkWQPdates.Rd | 1 - man/constructNWISURL.Rd | 1 - man/constructUseURL.Rd | 1 - man/constructWQPURL.Rd | 1 - man/countyCd.Rd | 1 - man/countyCdLookup.Rd | 1 - man/dataRetrieval-package.Rd | 1 - man/getQuerySummary.Rd | 1 - man/getWebServiceData.Rd | 1 - man/importNGWMN_wml2.Rd | 1 - man/importRDB1.Rd | 1 - man/importWQP.Rd | 1 - man/importWaterML1.Rd | 1 - man/importWaterML2.Rd | 1 - man/pCodeToName.Rd | 1 - man/parameterCdFile.Rd | 1 - man/readNGWMNdata.Rd | 1 - man/readNGWMNlevels.Rd | 1 - man/readNGWMNsites.Rd | 1 - man/readNWISdata.Rd | 5 ++-- man/readNWISdv.Rd | 1 - man/readNWISgwl.Rd | 1 - man/readNWISmeas.Rd | 1 - man/readNWISpCode.Rd | 1 - man/readNWISpeak.Rd | 1 - man/readNWISqw.Rd | 1 - man/readNWISrating.Rd | 1 - man/readNWISsite.Rd | 1 - man/readNWISstat.Rd | 1 - man/readNWISuse.Rd | 1 - man/readNWISuv.Rd | 1 - man/readWQPdata.Rd | 5 ++-- man/readWQPqw.Rd | 1 - man/renameNWISColumns.Rd | 1 - man/retrieveFeatureOfInterest.Rd | 1 - man/setAccess.Rd | 1 - man/stateCd.Rd | 1 - man/stateCdLookup.Rd | 1 - man/whatNWISdata.Rd | 1 - man/whatNWISsites.Rd | 1 - man/whatWQPsites.Rd | 5 ++-- man/zeroPad.Rd | 1 - tests/testthat/tests_userFriendly_fxns.R | 5 ++++ 45 files changed, 28 insertions(+), 69 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 322de2b..789ae25 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -46,4 +46,4 @@ VignetteBuilder: knitr BuildVignettes: true BugReports: https://github.com/USGS-R/dataRetrieval/issues URL: https://github.com/USGS-R/dataRetrieval, http://pubs.usgs.gov/tm/04/a10/ -RoxygenNote: 5.0.1 +RoxygenNote: 6.0.1 diff --git a/R/readNGWMNdata.R b/R/readNGWMNdata.R index 547c47a..01fadb2 100644 --- a/R/readNGWMNdata.R +++ b/R/readNGWMNdata.R @@ -49,9 +49,9 @@ readNGWMNdata <- function(..., service = "observation", asDateTime = TRUE, tz = dots <- list(...) if(service == "observation"){ - allObs <- NULL - allAttrs <- NULL - allSites <- NULL + allObs <- data.frame() + allAttrs <- data.frame() + #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[['featureID']])) @@ -62,26 +62,22 @@ readNGWMNdata <- function(..., service = "observation", asDateTime = TRUE, tz = #TODO: call featureOfInterest outside loop for(f in featureID){ obsFID <- retrieveObservation(featureID = f, asDateTime, attrs) - siteFID <- retrieveFeatureOfInterest(featureID = f, asDateTime) - if(is.null(allObs)){ - allObs <- obsFID - allAttrs <- saveAttrs(attrs, allObs) - allSites <- bind_cols(siteFID,allAttrs) - }else{ - obsFIDatt <- saveAttrs(attrs, obsFID) - obsFID <- removeAttrs(attrs, obsFID) - allObs <- bind_rows(allObs, obsFID) - obsSites <- bind_cols(siteFID, obsFIDatt) - allSites <- bind_rows(allSites, obsSites) - } + obsFIDattr <- saveAttrs(attrs, obsFID) + obsFID <- removeAttrs(attrs, obsFID) + allObs <- bind_rows(allObs, obsFID) + allAttrs <- bind_rows(allAttrs, obsFIDattr) - attr(allObs, "siteInfo") <- allSites - returnData <- allObs } + allSites <- retrieveFeatureOfInterest(featureID = featureID) + attr(allObs, "siteInfo") <- allSites + attr(allObs, "other") <- allAttrs + returnData <- allObs + }else if(service == "featureOfInterest"){ if("featureID" %in% names(dots)){ + featureID <- na.omit(gsub(":",".",dots[['featureID']])) #TODO: can do multi site calls with encoded comma - allSites <- retrieveFeatureOfInterest(featureID = dots[['featureID']], asDateTime=asDateTime) + allSites <- retrieveFeatureOfInterest(featureID = featureID) } if("bbox" %in% names(dots)){ allSites <- retrieveFeatureOfInterest(bbox=dots[['bbox']]) @@ -163,7 +159,7 @@ readNGWMNsites <- function(featureID){ retrieveObservation <- function(featureID, asDateTime, attrs){ #will need to contruct this more piece by piece if other versions, properties are added - baseURL <- "http://cida-test.er.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." + baseURL <- "https://cida-test.er.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." url <- paste0(baseURL, featureID) returnData <- importNGWMN_wml2(url, asDateTime) @@ -193,7 +189,7 @@ retrieveObservation <- function(featureID, asDateTime, attrs){ #TODO: can do multisite calls #TODO: allow pass through srsName needs to be worked in higher-up in dots retrieveFeatureOfInterest <- function(..., asDateTime, srsName="urn:ogc:def:crs:EPSG::4269"){ - baseURL <- "http://cida-test.usgs.gov/ngwmn_cache/sos?request=GetFeatureOfInterest&service=SOS&version=2.0.0" + baseURL <- "https://cida-test.er.usgs.gov/ngwmn_cache/sos?request=GetFeatureOfInterest&service=SOS&version=2.0.0" dots <- list(...) values <- convertDots(dots) diff --git a/man/checkWQPdates.Rd b/man/checkWQPdates.Rd index ca07a31..9c4f71d 100644 --- a/man/checkWQPdates.Rd +++ b/man/checkWQPdates.Rd @@ -22,4 +22,3 @@ values <- list(startDateLo="01-01-2002", characteristicName="Phosphorous", values <- checkWQPdates(values) } \keyword{internal} - diff --git a/man/constructNWISURL.Rd b/man/constructNWISURL.Rd index 5976ed5..8d280dc 100644 --- a/man/constructNWISURL.Rd +++ b/man/constructNWISURL.Rd @@ -76,4 +76,3 @@ urlQW <- constructNWISURL("450456092225801","70300",startDate="",endDate="","qw" \keyword{import} \keyword{service} \keyword{web} - diff --git a/man/constructUseURL.Rd b/man/constructUseURL.Rd index 9281bfa..7188a19 100644 --- a/man/constructUseURL.Rd +++ b/man/constructUseURL.Rd @@ -25,4 +25,3 @@ Reconstructs URLs to retrieve data from here: \url{http://waterdata.usgs.gov/nwi url <- constructUseURL(years=c(1990,1995),stateCd="Ohio",countyCd = c(1,3), categories = "ALL") } - diff --git a/man/constructWQPURL.Rd b/man/constructWQPURL.Rd index 53dace3..55096c4 100644 --- a/man/constructWQPURL.Rd +++ b/man/constructWQPURL.Rd @@ -41,4 +41,3 @@ url_wqp <- constructWQPURL(paste("USGS",siteNumber,sep="-"), \keyword{import} \keyword{service} \keyword{web} - diff --git a/man/countyCd.Rd b/man/countyCd.Rd index 03502a2..6bad0a8 100644 --- a/man/countyCd.Rd +++ b/man/countyCd.Rd @@ -25,4 +25,3 @@ head(countyCd) } \keyword{USGS} \keyword{countyCd} - diff --git a/man/countyCdLookup.Rd b/man/countyCdLookup.Rd index 870cdf6..454ce7f 100644 --- a/man/countyCdLookup.Rd +++ b/man/countyCdLookup.Rd @@ -23,4 +23,3 @@ name <- countyCdLookup(state = "OH", county = 13, output = "fullName") index <- countyCdLookup(state = "Pennsylvania", county = "ALLEGHENY COUNTY", output = "tableIndex") fromIDs <- countyCdLookup(state = 13, county = 5, output = "fullName") } - diff --git a/man/dataRetrieval-package.Rd b/man/dataRetrieval-package.Rd index 22a187e..c5039d1 100644 --- a/man/dataRetrieval-package.Rd +++ b/man/dataRetrieval-package.Rd @@ -28,4 +28,3 @@ Robert M. Hirsch \email{rhirsch@usgs.gov}, Laura De Cicco \email{ldecicco@usgs.g \keyword{USGS,} \keyword{services} \keyword{web} - diff --git a/man/getQuerySummary.Rd b/man/getQuerySummary.Rd index 6365801..edae20d 100644 --- a/man/getQuerySummary.Rd +++ b/man/getQuerySummary.Rd @@ -12,4 +12,3 @@ getQuerySummary(url) \description{ getting header information from a WQP query } - diff --git a/man/getWebServiceData.Rd b/man/getWebServiceData.Rd index edb2fa2..5877810 100644 --- a/man/getWebServiceData.Rd +++ b/man/getWebServiceData.Rd @@ -29,4 +29,3 @@ obs_url <- constructNWISURL(siteNumber,property,startDate,endDate,'dv') rawData <- getWebServiceData(obs_url) } } - diff --git a/man/importNGWMN_wml2.Rd b/man/importNGWMN_wml2.Rd index 8dd6d64..ba103b1 100644 --- a/man/importNGWMN_wml2.Rd +++ b/man/importNGWMN_wml2.Rd @@ -38,4 +38,3 @@ data <- importNGWMN_wml2(url) } - diff --git a/man/importRDB1.Rd b/man/importRDB1.Rd index 1dd0c2e..8b6feb8 100644 --- a/man/importRDB1.Rd +++ b/man/importRDB1.Rd @@ -89,4 +89,3 @@ fullPath <- file.path(filePath, fileName) importUserRDB <- importRDB1(fullPath) } - diff --git a/man/importWQP.Rd b/man/importWQP.Rd index bee8a94..10943cb 100644 --- a/man/importWQP.Rd +++ b/man/importWQP.Rd @@ -42,4 +42,3 @@ STORETdata <- importWQP(STORETex) \seealso{ \code{\link{readWQPdata}}, \code{\link{readWQPqw}}, \code{\link{whatWQPsites}} } - diff --git a/man/importWaterML1.Rd b/man/importWaterML1.Rd index 0123d0d..feda0a9 100644 --- a/man/importWaterML1.Rd +++ b/man/importWaterML1.Rd @@ -107,4 +107,3 @@ importFile <- importWaterML1(fullPath,TRUE) \seealso{ \code{\link{renameNWISColumns}} } - diff --git a/man/importWaterML2.Rd b/man/importWaterML2.Rd index cd530b3..983734f 100644 --- a/man/importWaterML2.Rd +++ b/man/importWaterML2.Rd @@ -51,4 +51,3 @@ fullPath <- file.path(filePath, fileName) UserData <- importWaterML2(fullPath) } - diff --git a/man/pCodeToName.Rd b/man/pCodeToName.Rd index 8ca26c6..8006e15 100644 --- a/man/pCodeToName.Rd +++ b/man/pCodeToName.Rd @@ -31,4 +31,3 @@ Data pulled from Water Quality Portal on November 25, 2014. The data was pulled head(pCodeToName[,1:2]) } \keyword{internal} - diff --git a/man/parameterCdFile.Rd b/man/parameterCdFile.Rd index a1f5c88..13da624 100644 --- a/man/parameterCdFile.Rd +++ b/man/parameterCdFile.Rd @@ -26,4 +26,3 @@ format=rdb&show=parameter_group_nm&show=parameter_nm&show=casrn&show=srsname&sho head(parameterCdFile[,1:2]) } \keyword{internal} - diff --git a/man/readNGWMNdata.Rd b/man/readNGWMNdata.Rd index 5c72dcf..d3b451b 100644 --- a/man/readNGWMNdata.Rd +++ b/man/readNGWMNdata.Rd @@ -45,4 +45,3 @@ noDataSite <- readNGWMNdata(featureID = noDataSite, service = "observation") } } - diff --git a/man/readNGWMNlevels.Rd b/man/readNGWMNlevels.Rd index 1d97a45..987cad5 100644 --- a/man/readNGWMNlevels.Rd +++ b/man/readNGWMNlevels.Rd @@ -32,4 +32,3 @@ noDataSite <- "UTGS.401544112060301" noDataSite <- readNGWMNlevels(featureID = noDataSite) } } - diff --git a/man/readNGWMNsites.Rd b/man/readNGWMNsites.Rd index e19e9b2..c253b2d 100644 --- a/man/readNGWMNsites.Rd +++ b/man/readNGWMNsites.Rd @@ -38,4 +38,3 @@ siteInfo <- readNGWMNsites(featureID = site) } } - diff --git a/man/readNWISdata.Rd b/man/readNWISdata.Rd index 4849f69..b57d263 100644 --- a/man/readNWISdata.Rd +++ b/man/readNWISdata.Rd @@ -13,12 +13,12 @@ statistics service). Note: "qw" and "measurement" calls go to: \url{http://nwis.waterdata.usgs.gov/usa/nwis} for data requests, and use different call requests schemes. The statistics service has a limited selection of arguments (see \url{http://waterservices.usgs.gov/rest/Statistics-Service-Test-Tool.html}).} +\item{\dots}{see \url{http://waterservices.usgs.gov/rest/Site-Service.html#Service} for a complete list of options} + \item{asDateTime}{logical, if \code{TRUE} returns date and time as POSIXct, if \code{FALSE}, Date} \item{convertType}{logical, defaults to \code{TRUE}. If \code{TRUE}, the function will convert the data to dates, datetimes, numerics based on a standard algorithm. If false, everything is returned as a character} - -\item{\dots}{see \url{http://waterservices.usgs.gov/rest/Site-Service.html#Service} for a complete list of options} } \value{ A data frame with the following columns: @@ -115,4 +115,3 @@ dailyWV <- readNWISdata(stateCd = "West Virginia", parameterCd = "00060") \seealso{ \code{\link{renameNWISColumns}}, \code{\link{importWaterML1}}, \code{\link{importRDB1}} } - diff --git a/man/readNWISdv.Rd b/man/readNWISdv.Rd index 9e4862c..e9b46e6 100644 --- a/man/readNWISdv.Rd +++ b/man/readNWISdv.Rd @@ -79,4 +79,3 @@ notActive <- readNWISdv(site, "00060", "2014-01-01","2014-01-07") \keyword{import} \keyword{service} \keyword{web} - diff --git a/man/readNWISgwl.Rd b/man/readNWISgwl.Rd index bb2f6c6..b3a302f 100644 --- a/man/readNWISgwl.Rd +++ b/man/readNWISgwl.Rd @@ -70,4 +70,3 @@ data4 <- readNWISgwl("425957088141001", startDate = "1980-01-01") \seealso{ \code{\link{constructNWISURL}}, \code{\link{importRDB1}} } - diff --git a/man/readNWISmeas.Rd b/man/readNWISmeas.Rd index 89b9690..144b103 100644 --- a/man/readNWISmeas.Rd +++ b/man/readNWISmeas.Rd @@ -69,4 +69,3 @@ Meas07227500.exRaw <- readNWISmeas("07227500",expanded=TRUE, convertType = FALSE \seealso{ \code{\link{constructNWISURL}}, \code{\link{importRDB1}} } - diff --git a/man/readNWISpCode.Rd b/man/readNWISpCode.Rd index 293a72c..aef98c5 100644 --- a/man/readNWISpCode.Rd +++ b/man/readNWISpCode.Rd @@ -39,4 +39,3 @@ paramINFO <- readNWISpCode(c('01075','00060','00931', NA)) \keyword{import} \keyword{service} \keyword{web} - diff --git a/man/readNWISpeak.Rd b/man/readNWISpeak.Rd index 8e32a65..52846fd 100644 --- a/man/readNWISpeak.Rd +++ b/man/readNWISpeak.Rd @@ -69,4 +69,3 @@ peakdata<-readNWISpeak(stations,convertType=FALSE) \seealso{ \code{\link{constructNWISURL}}, \code{\link{importRDB1}} } - diff --git a/man/readNWISqw.Rd b/man/readNWISqw.Rd index 1b4f38a..f5b6b63 100644 --- a/man/readNWISqw.Rd +++ b/man/readNWISqw.Rd @@ -119,4 +119,3 @@ rawNWISOpe <- readNWISqw(siteNumbers,"OPE", \keyword{import} \keyword{service} \keyword{web} - diff --git a/man/readNWISrating.Rd b/man/readNWISrating.Rd index 24c74bd..dedfbd4 100644 --- a/man/readNWISrating.Rd +++ b/man/readNWISrating.Rd @@ -54,4 +54,3 @@ attr(data, "RATING") \seealso{ \code{\link{constructNWISURL}}, \code{\link{importRDB1}} } - diff --git a/man/readNWISsite.Rd b/man/readNWISsite.Rd index 066c827..56dcba8 100644 --- a/man/readNWISsite.Rd +++ b/man/readNWISsite.Rd @@ -79,4 +79,3 @@ siteINFOMulti <- readNWISsite(c('05114000','09423350')) \keyword{import} \keyword{service} \keyword{web} - diff --git a/man/readNWISstat.Rd b/man/readNWISstat.Rd index 7e6a37b..2aee70f 100644 --- a/man/readNWISstat.Rd +++ b/man/readNWISstat.Rd @@ -74,4 +74,3 @@ x <- readNWISstat(siteNumbers=c("02171500"), \seealso{ \code{\link{constructNWISURL}}, \code{\link{importRDB1}} } - diff --git a/man/readNWISuse.Rd b/man/readNWISuse.Rd index 71869f7..f3829c7 100644 --- a/man/readNWISuse.Rd +++ b/man/readNWISuse.Rd @@ -59,4 +59,3 @@ paData <- readNWISuse(stateCd = "42",countyCd = c("Allegheny County", "BUTLER", ks <- readNWISuse(stateCd = "KS", countyCd = NULL, categories = c("IT","LI")) } } - diff --git a/man/readNWISuv.Rd b/man/readNWISuv.Rd index 757bf07..30d804a 100644 --- a/man/readNWISuv.Rd +++ b/man/readNWISuv.Rd @@ -87,4 +87,3 @@ GMTdata <- readNWISuv(siteNumber,parameterCd, \keyword{import} \keyword{service} \keyword{web} - diff --git a/man/readWQPdata.Rd b/man/readWQPdata.Rd index 59804ce..9dd054d 100644 --- a/man/readWQPdata.Rd +++ b/man/readWQPdata.Rd @@ -7,11 +7,11 @@ readWQPdata(..., zip = FALSE, querySummary = FALSE) } \arguments{ +\item{\dots}{see \url{www.waterqualitydata.us/webservices_documentation.jsp} for a complete list of options} + \item{zip}{logical to request data via downloading zip file. Default set to FALSE.} \item{querySummary}{logical to ONLY return the number of records and unique sites that will be returned from this query.} - -\item{\dots}{see \url{www.waterqualitydata.us/webservices_documentation.jsp} for a complete list of options} } \value{ A data frame with at least the following columns: @@ -116,4 +116,3 @@ nutrientDaneCounty <- readWQPdata(countycode="US:55:025",startDate=startDate, \keyword{import} \keyword{service} \keyword{web} - diff --git a/man/readWQPqw.Rd b/man/readWQPqw.Rd index ee50f73..40100d7 100644 --- a/man/readWQPqw.Rd +++ b/man/readWQPqw.Rd @@ -135,4 +135,3 @@ nwisEx.summary <- readWQPqw('USGS-04024000',c('34247','30234','32104','34220'), \keyword{import} \keyword{service} \keyword{web} - diff --git a/man/renameNWISColumns.Rd b/man/renameNWISColumns.Rd index ab2dcfe..d243226 100644 --- a/man/renameNWISColumns.Rd +++ b/man/renameNWISColumns.Rd @@ -79,4 +79,3 @@ rdbResults <- renameNWISColumns(rdbResults) } \keyword{IO} \keyword{manip} - diff --git a/man/retrieveFeatureOfInterest.Rd b/man/retrieveFeatureOfInterest.Rd index 8bdf1e5..4b83f21 100644 --- a/man/retrieveFeatureOfInterest.Rd +++ b/man/retrieveFeatureOfInterest.Rd @@ -10,4 +10,3 @@ retrieveFeatureOfInterest(..., asDateTime, \description{ retrieve feature of interest } - diff --git a/man/setAccess.Rd b/man/setAccess.Rd index 9bf57fc..1fb7a0c 100644 --- a/man/setAccess.Rd +++ b/man/setAccess.Rd @@ -32,4 +32,3 @@ setAccess('public') \author{ Luke Winslow, Jordan S Read } - diff --git a/man/stateCd.Rd b/man/stateCd.Rd index 314b97f..8b906c0 100644 --- a/man/stateCd.Rd +++ b/man/stateCd.Rd @@ -24,4 +24,3 @@ head(stateCd) } \keyword{USGS} \keyword{stateCd} - diff --git a/man/stateCdLookup.Rd b/man/stateCdLookup.Rd index 377d6be..05d015f 100644 --- a/man/stateCdLookup.Rd +++ b/man/stateCdLookup.Rd @@ -24,4 +24,3 @@ index <- stateCdLookup("WI", "tableIndex") stateCd[index,] stateCdLookup(c("West Virginia", "Wisconsin", 55, "MN")) } - diff --git a/man/whatNWISdata.Rd b/man/whatNWISdata.Rd index 05bb05b..481782d 100644 --- a/man/whatNWISdata.Rd +++ b/man/whatNWISdata.Rd @@ -82,4 +82,3 @@ flowAndTemp <- whatNWISdata(siteNumbers, parameterCd=c("00060","00010")) \keyword{import} \keyword{service} \keyword{web} - diff --git a/man/whatNWISsites.Rd b/man/whatNWISsites.Rd index 3edf79b..4961b9f 100644 --- a/man/whatNWISsites.Rd +++ b/man/whatNWISsites.Rd @@ -39,4 +39,3 @@ Mapper format is used siteListPhos <- whatNWISsites(stateCd="OH",parameterCd="00665") } } - diff --git a/man/whatWQPsites.Rd b/man/whatWQPsites.Rd index efd0d23..00f5e03 100644 --- a/man/whatWQPsites.Rd +++ b/man/whatWQPsites.Rd @@ -7,9 +7,9 @@ whatWQPsites(..., zip = FALSE) } \arguments{ -\item{zip}{logical to request data via downloading zip file. Default set to FALSE.} - \item{\dots}{see \url{www.waterqualitydata.us/webservices_documentation.jsp} for a complete list of options} + +\item{zip}{logical to request data via downloading zip file. Default set to FALSE.} } \value{ A data frame with at least the following columns: @@ -72,4 +72,3 @@ lakeSites <- whatWQPsites(siteType = "Lake, Reservoir, Impoundment", statecode = \keyword{import} \keyword{service} \keyword{web} - diff --git a/man/zeroPad.Rd b/man/zeroPad.Rd index 9c67705..06219a4 100644 --- a/man/zeroPad.Rd +++ b/man/zeroPad.Rd @@ -30,4 +30,3 @@ padPCodeNA <- zeroPad(pCodeNA,4) \keyword{import} \keyword{service} \keyword{web} - diff --git a/tests/testthat/tests_userFriendly_fxns.R b/tests/testthat/tests_userFriendly_fxns.R index 2591453..bb0dc86 100644 --- a/tests/testthat/tests_userFriendly_fxns.R +++ b/tests/testthat/tests_userFriendly_fxns.R @@ -222,6 +222,10 @@ test_that("NGWMN functions working", { noDataSite <- readNGWMNlevels(featureID = noDataSite) expect_true(is.data.frame(noDataSite)) + #bounding box and a bigger request + bboxSites <- readNGWMNdata(service = "featureOfInterest", bbox = c(30, -99, 31, 102)) + siteInfo <- readNGWMNsites(bboxSites$site[1:100]) + #one site site <- "USGS.430427089284901" oneSite <- readNGWMNlevels(featureID = site) @@ -237,6 +241,7 @@ test_that("NGWMN functions working", { expect_true(nrow(data) > 1) expect_true(is.numeric(oneSite$value)) + }) -- GitLab From f9182029f1f7ca23d30424aa77123e64db480b4a Mon Sep 17 00:00:00 2001 From: wdwatkins Date: Fri, 17 Feb 2017 16:13:45 -0600 Subject: [PATCH 10/14] cleaned up TODOs --- R/importNGWMN_wml2.R | 5 ++-- R/importWaterML2.r | 1 - R/readNGWMNdata.R | 35 +++++++++++------------- man/readNGWMNdata.Rd | 9 +++--- man/readNGWMNlevels.Rd | 6 +++- tests/testthat/tests_userFriendly_fxns.R | 18 ++++++++---- 6 files changed, 42 insertions(+), 32 deletions(-) diff --git a/R/importNGWMN_wml2.R b/R/importNGWMN_wml2.R index 1d5e71e..d8b57f1 100644 --- a/R/importNGWMN_wml2.R +++ b/R/importNGWMN_wml2.R @@ -117,7 +117,9 @@ importNGWMN_wml2 <- function(input, asDateTime=FALSE, tz=""){ url <- input attr(mergedDF, "url") <- url } - mergedDF$date <- as.Date(mergedDF$date) + if(asDateTime){ + mergedDF$date <- as.Date(mergedDF$date) + } nonDateCols <- grep("date",names(mergedDF), value=TRUE, invert = TRUE) mergedDF[nonDateCols][mergedDF[nonDateCols] == "" | mergedDF[nonDateCols]== -999999.0] <- NA @@ -140,7 +142,6 @@ importNGWMN_wml2 <- function(input, asDateTime=FALSE, tz=""){ siteLocs <- data.frame(matrix(unlist(siteLocs), nrow=length(siteLocs), byrow=TRUE), stringsAsFactors = FALSE) names(siteLocs) <- c("dec_lat_va", "dec_lon_va") siteLocs <- mutate(siteLocs, dec_lat_va=as.numeric(dec_lat_va), dec_lon_va=as.numeric(dec_lon_va)) - #siteLocs <- data.frame(dec_lat_va=as.numeric(siteLocs[[1]][1]), dec_lon_va=as.numeric(siteLocs[[1]][2]), stringsAsFactors = FALSE) mergedDF <- cbind.data.frame(site, description = siteDesc, siteLocs, stringsAsFactors = FALSE) } else{ diff --git a/R/importWaterML2.r b/R/importWaterML2.r index 4178599..53a8dc8 100644 --- a/R/importWaterML2.r +++ b/R/importWaterML2.r @@ -79,7 +79,6 @@ importWaterML2 <- function(obs_url, asDateTime=FALSE, tz=""){ for(t in timeSeries){ TVP <- xml_find_all(t, ".//wml2:MeasurementTVP")#time-value pairs time <- xml_text(xml_find_all(TVP,".//wml2:time")) - #TODO: if asDateTime.... if(asDateTime){ time <- parse_date_time(time, 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) diff --git a/R/readNGWMNdata.R b/R/readNGWMNdata.R index 01fadb2..87ca44a 100644 --- a/R/readNGWMNdata.R +++ b/R/readNGWMNdata.R @@ -5,8 +5,8 @@ #' \code{FALSE} since time zone information is not included. #' @param featureID character Vector of feature IDs in the formatted with agency code and site number #' separated by a period, e.g. \code{USGS.404159100494601}. -#' @param service character Identifies which web service to access. Only \code{observation} is currently -#' supported, which retrieves all water level for each site. +#' @param service character Identifies which web service to access. \code{observation} retrieves all water level for each site, +#' and \code{featureOfInterest} retrieves a data frame of site information, including description, latitude, and longitude. #' @param tz character to set timezone attribute of datetime. Default is an empty quote, which converts the #' datetimes to UTC (properly accounting for daylight savings times based on the data's provided time zone offset). #' Possible values to provide are "America/New_York","America/Chicago", "America/Denver","America/Los_Angeles", @@ -26,10 +26,11 @@ #' #multiple sites #' sites <- c("USGS.272838082142201","USGS.404159100494601", "USGS.401216080362703") #' multiSiteData <- readNGWMNdata(sites) -#' +#' attributes(multiSiteData) #' #' #non-USGS site -#' site <- "MBMG.892195" +#' #accepts colon or period between agency and ID +#' site <- "MBMG:892195" #' data <- readNGWMNdata(featureID = site) #' #' #site with no data returns empty data frame @@ -37,8 +38,6 @@ #' noDataSite <- readNGWMNdata(featureID = noDataSite, service = "observation") #' } #' -#TODO: accept colon or period! change examples -#TODO: deal with NA fIDs readNGWMNdata <- function(..., service = "observation", asDateTime = TRUE, tz = ""){ message(" ******************************************************** DISCLAIMER: NGWMN retrieval functions are still in flux, @@ -56,10 +55,6 @@ readNGWMNdata <- function(..., service = "observation", asDateTime = TRUE, tz = attrs <- c("url","gml:identifier","generationDate","responsibleParty", "contact") featureID <- na.omit(gsub(":",".",dots[['featureID']])) - #featureID <- na.omit(featureID) - #featureID <- featureID[!is.na(featureID)] - #featureID <- gsub(":",".",featureID) #getFeatureOfInterest returns with colons - #TODO: call featureOfInterest outside loop for(f in featureID){ obsFID <- retrieveObservation(featureID = f, asDateTime, attrs) obsFIDattr <- saveAttrs(attrs, obsFID) @@ -76,7 +71,6 @@ readNGWMNdata <- function(..., service = "observation", asDateTime = TRUE, tz = }else if(service == "featureOfInterest"){ if("featureID" %in% names(dots)){ featureID <- na.omit(gsub(":",".",dots[['featureID']])) - #TODO: can do multi site calls with encoded comma allSites <- retrieveFeatureOfInterest(featureID = featureID) } if("bbox" %in% names(dots)){ @@ -94,6 +88,9 @@ readNGWMNdata <- function(..., service = "observation", asDateTime = TRUE, tz = #' #' @param featureID character Vector of feature IDs in the formatted with agency code and site number #' separated by a period, e.g. \code{USGS.404159100494601}. +#' @param asDateTime logical Should dates and times be converted to date/time objects, +#' or returned as character? Defaults to \code{TRUE}. Must be set to \code{FALSE} if a site +#' contains non-standard dates. #' #' @export #' @@ -116,8 +113,9 @@ readNGWMNdata <- function(..., service = "observation", asDateTime = TRUE, tz = #' noDataSite <- readNGWMNlevels(featureID = noDataSite) #' } -readNGWMNlevels <- function(featureID){ - data <- readNGWMNdata(featureID = featureID, service = "observation") +readNGWMNlevels <- function(featureID, asDateTime = TRUE){ + data <- readNGWMNdata(featureID = featureID, service = "observation", + asDateTime = asDateTime) return(data) } @@ -156,7 +154,6 @@ readNGWMNsites <- function(featureID){ } - retrieveObservation <- function(featureID, asDateTime, attrs){ #will need to contruct this more piece by piece if other versions, properties are added baseURL <- "https://cida-test.er.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." @@ -185,17 +182,15 @@ retrieveObservation <- function(featureID, asDateTime, attrs){ #' retrieve feature of interest #' -#' @export -#TODO: can do multisite calls -#TODO: allow pass through srsName needs to be worked in higher-up in dots +#could allow pass through srsName - needs to be worked in higher-up in dots retrieveFeatureOfInterest <- function(..., asDateTime, srsName="urn:ogc:def:crs:EPSG::4269"){ baseURL <- "https://cida-test.er.usgs.gov/ngwmn_cache/sos?request=GetFeatureOfInterest&service=SOS&version=2.0.0" dots <- list(...) - values <- convertDots(dots) + values <- gsub(x = convertDots(dots), pattern = ",", replacement = "%2C") if("featureID" %in% names(values)){ foiURL <- "&featureOfInterest=" - fidURL <- paste("VW_GWDP_GEOSERVER", values[['featureID']], sep=".", collapse = "%2C") + fidURL <- paste0("VW_GWDP_GEOSERVER.", values[['featureID']]) url <- paste0(baseURL, foiURL, fidURL) }else if("bbox" %in% names(values)){ @@ -205,6 +200,8 @@ retrieveFeatureOfInterest <- function(..., asDateTime, srsName="urn:ogc:def:crs: stop() } siteDF <- importNGWMN_wml2(url, asDateTime) + attr(siteDF, "url") <- url + attr(siteDF, "queryTime") <- Sys.time() return(siteDF) } diff --git a/man/readNGWMNdata.Rd b/man/readNGWMNdata.Rd index d3b451b..1573542 100644 --- a/man/readNGWMNdata.Rd +++ b/man/readNGWMNdata.Rd @@ -7,8 +7,8 @@ readNGWMNdata(..., service = "observation", asDateTime = TRUE, tz = "") } \arguments{ -\item{service}{character Identifies which web service to access. Only \code{observation} is currently -supported, which retrieves all water level for each site.} +\item{service}{character Identifies which web service to access. \code{observation} retrieves all water level for each site, +and \code{featureOfInterest} retrieves a data frame of site information, including description, latitude, and longitude.} \item{asDateTime}{logical if \code{TRUE}, will convert times to POSIXct format. Currently defaults to \code{FALSE} since time zone information is not included.} @@ -33,10 +33,11 @@ oneSite <- readNGWMNdata(featureID = site) #multiple sites sites <- c("USGS.272838082142201","USGS.404159100494601", "USGS.401216080362703") multiSiteData <- readNGWMNdata(sites) - +attributes(multiSiteData) #non-USGS site -site <- "MBMG.892195" +#accepts colon or period between agency and ID +site <- "MBMG:892195" data <- readNGWMNdata(featureID = site) #site with no data returns empty data frame diff --git a/man/readNGWMNlevels.Rd b/man/readNGWMNlevels.Rd index 987cad5..8cca195 100644 --- a/man/readNGWMNlevels.Rd +++ b/man/readNGWMNlevels.Rd @@ -4,11 +4,15 @@ \alias{readNGWMNlevels} \title{Retrieve groundwater levels from the National Ground Water Monitoring Network \url{http://cida.usgs.gov/ngwmn/}.} \usage{ -readNGWMNlevels(featureID) +readNGWMNlevels(featureID, asDateTime = TRUE) } \arguments{ \item{featureID}{character Vector of feature IDs in the formatted with agency code and site number separated by a period, e.g. \code{USGS.404159100494601}.} + +\item{asDateTime}{logical Should dates and times be converted to date/time objects, +or returned as character? Defaults to \code{TRUE}. Must be set to \code{FALSE} if a site +contains non-standard dates.} } \description{ Retrieve groundwater levels from the National Ground Water Monitoring Network \url{http://cida.usgs.gov/ngwmn/}. diff --git a/tests/testthat/tests_userFriendly_fxns.R b/tests/testthat/tests_userFriendly_fxns.R index bb0dc86..61e9cef 100644 --- a/tests/testthat/tests_userFriendly_fxns.R +++ b/tests/testthat/tests_userFriendly_fxns.R @@ -241,8 +241,16 @@ test_that("NGWMN functions working", { expect_true(nrow(data) > 1) expect_true(is.numeric(oneSite$value)) - -}) - - - + #sites with colons and NAs work + na_colons <- c(NA, bboxSites$site[200:205], NA, NA) + returnDF <- readNGWMNdata(service = "observation", featureID = na_colons) + expect_is(returnDF, "data.frame") + expect_true(nrow(returnDF) > 1) + expect_true(!is.null(attributes(returnDF)$siteInfo)) + + sites <- c("USGS:424427089494701", NA) + siteInfo <- readNGWMNsites(sites) + expect_is(siteInfo, "data.frame") + expect_true(nrow(siteInfo) == 1) + +}) \ No newline at end of file -- GitLab From 8f92df03a5575c05b2bea1ff9e400250711e3698 Mon Sep 17 00:00:00 2001 From: wdwatkins Date: Tue, 21 Feb 2017 17:28:31 -0600 Subject: [PATCH 11/14] setAccess for levels --- R/importNGWMN_wml2.R | 6 +----- R/readNGWMNdata.R | 6 ++++-- R/setAccess.R | 2 ++ 3 files changed, 7 insertions(+), 7 deletions(-) diff --git a/R/importNGWMN_wml2.R b/R/importNGWMN_wml2.R index d8b57f1..0f9a27d 100644 --- a/R/importNGWMN_wml2.R +++ b/R/importNGWMN_wml2.R @@ -34,11 +34,7 @@ #TODO: separate id and agency name, give also as separate dimensions importNGWMN_wml2 <- function(input, asDateTime=FALSE, tz=""){ if(tz != ""){ - tz <- match.arg(tz, c("America/New_York","America/Chicago", - "America/Denver","America/Los_Angeles", - "America/Anchorage","America/Honolulu", - "America/Jamaica","America/Managua", - "America/Phoenix","America/Metlakatla")) + tz <- match.arg(tz, OlsonNames()) }else{tz = "UTC"} raw <- FALSE diff --git a/R/readNGWMNdata.R b/R/readNGWMNdata.R index 87ca44a..732e63c 100644 --- a/R/readNGWMNdata.R +++ b/R/readNGWMNdata.R @@ -156,8 +156,10 @@ readNGWMNsites <- function(featureID){ retrieveObservation <- function(featureID, asDateTime, attrs){ #will need to contruct this more piece by piece if other versions, properties are added - baseURL <- "https://cida-test.er.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." - url <- paste0(baseURL, featureID) + #baseURL <- "https://cida-test.er.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." + url <- drURL(base.name = "NGWMN", access = pkg.env$access, request = "GetObservation", + service = "SOS", version = "2.0.0", observedProperty = "urn:ogc:def:property:OGC:GroundWaterLevel", + responseFormat = "text/xml", featureOfInterest = paste("VW_GWDP_GEOSERVER", featureID, sep = ".")) returnData <- importNGWMN_wml2(url, asDateTime) if(nrow(returnData) == 0){ diff --git a/R/setAccess.R b/R/setAccess.R index c8c5b57..e803813 100644 --- a/R/setAccess.R +++ b/R/setAccess.R @@ -55,6 +55,8 @@ access = match.arg(access, c('public','internal','cooperator','USGS')) pkg.env$wqpData = "https://www.waterqualitydata.us/Result/search" pkg.env$wqpStation = "https://www.waterqualitydata.us/Station/search" + pkg.env$NGWMN = "https://cida-test.er.usgs.gov/ngwmn_cache/sos" + options(Access.dataRetrieval = access) } -- GitLab From 3d46679f25aef40ee3d9fe1d1546d46c97ce941b Mon Sep 17 00:00:00 2001 From: wdwatkins Date: Wed, 22 Feb 2017 10:46:19 -0600 Subject: [PATCH 12/14] url handling working --- R/readNGWMNdata.R | 15 +++++++-------- tests/testthat/tests_userFriendly_fxns.R | 3 --- 2 files changed, 7 insertions(+), 11 deletions(-) diff --git a/R/readNGWMNdata.R b/R/readNGWMNdata.R index 732e63c..6d2e72d 100644 --- a/R/readNGWMNdata.R +++ b/R/readNGWMNdata.R @@ -155,8 +155,6 @@ readNGWMNsites <- function(featureID){ retrieveObservation <- function(featureID, asDateTime, attrs){ - #will need to contruct this more piece by piece if other versions, properties are added - #baseURL <- "https://cida-test.er.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." url <- drURL(base.name = "NGWMN", access = pkg.env$access, request = "GetObservation", service = "SOS", version = "2.0.0", observedProperty = "urn:ogc:def:property:OGC:GroundWaterLevel", responseFormat = "text/xml", featureOfInterest = paste("VW_GWDP_GEOSERVER", featureID, sep = ".")) @@ -186,18 +184,19 @@ retrieveObservation <- function(featureID, asDateTime, attrs){ #' #could allow pass through srsName - needs to be worked in higher-up in dots retrieveFeatureOfInterest <- function(..., asDateTime, srsName="urn:ogc:def:crs:EPSG::4269"){ - baseURL <- "https://cida-test.er.usgs.gov/ngwmn_cache/sos?request=GetFeatureOfInterest&service=SOS&version=2.0.0" dots <- list(...) values <- gsub(x = convertDots(dots), pattern = ",", replacement = "%2C") + url <- drURL(base.name = "NGWMN", access = pkg.env$access, request = "GetFeatureOfInterest", + service = "SOS", version = "2.0.0", responseFormat = "text/xml") + if("featureID" %in% names(values)){ - foiURL <- "&featureOfInterest=" - fidURL <- paste0("VW_GWDP_GEOSERVER.", values[['featureID']]) - url <- paste0(baseURL, foiURL, fidURL) + url <- appendDrURL(url, featureOfInterest = paste("VW_GWDP_GEOSERVER", + values[['featureID']], sep = ".")) }else if("bbox" %in% names(values)){ - bbox <- paste(values[['bbox']], collapse=",") - url <- paste0(baseURL, "&bbox=", bbox, "&srsName=",srsName) + url <- appendDrURL(url, bbox = paste(values[['bbox']], collapse=","), + srsName = srsName) }else{ stop() } diff --git a/tests/testthat/tests_userFriendly_fxns.R b/tests/testthat/tests_userFriendly_fxns.R index 0c62de8..71c512b 100644 --- a/tests/testthat/tests_userFriendly_fxns.R +++ b/tests/testthat/tests_userFriendly_fxns.R @@ -39,12 +39,9 @@ test_that("Unit value data returns correct types", { "dateTime","X_.YSI.6136.UP._63680_00000", "X_YSI.6136.DOWN_63680_00000","X_.YSI.6136.UP._63680_00000_cd", "X_YSI.6136.DOWN_63680_00000_cd","tz_cd"))) -<<<<<<< HEAD -======= noData <- readNWISuv("01196500","00010", "2016-06-15", "2016-06-15") # expect_equal(noData$X_00010_00000[1], as.numeric(NA)) ->>>>>>> 125360521cf5136c7b1a8b1ea260a8d8d8f3ec4c }) -- GitLab From 662ccfc1bb32323140c9b44361d1ef108cb0b63a Mon Sep 17 00:00:00 2001 From: wdwatkins Date: Wed, 22 Feb 2017 10:47:18 -0600 Subject: [PATCH 13/14] flip url back to prod --- R/setAccess.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/setAccess.R b/R/setAccess.R index e803813..3956464 100644 --- a/R/setAccess.R +++ b/R/setAccess.R @@ -55,7 +55,7 @@ access = match.arg(access, c('public','internal','cooperator','USGS')) pkg.env$wqpData = "https://www.waterqualitydata.us/Result/search" pkg.env$wqpStation = "https://www.waterqualitydata.us/Station/search" - pkg.env$NGWMN = "https://cida-test.er.usgs.gov/ngwmn_cache/sos" + pkg.env$NGWMN = "https://cida.usgs.gov/ngwmn_cache/sos" options(Access.dataRetrieval = access) } -- GitLab From e3499d904c1491ed5f0786cd7f3e65b5d3c600fd Mon Sep 17 00:00:00 2001 From: wdwatkins Date: Wed, 22 Feb 2017 17:12:10 -0600 Subject: [PATCH 14/14] warnings, and several tests commented for req limit --- R/importNGWMN_wml2.R | 2 ++ R/readNGWMNdata.R | 9 +++++---- man/readNGWMNdata.Rd | 8 +++++--- man/retrieveFeatureOfInterest.Rd | 12 ------------ tests/testthat/tests_userFriendly_fxns.R | 12 ++++++------ 5 files changed, 18 insertions(+), 25 deletions(-) delete mode 100644 man/retrieveFeatureOfInterest.Rd diff --git a/R/importNGWMN_wml2.R b/R/importNGWMN_wml2.R index 0f9a27d..b5d2298 100644 --- a/R/importNGWMN_wml2.R +++ b/R/importNGWMN_wml2.R @@ -137,6 +137,8 @@ importNGWMN_wml2 <- function(input, asDateTime=FALSE, tz=""){ 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)) mergedDF <- cbind.data.frame(site, description = siteDesc, siteLocs, stringsAsFactors = FALSE) } diff --git a/R/readNGWMNdata.R b/R/readNGWMNdata.R index 6d2e72d..b4ef50b 100644 --- a/R/readNGWMNdata.R +++ b/R/readNGWMNdata.R @@ -3,14 +3,13 @@ #' Only water level data is currently available through the web service. #' @param asDateTime logical if \code{TRUE}, will convert times to POSIXct format. Currently defaults to #' \code{FALSE} since time zone information is not included. -#' @param featureID character Vector of feature IDs in the formatted with agency code and site number -#' separated by a period, e.g. \code{USGS.404159100494601}. #' @param service character Identifies which web service to access. \code{observation} retrieves all water level for each site, #' and \code{featureOfInterest} retrieves a data frame of site information, including description, latitude, and longitude. #' @param tz character to set timezone attribute of datetime. Default is an empty quote, which converts the #' datetimes to UTC (properly accounting for daylight savings times based on the data's provided time zone offset). #' Possible values to provide are "America/New_York","America/Chicago", "America/Denver","America/Los_Angeles", #' "America/Anchorage","America/Honolulu","America/Jamaica","America/Managua","America/Phoenix", and "America/Metlakatla" +#' @param \dots Other parameters to supply, namely \code{featureID} or \code{bbox} #' @import utils #' @importFrom dplyr mutate #' @importFrom dplyr bind_rows @@ -36,6 +35,9 @@ #' #site with no data returns empty data frame #' noDataSite <- "UTGS.401544112060301" #' noDataSite <- readNGWMNdata(featureID = noDataSite, service = "observation") +#' +#' #bounding box +#' bboxSites <- readNGWMNdata(service = "featureOfInterest", bbox = c(30, -99, 31, 102)) #' } #' readNGWMNdata <- function(..., service = "observation", asDateTime = TRUE, tz = ""){ @@ -180,8 +182,7 @@ retrieveObservation <- function(featureID, asDateTime, attrs){ return(returnData) } -#' retrieve feature of interest -#' +#retrieve feature of interest #could allow pass through srsName - needs to be worked in higher-up in dots retrieveFeatureOfInterest <- function(..., asDateTime, srsName="urn:ogc:def:crs:EPSG::4269"){ dots <- list(...) diff --git a/man/readNGWMNdata.Rd b/man/readNGWMNdata.Rd index 1573542..b87830c 100644 --- a/man/readNGWMNdata.Rd +++ b/man/readNGWMNdata.Rd @@ -7,6 +7,8 @@ readNGWMNdata(..., service = "observation", asDateTime = TRUE, tz = "") } \arguments{ +\item{\dots}{Other parameters to supply, namely \code{featureID} or \code{bbox}} + \item{service}{character Identifies which web service to access. \code{observation} retrieves all water level for each site, and \code{featureOfInterest} retrieves a data frame of site information, including description, latitude, and longitude.} @@ -17,9 +19,6 @@ and \code{featureOfInterest} retrieves a data frame of site information, includi datetimes to UTC (properly accounting for daylight savings times based on the data's provided time zone offset). Possible values to provide are "America/New_York","America/Chicago", "America/Denver","America/Los_Angeles", "America/Anchorage","America/Honolulu","America/Jamaica","America/Managua","America/Phoenix", and "America/Metlakatla"} - -\item{featureID}{character Vector of feature IDs in the formatted with agency code and site number -separated by a period, e.g. \code{USGS.404159100494601}.} } \description{ Only water level data is currently available through the web service. @@ -43,6 +42,9 @@ data <- readNGWMNdata(featureID = site) #site with no data returns empty data frame noDataSite <- "UTGS.401544112060301" noDataSite <- readNGWMNdata(featureID = noDataSite, service = "observation") + +#bounding box +bboxSites <- readNGWMNdata(service = "featureOfInterest", bbox = c(30, -99, 31, 102)) } } diff --git a/man/retrieveFeatureOfInterest.Rd b/man/retrieveFeatureOfInterest.Rd deleted file mode 100644 index 4b83f21..0000000 --- a/man/retrieveFeatureOfInterest.Rd +++ /dev/null @@ -1,12 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/readNGWMNdata.R -\name{retrieveFeatureOfInterest} -\alias{retrieveFeatureOfInterest} -\title{retrieve feature of interest} -\usage{ -retrieveFeatureOfInterest(..., asDateTime, - srsName = "urn:ogc:def:crs:EPSG::4269") -} -\description{ -retrieve feature of interest -} diff --git a/tests/testthat/tests_userFriendly_fxns.R b/tests/testthat/tests_userFriendly_fxns.R index 71c512b..d7c5d59 100644 --- a/tests/testthat/tests_userFriendly_fxns.R +++ b/tests/testthat/tests_userFriendly_fxns.R @@ -232,7 +232,7 @@ test_that("NGWMN functions working", { #bounding box and a bigger request bboxSites <- readNGWMNdata(service = "featureOfInterest", bbox = c(30, -99, 31, 102)) - siteInfo <- readNGWMNsites(bboxSites$site[1:100]) + #siteInfo <- readNGWMNsites(bboxSites$site[1:100]) #one site site <- "USGS.430427089284901" @@ -250,16 +250,16 @@ test_that("NGWMN functions working", { expect_true(is.numeric(oneSite$value)) #sites with colons and NAs work - na_colons <- c(NA, bboxSites$site[200:205], NA, NA) + na_colons <- c(NA, bboxSites$site[202], NA, NA) returnDF <- readNGWMNdata(service = "observation", featureID = na_colons) expect_is(returnDF, "data.frame") expect_true(nrow(returnDF) > 1) expect_true(!is.null(attributes(returnDF)$siteInfo)) - sites <- c("USGS:424427089494701", NA) - siteInfo <- readNGWMNsites(sites) - expect_is(siteInfo, "data.frame") - expect_true(nrow(siteInfo) == 1) + # sites <- c("USGS:424427089494701", NA) + # siteInfo <- readNGWMNsites(sites) + # expect_is(siteInfo, "data.frame") + # expect_true(nrow(siteInfo) == 1) }) -- GitLab