#' Site Data Import from Water Quality Portal #' #' Returns a list of sites from the Water Quality Portal web service. This function gets the data from: \url{http://www.waterqualitydata.us}. #' Arguments to the function should be based on \url{www.waterqualitydata.us/webservices_documentation.jsp} #' #' @param \dots see \url{www.waterqualitydata.us/webservices_documentation.jsp} for a complete list of options #' @keywords data import WQP web service #' @return retval dataframe with first column dateTime, and at least one qualifier and value columns #' (subsequent qualifier/value columns could follow depending on requested parameter codes) #' @export #' @examples #' \dontrun{ #' site1 <- whatWQPsites(siteid="USGS-01594440") #' #' type <- "Stream" #' sites <- whatWQPsites(statecode="US:55",countycode="US:55:025",siteType=type) #' } whatWQPsites <- function(...){ matchReturn <- list(...) options <- c("bBox","lat","long","within","countrycode","statecode","countycode","siteType","organization", "siteid","huc","sampleMedia","characteristicType","characteristicName","pCode","activityId", "startDateLo","startDateHi","mimeType","Zip","providers") if(!all(names(matchReturn) %in% options)) warning(matchReturn[!(names(matchReturn) %in% options)],"is not a valid query parameter to the Water Quality Portal") values <- sapply(matchReturn, function(x) URLencode(as.character(paste(eval(x),collapse="",sep="")))) urlCall <- paste(paste(names(values),values,sep="="),collapse="&") baseURL <- "http://www.waterqualitydata.us/Station/search?" urlCall <- paste(baseURL, urlCall, "&mimeType=tsv",sep = "") retval = tryCatch({ h <- basicHeaderGatherer() doc <- getURL(urlCall, headerfunction = h$update) }, warning = function(w) { message(paste("URL caused a warning:", urlCall)) message(w) }, error = function(e) { message(paste("URL does not seem to exist:", urlCall)) message(e) return(NA) }) if(h$value()["Content-Type"] == "text/tab-separated-values;charset=UTF-8"){ numToBeReturned <- as.numeric(h$value()["Total-Site-Count"]) if (!is.na(numToBeReturned) | numToBeReturned != 0){ retval <- read.delim(textConnection(doc), header = TRUE, quote="\"", dec=".", sep='\t', colClasses=c('character'), fill = TRUE) actualNumReturned <- nrow(retval) if(actualNumReturned != numToBeReturned) warning(numToBeReturned, " sites were expected, ", actualNumReturned, " were returned") if("LatitudeMeasure" %in% names(retval)){ retval$LatitudeMeasure <- as.numeric(retval$LatitudeMeasure) } if("LongitudeMeasure" %in% names(retval)){ retval$LongitudeMeasure <- as.numeric(retval$LongitudeMeasure) } retval$queryTime <- Sys.time() return(retval) } else { warning(paste("No data to retrieve from",urlCall)) return(NA) } } else { message(paste("URL caused an error:", urlCall)) message("Content-Type=",h$value()["Content-Type"]) return(NA) } }