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

just need to split into user-friendly functions

parent efc72c6a
...@@ -18,10 +18,12 @@ ...@@ -18,10 +18,12 @@
#' @importFrom lubridate parse_date_time #' @importFrom lubridate parse_date_time
#' @examples #' @examples
#' \dontrun{ #' \dontrun{
#' url <- "http://cida.usgs.gov/ngwmn_cache/sos?request=GetObservation&service=SOS&version=2.0.0&observedProperty=urn:ogc:def:property:OGC:GroundWaterLevel&responseFormat=text/xml&featureOfInterest=VW_GWDP_GEOSERVER.USGS.403836085374401" #' url <- "http://cida.usgs.gov/ngwmn_cache/sos?request=GetObservation&service=SOS&version=2.0.0
#' &observedProperty=urn:ogc:def:property:OGC:GroundWaterLevel&responseFormat=text/xml&featureOfInterest=VW_GWDP_GEOSERVER.USGS.403836085374401"
#' data <- importNGWMN_wml2(url) #' data <- importNGWMN_wml2(url)
#' #'
#' url <- "http://cida.usgs.gov/ngwmn_cache/sos?request=GetObservation&service=SOS&version=2.0.0&observedProperty=urn:ogc:def:property:OGC:GroundWaterLevel&responseFormat=text/xml&featureOfInterest=VW_GWDP_GEOSERVER.USGS.474011117072901" #' url <- "http://cida.usgs.gov/ngwmn_cache/sos?request=GetObservation&service=SOS&version=2.0.0
#' &observedProperty=urn:ogc:def:property:OGC:GroundWaterLevel&responseFormat=text/xml&featureOfInterest=VW_GWDP_GEOSERVER.USGS.474011117072901"
#' data <- importNGWMN_wml2(url) #' data <- importNGWMN_wml2(url)
#' } #' }
#' #'
...@@ -62,23 +64,35 @@ importNGWMN_wml2 <- function(input, asDateTime=FALSE, tz=""){ ...@@ -62,23 +64,35 @@ importNGWMN_wml2 <- function(input, asDateTime=FALSE, tz=""){
for(t in timeSeries){ for(t in timeSeries){
gmlID <- xml_attr(t,"id") gmlID <- xml_attr(t,"id")
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")) rawTime <- xml_text(xml_find_all(TVP,".//wml2:time"))
valueNodes <- xml_find_all(TVP,".//wml2:value")
values <- as.numeric(xml_text(valueNodes))
nVals <- length(values)
gmlID <- rep(gmlID, nVals)
#df of date, time, dateTime
oneCol <- rep(NA, nVals)
timeDF <- data.frame(date=oneCol, time=oneCol, dateTime=oneCol)
splitTime <- data.frame(matrix(unlist(strsplit(rawTime, "T")), nrow=nVals, byrow = TRUE), stringsAsFactors=FALSE)
names(splitTime) <- c("date", "time")
timeDF <- mutate(splitTime, dateTime = NA)
logicVec <- nchar(rawTime) > 19
timeDF$dateTime[logicVec] <- rawTime[logicVec]
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", timeDF$dateTime <- parse_date_time(timeDF$dateTime, c("%Y","%Y-%m-%d","%Y-%m-%dT%H:%M","%Y-%m-%dT%H:%M:%S",
"%Y-%m-%dT%H:%M:%OS","%Y-%m-%dT%H:%M:%OS%z"), exact = TRUE) "%Y-%m-%dT%H:%M:%OS","%Y-%m-%dT%H:%M:%OS%z"), exact = TRUE)
#^^setting tz in as.POSIXct just sets the attribute, does not convert the time! #^^setting tz in as.POSIXct just sets the attribute, does not convert the time!
attr(time, 'tzone') <- tz attr(time, 'tzone') <- tz
} }
valueNodes <- xml_find_all(TVP,".//wml2:value")
values <- as.numeric(xml_text(valueNodes))
nVals <- length(values)
gmlID <- rep(gmlID, nVals)
uom <- xml_attr(valueNodes, "uom", default = NA) uom <- xml_attr(valueNodes, "uom", default = NA)
source <- xml_attr(xml_find_all(TVP, ".//wml2:source"), "title") source <- xml_attr(xml_find_all(TVP, ".//wml2:source"), "title")
comment <- xml_text(xml_find_all(TVP, ".//wml2:comment")) comment <- xml_text(xml_find_all(TVP, ".//wml2:comment"))
df <- cbind.data.frame(source, time, value=values, uom, comment, gmlID, df <- cbind.data.frame(source, timeDF, value=values, uom, comment, gmlID,
stringsAsFactors=FALSE) stringsAsFactors=FALSE)
if (is.null(mergedDF)){ if (is.null(mergedDF)){
mergedDF <- df mergedDF <- df
...@@ -92,10 +106,13 @@ importNGWMN_wml2 <- function(input, asDateTime=FALSE, tz=""){ ...@@ -92,10 +106,13 @@ importNGWMN_wml2 <- function(input, asDateTime=FALSE, tz=""){
url <- input url <- input
attr(mergedDF, "url") <- url attr(mergedDF, "url") <- url
} }
mergedDF[mergedDF == ""] <- NA mergedDF$date <- as.Date(mergedDF$date)
nonDateCols <- grep("date",names(mergedDF), value=TRUE, invert = TRUE)
mergedDF[nonDateCols][mergedDF[nonDateCols] == "" | mergedDF[nonDateCols]== -999999.0] <- NA
attr(mergedDF, "gml:identifier") <- xml_text(xml_find_all(returnedDoc, ".//gml:identifier")) attr(mergedDF, "gml:identifier") <- xml_text(xml_find_all(returnedDoc, ".//gml:identifier"))
attr(mergedDF, "generationDate") <- xml_text(xml_find_all(returnedDoc, ".//wml2:generationDate")) attr(mergedDF, "generationDate") <- xml_text(xml_find_all(returnedDoc, ".//wml2:generationDate"))
mergedDF$value[mergedDF$value == -999999.0] <- NA
}else if(response == "GetFeatureOfInterestResponse"){ }else if(response == "GetFeatureOfInterestResponse"){
site <- xml_text(xml_find_all(returnedDoc,".//gml:identifier")) site <- xml_text(xml_find_all(returnedDoc,".//gml:identifier"))
...@@ -109,7 +126,7 @@ importNGWMN_wml2 <- function(input, asDateTime=FALSE, tz=""){ ...@@ -109,7 +126,7 @@ importNGWMN_wml2 <- function(input, asDateTime=FALSE, tz=""){
} }
siteLocs <- strsplit(xml_text(xml_find_all(returnedDoc, ".//gml:pos")), " ") siteLocs <- strsplit(xml_text(xml_find_all(returnedDoc, ".//gml:pos")), " ")
siteLocs <- data.frame(lat=siteLocs[[1]][1], lon=siteLocs[[1]][2], stringsAsFactors = FALSE) 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{
......
#' import data from the National Groundwater Monitoring Network \link{http://cida.usgs.gov/ngwmn/}. #' import data from the National Groundwater Monitoring Network \url{http://cida.usgs.gov/ngwmn/}.
#' #'
#' Only water level data is currently available through the web service. #' 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 #' @param asDateTime logical if \code{TRUE}, will convert times to POSIXct format. Currently defaults to
...@@ -32,12 +32,13 @@ ...@@ -32,12 +32,13 @@
#' } #' }
#' #'
readNGWMNdata <- function(featureID, request = "observation", asDateTime = FALSE){ readNGWMNdata <- function(featureID, request = "observation", asDateTime = TRUE){
message(" ********************************************************
DISCLAIMER: NGWMN retrieval functions are still in flux,
and no future behavior or output is guaranteed
*********************************************************")
match.arg(request, c("observation", "featureOfInterest")) match.arg(request, c("observation", "featureOfInterest"))
if(asDateTime){
warning("Times zones will be incorrect. This will be fixed in the future")
}
if(request == "observation"){ if(request == "observation"){
allObs <- NULL allObs <- NULL
...@@ -47,7 +48,7 @@ readNGWMNdata <- function(featureID, request = "observation", asDateTime = FALSE ...@@ -47,7 +48,7 @@ readNGWMNdata <- function(featureID, request = "observation", asDateTime = FALSE
attrs <- c("url","gml:identifier","generationDate") attrs <- c("url","gml:identifier","generationDate")
for(f in featureID){ for(f in featureID){
obsFID <- retrieveObservation(f, asDateTime, attrs) obsFID <- retrieveObservation(f, asDateTime, attrs)
siteFID <- retrieveFeatureOfInterest(f) siteFID <- retrieveFeatureOfInterest(f, asDateTime)
if(is.null(allObs)){ if(is.null(allObs)){
allObs <- obsFID allObs <- obsFID
allSites <- siteFID allSites <- siteFID
...@@ -86,7 +87,8 @@ retrieveObservation <- function(featureID, asDateTime, attrs){ ...@@ -86,7 +87,8 @@ retrieveObservation <- function(featureID, asDateTime, attrs){
#tack on site number #tack on site number
siteNum <- rep(sub('.*\\.', '', featureID), nrow(returnData)) siteNum <- rep(sub('.*\\.', '', featureID), nrow(returnData))
returnData <- mutate(returnData, site = siteNum) returnData <- mutate(returnData, site = siteNum)
returnData <- returnData[,c(7,1:6)] #move siteNum to the left numCol <- ncol(returnData)
returnData <- returnData[,c(numCol,1:(numCol - 1))] #move siteNum to the left
} }
attributes(returnData) <- c(attributes(returnData), as.list(attribs)) attributes(returnData) <- c(attributes(returnData), as.list(attribs))
...@@ -96,7 +98,7 @@ retrieveObservation <- function(featureID, asDateTime, attrs){ ...@@ -96,7 +98,7 @@ retrieveObservation <- function(featureID, asDateTime, attrs){
#retrieve feature of interest #retrieve feature of interest
#don't expose until can support bbox #don't expose until can support bbox
#note: import function can only do single sites right now #note: import function can only do single sites right now
retrieveFeatureOfInterest <- function(featureID){ 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." 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) url <- paste0(baseURL, featureID)
siteDF <- importNGWMN_wml2(url, asDateTime) siteDF <- importNGWMN_wml2(url, asDateTime)
......
...@@ -25,10 +25,12 @@ but the general functionality is correct. ...@@ -25,10 +25,12 @@ but the general functionality is correct.
} }
\examples{ \examples{
\dontrun{ \dontrun{
url <- "http://cida.usgs.gov/ngwmn_cache/sos?request=GetObservation&service=SOS&version=2.0.0&observedProperty=urn:ogc:def:property:OGC:GroundWaterLevel&responseFormat=text/xml&featureOfInterest=VW_GWDP_GEOSERVER.USGS.403836085374401" url <- "http://cida.usgs.gov/ngwmn_cache/sos?request=GetObservation&service=SOS&version=2.0.0
&observedProperty=urn:ogc:def:property:OGC:GroundWaterLevel&responseFormat=text/xml&featureOfInterest=VW_GWDP_GEOSERVER.USGS.403836085374401"
data <- importNGWMN_wml2(url) data <- importNGWMN_wml2(url)
url <- "http://cida.usgs.gov/ngwmn_cache/sos?request=GetObservation&service=SOS&version=2.0.0&observedProperty=urn:ogc:def:property:OGC:GroundWaterLevel&responseFormat=text/xml&featureOfInterest=VW_GWDP_GEOSERVER.USGS.474011117072901" url <- "http://cida.usgs.gov/ngwmn_cache/sos?request=GetObservation&service=SOS&version=2.0.0
&observedProperty=urn:ogc:def:property:OGC:GroundWaterLevel&responseFormat=text/xml&featureOfInterest=VW_GWDP_GEOSERVER.USGS.474011117072901"
data <- importNGWMN_wml2(url) data <- importNGWMN_wml2(url)
} }
......
...@@ -2,9 +2,9 @@ ...@@ -2,9 +2,9 @@
% Please edit documentation in R/readNGWMNdata.R % Please edit documentation in R/readNGWMNdata.R
\name{readNGWMNdata} \name{readNGWMNdata}
\alias{readNGWMNdata} \alias{readNGWMNdata}
\title{import data from the National Groundwater Monitoring Network \link{http://cida.usgs.gov/ngwmn/}.} \title{import data from the National Groundwater Monitoring Network \url{http://cida.usgs.gov/ngwmn/}.}
\usage{ \usage{
readNGWMNdata(featureID, request = "observation", asDateTime = FALSE) readNGWMNdata(featureID, request = "observation", 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
......
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