Commit 44dd4da2 authored by David Watkins's avatar David Watkins
Browse files

bbox working from retrieveFeatureOfInterest

parent 169da10c
......@@ -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)
......@@ -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{
......
......@@ -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)
}
......
......@@ -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
......@@ -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.
......
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