Commit 2061d22f authored by David Watkins's avatar David Watkins
Browse files

multi-site good to go?

parent dc4a18c2
......@@ -91,7 +91,23 @@ importNGMWN_wml2 <- function(input, asDateTime=FALSE, tz=""){
}
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"){
}else if(response == "GetFeatureOfInterestResponse"){
site <- xml_text(xml_find_all(returnedDoc,".//gml:identifier"))
site <- substring(site, 8)
#bandaid to work with only single site calls
#TODO: need better solution when bbox is added
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(lat=siteLocs[[1]][1], lon=siteLocs[[1]][2], stringsAsFactors = FALSE)
mergedDF <- cbind.data.frame(site, description = siteDesc, siteLocs, stringsAsFactors = FALSE)
}
else if(response == "ExceptionReport"){
#TODO: what happens if exception?
}
return(mergedDF)
......
......@@ -16,13 +16,17 @@ readNGWMNdata <- function(featureID, request = "observation", asDateTime = TRUE)
if(request == "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")
for(f in featureID){
obsFID <- retrieveObservation(f, asDateTime, attrs)
siteFID <- retrieveFeatureOfInterest(f)
if(is.null(allObs)){
allObs <- obsFID
allSites <- siteFID
}else{
#TODO: can attaching attributes wait till the end?
obsFIDatt <- saveAttrs(attrs, obsFID)
allAttrs <- saveAttrs(attrs, allObs)
allObs <- removeAttrs(attrs, allObs)
......@@ -30,16 +34,17 @@ readNGWMNdata <- function(featureID, request = "observation", asDateTime = TRUE)
allAttrs <- bind_rows(allAttrs, obsFIDatt)
allObs <- bind_rows(allObs, obsFID)
attributes(allObs) <- c(attributes(allObs),as.list(allAttrs))
allSites <- bind_rows(allSites, siteFID)
}
attr(allObs, "siteInfo") <- allSites
returnData <- allObs
}
}
} #TODO: add direct feature of interest request
return(returnData)
}
retrieveObservation <- function(featureID, asDateTime, attrs){
#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)
......@@ -51,7 +56,6 @@ retrieveObservation <- function(featureID, asDateTime, attrs){
attr(returnData, "generationDate") <- NA
}
#mutate removes the attributes, need to save and append
attribs <- saveAttrs(attrs, returnData)
if(nrow(returnData) > 0){
......@@ -61,13 +65,30 @@ retrieveObservation <- function(featureID, asDateTime, attrs){
returnData <- returnData[,c(7,1:6)] #move siteNum to the left
}
attributes(returnData) <- c(attributes(returnData), as.list(attribs))
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){
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)
siteDF <- importNGMWN_wml2(url, asDateTime)
return(siteDF)
}
#save specified attributes from a data frame
saveAttrs <- function(attrs, df){
attribs <- sapply(attrs, function(x) attr(df, x))
return(as.data.frame(t(attribs), stringsAsFactors = FALSE))
if(is.vector(attribs)){
toReturn <- as.data.frame(t(attribs), stringsAsFactors = FALSE)
}else{ #don't need to transpose
toReturn <- as.data.frame(attribs, stringsAsFactors = FALSE)
}
return(toReturn)
}
#strip specified attributes from a data frame
......
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