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

new branch

parent 9b1669bc
...@@ -14,6 +14,7 @@ export(importWaterML1) ...@@ -14,6 +14,7 @@ export(importWaterML1)
export(importWaterML2) export(importWaterML2)
export(pCodeToName) export(pCodeToName)
export(parameterCdFile) export(parameterCdFile)
export(readNGWMNdata)
export(readNWISdata) export(readNWISdata)
export(readNWISdv) export(readNWISdv)
export(readNWISgwl) export(readNWISgwl)
...@@ -47,6 +48,7 @@ importFrom(curl,curl_version) ...@@ -47,6 +48,7 @@ importFrom(curl,curl_version)
importFrom(dplyr,bind_rows) importFrom(dplyr,bind_rows)
importFrom(dplyr,full_join) importFrom(dplyr,full_join)
importFrom(dplyr,left_join) importFrom(dplyr,left_join)
importFrom(dplyr,mutate)
importFrom(dplyr,mutate_) importFrom(dplyr,mutate_)
importFrom(dplyr,mutate_each_) importFrom(dplyr,mutate_each_)
importFrom(dplyr,rbind_all) importFrom(dplyr,rbind_all)
......
#' Function to return data from the WaterML2 data #' Function to return data from the National Ground Water Monitoring Network waterML2 format
#' #'
#' This function accepts a url parameter for a WaterML2 getObservation. This function is still under development, #' This function accepts a url parameter for a WaterML2 getObservation. This function is still under development,
#' but the general functionality is correct. #' but the general functionality is correct.
#' #'
#' @param input character or raw, containing the url for the retrieval or a path to the data file, or raw XML. #' @param input character or raw, containing the url for the retrieval or a path to the data file, or raw XML.
#' @param asDateTime logical, if \code{TRUE} returns date and time as POSIXct, if \code{FALSE}, character #' @param asDateTime logical, if \code{TRUE} returns date and time as POSIXct, if \code{FALSE}, character
#' @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 tz_cd column). #' datetimes to UTC (properly accounting for daylight savings times based on the data's provided tz_cd column).
#' 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",
#' "America/Anchorage","America/Honolulu","America/Jamaica","America/Managua","America/Phoenix", and "America/Metlakatla" #' "America/Anchorage","America/Honolulu","America/Jamaica","America/Managua","America/Phoenix", and "America/Metlakatla"
#' @return mergedDF a data frame time, value, description, qualifier, and identifier #' @return mergedDF a data frame source, time, value, uom, uomTitle, comment, gmlID
#' @export #' @export
#' @importFrom xml2 read_xml #' @importFrom xml2 read_xml
#' @importFrom xml2 xml_find_all #' @importFrom xml2 xml_find_all
...@@ -17,9 +17,12 @@ ...@@ -17,9 +17,12 @@
#' @importFrom xml2 xml_attr #' @importFrom xml2 xml_attr
#' @importFrom lubridate parse_date_time #' @importFrom lubridate parse_date_time
#' @examples #' @examples
#' #' \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"
#' data <- importNGWMN_wml2(url)
#' }
importNGMWN_wml2 <- function(input, asDateTime=FALSE, tz=""){ importNGMWN_wml2 <- function(input, asDateTime=FALSE, tz=""){
#TODO: update documentation
if(tz != ""){ if(tz != ""){
tz <- match.arg(tz, c("America/New_York","America/Chicago", tz <- match.arg(tz, c("America/New_York","America/Chicago",
"America/Denver","America/Los_Angeles", "America/Denver","America/Los_Angeles",
...@@ -38,58 +41,59 @@ importNGMWN_wml2 <- function(input, asDateTime=FALSE, tz=""){ ...@@ -38,58 +41,59 @@ importNGMWN_wml2 <- function(input, asDateTime=FALSE, tz=""){
returnedDoc <- xml_root(getWebServiceData(input, encoding='gzip')) returnedDoc <- xml_root(getWebServiceData(input, encoding='gzip'))
} }
response <- xml_name(returnedDoc)
if(response == "GetObservationResponse"){
timeSeries <- xml_find_all(returnedDoc, "//wml2:MeasurementTimeseries") #each parameter/site combo
timeSeries <- xml_find_all(returnedDoc, "//wml2:MeasurementTimeseries") #each parameter/site combo
if(0 == length(timeSeries)){
df <- data.frame() if(0 == length(timeSeries)){
if(!raw){ df <- data.frame()
attr(df, "url") <- input if(!raw){
} attr(df, "url") <- input
return(df) }
} return(df)
mergedDF <- NULL
for(t in timeSeries){
gmlID <- xml_attr(t,"id")
uomTitle <- xml_attr(xml_find_all(t, ".//wml2:uom"), "title")
TVP <- xml_find_all(t, ".//wml2:MeasurementTVP")#time-value pairs
time <- xml_text(xml_find_all(TVP,".//wml2:time"))
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)
#^^setting tz in as.POSIXct just sets the attribute, does not convert the time!
attr(time, 'tzone') <- tz
} }
valueNodes <- xml_find_all(TVP,".//wml2:value")
values <- as.numeric(xml_text(valueNodes))
nVals <- length(values)
gmlID <- rep(gmlID, nVals)
uomTitle <- rep(uomTitle, nVals)
uom <- removeBlanks(xml_attr(valueNodes, "uom", default = NA)) mergedDF <- NULL
source <- xml_attr(xml_find_all(TVP, ".//wml2:source"), "title")
comment <- removeBlanks(xml_text(xml_find_all(TVP, ".//wml2:comment")))
df <- cbind.data.frame(source, time, value=values, uom, uomTitle, comment, gmlID, for(t in timeSeries){
stringsAsFactors=FALSE) gmlID <- xml_attr(t,"id")
if (is.null(mergedDF)){ TVP <- xml_find_all(t, ".//wml2:MeasurementTVP")#time-value pairs
mergedDF <- df time <- xml_text(xml_find_all(TVP,".//wml2:time"))
} else { if(asDateTime){
similarNames <- intersect(colnames(mergedDF), colnames(df)) time <- parse_date_time(time, c("%Y","%Y-%m-%d","%Y-%m-%dT%H:%M","%Y-%m-%dT%H:%M:%S",
mergedDF <- full_join(mergedDF, df, by=similarNames) "%Y-%m-%dT%H:%M:%OS","%Y-%m-%dT%H:%M:%OS%z"), exact = TRUE)
#^^setting tz in as.POSIXct just sets the attribute, does not convert the time!
attr(time, 'tzone') <- tz
}
valueNodes <- xml_find_all(TVP,".//wml2:value")
values <- as.numeric(xml_text(valueNodes))
nVals <- length(values)
gmlID <- rep(gmlID, nVals)
uom <- removeBlanks(xml_attr(valueNodes, "uom", default = NA))
source <- xml_attr(xml_find_all(TVP, ".//wml2:source"), "title")
comment <- removeBlanks(xml_text(xml_find_all(TVP, ".//wml2:comment")))
df <- cbind.data.frame(source, time, value=values, uom, comment, gmlID,
stringsAsFactors=FALSE)
if (is.null(mergedDF)){
mergedDF <- df
} else {
similarNames <- intersect(colnames(mergedDF), colnames(df))
mergedDF <- full_join(mergedDF, df, by=similarNames)
}
} }
if(!raw){
url <- input
attr(mergedDF, "url") <- url
}
attr(mergedDF, "gml:identifier") <- xml_text(xml_find_all(returnedDoc, ".//gml:identifier"))
attr(mergedDF, "generationDate") <- xml_text(xml_find_all(returnedDoc, ".//wml2:generationDate"))
}else if(response == "ExceptionReport"){
#TODO: what happens if exception?
} }
if(!raw){
url <- input
attr(mergedDF, "url") <- url
}
attr(mergedDF, "gml:identifier") <- xml_text(xml_find_all(returnedDoc, ".//gml:identifier"))
attr(mergedDF, "generationDate") <- xml_text(xml_find_all(returnedDoc, ".//wml2:generationDate"))
return(mergedDF) return(mergedDF)
} }
......
#' import data from the National Groundwater Monitoring Network \link{http://cida.usgs.gov/ngwmn/} #' import data from the National Groundwater Monitoring Network \link{http://cida.usgs.gov/ngwmn/}
#' Only water level data and site metadata is currently available through the web service. #' Only water level data and site metadata is currently available through the web service.
#' @param asDateTime #' @param asDateTime logical
#' @param sites #' @param featureID character
#' @param request #' @param request character
#' @import utils
#' @importFrom dplyr mutate
#' @export
#' #'
#TODO: documentation once more solidified
readNGWMNdata <- function(sites, request = "observation", asDateTime = TRUE){ readNGWMNdata <- function(featureID, request = "observation", asDateTime = TRUE){
match.arg(request, c("observation", "featureOfInterest"))
if(request == "observation"){
#allow for multiple site calls, and aggregate here?
#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."
url <- paste0(baseURL, featureID)
returnData <- importNGMWN_wml2(url, asDateTime)
#tack on site number
siteNum <- rep(sub('.*\\.', '', featureID), nrow(returnData))
returnData <- mutate(returnData, site = siteNum)
returnData <- returnData[,c(7,1:6)] #move siteNum to the left
}
return(returnData)
} }
\ No newline at end of file
This diff is collapsed.
...@@ -2,7 +2,7 @@ ...@@ -2,7 +2,7 @@
% Please edit documentation in R/importNGWMN_wml2.R % Please edit documentation in R/importNGWMN_wml2.R
\name{importNGMWN_wml2} \name{importNGMWN_wml2}
\alias{importNGMWN_wml2} \alias{importNGMWN_wml2}
\title{Function to return data from the WaterML2 data} \title{Function to return data from the National Ground Water Monitoring Network waterML2 format}
\usage{ \usage{
importNGMWN_wml2(input, asDateTime = FALSE, tz = "") importNGMWN_wml2(input, asDateTime = FALSE, tz = "")
} }
...@@ -17,13 +17,16 @@ Possible values to provide are "America/New_York","America/Chicago", "America/De ...@@ -17,13 +17,16 @@ Possible values to provide are "America/New_York","America/Chicago", "America/De
"America/Anchorage","America/Honolulu","America/Jamaica","America/Managua","America/Phoenix", and "America/Metlakatla"} "America/Anchorage","America/Honolulu","America/Jamaica","America/Managua","America/Phoenix", and "America/Metlakatla"}
} }
\value{ \value{
mergedDF a data frame time, value, description, qualifier, and identifier mergedDF a data frame source, time, value, uom, uomTitle, comment, gmlID
} }
\description{ \description{
This function accepts a url parameter for a WaterML2 getObservation. This function is still under development, This function accepts a url parameter for a WaterML2 getObservation. This function is still under development,
but the general functionality is correct. but the general functionality is correct.
} }
\examples{ \examples{
\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"
data <- importNGWMN_wml2(url)
}
} }
...@@ -2,14 +2,20 @@ ...@@ -2,14 +2,20 @@
% 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 \link{http://cida.usgs.gov/ngwmn/}
Only water level data and site metadata is currently available through the web service.}
\usage{ \usage{
readNGWMNdata(sites, request = "observation", asDateTime = TRUE) readNGWMNdata(featureID, request = "observation", asDateTime = TRUE)
} }
\arguments{ \arguments{
\item{request}{} \item{featureID}{character}
\item{request}{character}
\item{asDateTime}{logical}
} }
\description{ \description{
import data from the National Groundwater Monitoring Network \link{http://cida.usgs.gov/ngwmn/} import data from the National Groundwater Monitoring Network \link{http://cida.usgs.gov/ngwmn/}
Only water level data and site metadata 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