Commit f9182029 authored by David Watkins's avatar David Watkins
Browse files

cleaned up TODOs

parent 1f6d8d01
...@@ -117,7 +117,9 @@ importNGWMN_wml2 <- function(input, asDateTime=FALSE, tz=""){ ...@@ -117,7 +117,9 @@ importNGWMN_wml2 <- function(input, asDateTime=FALSE, tz=""){
url <- input url <- input
attr(mergedDF, "url") <- url 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) nonDateCols <- grep("date",names(mergedDF), value=TRUE, invert = TRUE)
mergedDF[nonDateCols][mergedDF[nonDateCols] == "" | mergedDF[nonDateCols]== -999999.0] <- NA mergedDF[nonDateCols][mergedDF[nonDateCols] == "" | mergedDF[nonDateCols]== -999999.0] <- NA
...@@ -140,7 +142,6 @@ importNGWMN_wml2 <- function(input, asDateTime=FALSE, tz=""){ ...@@ -140,7 +142,6 @@ importNGWMN_wml2 <- function(input, asDateTime=FALSE, tz=""){
siteLocs <- data.frame(matrix(unlist(siteLocs), nrow=length(siteLocs), byrow=TRUE), stringsAsFactors = FALSE) siteLocs <- data.frame(matrix(unlist(siteLocs), nrow=length(siteLocs), byrow=TRUE), stringsAsFactors = FALSE)
names(siteLocs) <- c("dec_lat_va", "dec_lon_va") 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 <- 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) mergedDF <- cbind.data.frame(site, description = siteDesc, siteLocs, stringsAsFactors = FALSE)
} }
else{ else{
......
...@@ -79,7 +79,6 @@ importWaterML2 <- function(obs_url, asDateTime=FALSE, tz=""){ ...@@ -79,7 +79,6 @@ importWaterML2 <- function(obs_url, asDateTime=FALSE, tz=""){
for(t in timeSeries){ for(t in timeSeries){
TVP <- xml_find_all(t, ".//wml2:MeasurementTVP")#time-value pairs TVP <- xml_find_all(t, ".//wml2:MeasurementTVP")#time-value pairs
time <- xml_text(xml_find_all(TVP,".//wml2:time")) time <- xml_text(xml_find_all(TVP,".//wml2:time"))
#TODO: if asDateTime....
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", 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) "%Y-%m-%dT%H:%M:%OS","%Y-%m-%dT%H:%M:%OS%z"), exact = TRUE)
......
...@@ -5,8 +5,8 @@ ...@@ -5,8 +5,8 @@
#' \code{FALSE} since time zone information is not included. #' \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 #' @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}. #' separated by a period, e.g. \code{USGS.404159100494601}.
#' @param service character Identifies which web service to access. Only \code{observation} is currently #' @param service character Identifies which web service to access. \code{observation} retrieves all water level for each site,
#' supported, which 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 #' @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). #' 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", #' Possible values to provide are "America/New_York","America/Chicago", "America/Denver","America/Los_Angeles",
...@@ -26,10 +26,11 @@ ...@@ -26,10 +26,11 @@
#' #multiple sites #' #multiple sites
#' sites <- c("USGS.272838082142201","USGS.404159100494601", "USGS.401216080362703") #' sites <- c("USGS.272838082142201","USGS.404159100494601", "USGS.401216080362703")
#' multiSiteData <- readNGWMNdata(sites) #' multiSiteData <- readNGWMNdata(sites)
#' #' attributes(multiSiteData)
#' #'
#' #non-USGS site #' #non-USGS site
#' site <- "MBMG.892195" #' #accepts colon or period between agency and ID
#' site <- "MBMG:892195"
#' data <- readNGWMNdata(featureID = site) #' data <- readNGWMNdata(featureID = site)
#' #'
#' #site with no data returns empty data frame #' #site with no data returns empty data frame
...@@ -37,8 +38,6 @@ ...@@ -37,8 +38,6 @@
#' noDataSite <- readNGWMNdata(featureID = noDataSite, service = "observation") #' 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 = ""){ readNGWMNdata <- function(..., service = "observation", asDateTime = TRUE, tz = ""){
message(" ******************************************************** message(" ********************************************************
DISCLAIMER: NGWMN retrieval functions are still in flux, DISCLAIMER: NGWMN retrieval functions are still in flux,
...@@ -56,10 +55,6 @@ readNGWMNdata <- function(..., service = "observation", asDateTime = TRUE, tz = ...@@ -56,10 +55,6 @@ readNGWMNdata <- function(..., service = "observation", asDateTime = TRUE, tz =
attrs <- c("url","gml:identifier","generationDate","responsibleParty", "contact") attrs <- c("url","gml:identifier","generationDate","responsibleParty", "contact")
featureID <- na.omit(gsub(":",".",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){ for(f in featureID){
obsFID <- retrieveObservation(featureID = f, asDateTime, attrs) obsFID <- retrieveObservation(featureID = f, asDateTime, attrs)
obsFIDattr <- saveAttrs(attrs, obsFID) obsFIDattr <- saveAttrs(attrs, obsFID)
...@@ -76,7 +71,6 @@ readNGWMNdata <- function(..., service = "observation", asDateTime = TRUE, tz = ...@@ -76,7 +71,6 @@ readNGWMNdata <- function(..., service = "observation", asDateTime = TRUE, tz =
}else if(service == "featureOfInterest"){ }else if(service == "featureOfInterest"){
if("featureID" %in% names(dots)){ if("featureID" %in% names(dots)){
featureID <- na.omit(gsub(":",".",dots[['featureID']])) featureID <- na.omit(gsub(":",".",dots[['featureID']]))
#TODO: can do multi site calls with encoded comma
allSites <- retrieveFeatureOfInterest(featureID = featureID) allSites <- retrieveFeatureOfInterest(featureID = featureID)
} }
if("bbox" %in% names(dots)){ if("bbox" %in% names(dots)){
...@@ -94,6 +88,9 @@ readNGWMNdata <- function(..., service = "observation", asDateTime = TRUE, tz = ...@@ -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 #' @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}. #' 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 #' @export
#' #'
...@@ -116,8 +113,9 @@ readNGWMNdata <- function(..., service = "observation", asDateTime = TRUE, tz = ...@@ -116,8 +113,9 @@ readNGWMNdata <- function(..., service = "observation", asDateTime = TRUE, tz =
#' noDataSite <- readNGWMNlevels(featureID = noDataSite) #' noDataSite <- readNGWMNlevels(featureID = noDataSite)
#' } #' }
readNGWMNlevels <- function(featureID){ readNGWMNlevels <- function(featureID, asDateTime = TRUE){
data <- readNGWMNdata(featureID = featureID, service = "observation") data <- readNGWMNdata(featureID = featureID, service = "observation",
asDateTime = asDateTime)
return(data) return(data)
} }
...@@ -156,7 +154,6 @@ readNGWMNsites <- function(featureID){ ...@@ -156,7 +154,6 @@ readNGWMNsites <- function(featureID){
} }
retrieveObservation <- function(featureID, asDateTime, attrs){ retrieveObservation <- function(featureID, asDateTime, attrs){
#will need to contruct this more piece by piece if other versions, properties are added #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." 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){ ...@@ -185,17 +182,15 @@ retrieveObservation <- function(featureID, asDateTime, attrs){
#' retrieve feature of interest #' retrieve feature of interest
#' #'
#' @export #could allow pass through srsName - needs to be worked in higher-up in dots
#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"){ 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" baseURL <- "https://cida-test.er.usgs.gov/ngwmn_cache/sos?request=GetFeatureOfInterest&service=SOS&version=2.0.0"
dots <- list(...) dots <- list(...)
values <- convertDots(dots) values <- gsub(x = convertDots(dots), pattern = ",", replacement = "%2C")
if("featureID" %in% names(values)){ if("featureID" %in% names(values)){
foiURL <- "&featureOfInterest=" foiURL <- "&featureOfInterest="
fidURL <- paste("VW_GWDP_GEOSERVER", values[['featureID']], sep=".", collapse = "%2C") fidURL <- paste0("VW_GWDP_GEOSERVER.", values[['featureID']])
url <- paste0(baseURL, foiURL, fidURL) url <- paste0(baseURL, foiURL, fidURL)
}else if("bbox" %in% names(values)){ }else if("bbox" %in% names(values)){
...@@ -205,6 +200,8 @@ retrieveFeatureOfInterest <- function(..., asDateTime, srsName="urn:ogc:def:crs: ...@@ -205,6 +200,8 @@ retrieveFeatureOfInterest <- function(..., asDateTime, srsName="urn:ogc:def:crs:
stop() stop()
} }
siteDF <- importNGWMN_wml2(url, asDateTime) siteDF <- importNGWMN_wml2(url, asDateTime)
attr(siteDF, "url") <- url
attr(siteDF, "queryTime") <- Sys.time()
return(siteDF) return(siteDF)
} }
......
...@@ -7,8 +7,8 @@ ...@@ -7,8 +7,8 @@
readNGWMNdata(..., service = "observation", asDateTime = TRUE, tz = "") readNGWMNdata(..., service = "observation", asDateTime = TRUE, tz = "")
} }
\arguments{ \arguments{
\item{service}{character Identifies which web service to access. Only \code{observation} is currently \item{service}{character Identifies which web service to access. \code{observation} retrieves all water level for each site,
supported, which 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 \item{asDateTime}{logical if \code{TRUE}, will convert times to POSIXct format. Currently defaults to
\code{FALSE} since time zone information is not included.} \code{FALSE} since time zone information is not included.}
...@@ -33,10 +33,11 @@ oneSite <- readNGWMNdata(featureID = site) ...@@ -33,10 +33,11 @@ oneSite <- readNGWMNdata(featureID = site)
#multiple sites #multiple sites
sites <- c("USGS.272838082142201","USGS.404159100494601", "USGS.401216080362703") sites <- c("USGS.272838082142201","USGS.404159100494601", "USGS.401216080362703")
multiSiteData <- readNGWMNdata(sites) multiSiteData <- readNGWMNdata(sites)
attributes(multiSiteData)
#non-USGS site #non-USGS site
site <- "MBMG.892195" #accepts colon or period between agency and ID
site <- "MBMG:892195"
data <- readNGWMNdata(featureID = site) data <- readNGWMNdata(featureID = site)
#site with no data returns empty data frame #site with no data returns empty data frame
......
...@@ -4,11 +4,15 @@ ...@@ -4,11 +4,15 @@
\alias{readNGWMNlevels} \alias{readNGWMNlevels}
\title{Retrieve groundwater levels from the National Ground Water Monitoring Network \url{http://cida.usgs.gov/ngwmn/}.} \title{Retrieve groundwater levels from the National Ground Water Monitoring Network \url{http://cida.usgs.gov/ngwmn/}.}
\usage{ \usage{
readNGWMNlevels(featureID) readNGWMNlevels(featureID, asDateTime = TRUE)
} }
\arguments{ \arguments{
\item{featureID}{character Vector of feature IDs in the formatted with agency code and site number \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}.} 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{ \description{
Retrieve groundwater levels from the National Ground Water Monitoring Network \url{http://cida.usgs.gov/ngwmn/}. Retrieve groundwater levels from the National Ground Water Monitoring Network \url{http://cida.usgs.gov/ngwmn/}.
......
...@@ -241,8 +241,16 @@ test_that("NGWMN functions working", { ...@@ -241,8 +241,16 @@ test_that("NGWMN functions working", {
expect_true(nrow(data) > 1) expect_true(nrow(data) > 1)
expect_true(is.numeric(oneSite$value)) 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
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment