From c808a33e255b3f61b3502afa22d20d98546c149f Mon Sep 17 00:00:00 2001
From: unknown <ldecicco@usgs.gov>
Date: Tue, 21 Oct 2014 16:47:44 -0500
Subject: [PATCH] Renamed to parseWQPData
---
R/basicWQPData.R | 130 -----------------------------------------------
1 file changed, 130 deletions(-)
delete mode 100644 R/basicWQPData.R
diff --git a/R/basicWQPData.R b/R/basicWQPData.R
deleted file mode 100644
index 13ffe915..00000000
--- a/R/basicWQPData.R
+++ /dev/null
@@ -1,130 +0,0 @@
-#' Basic Water Quality Portal Data grabber
-#'
-#' Imports data from the Water Quality Portal based on a specified url.
-#'
-#' @param url string URL to Water Quality Portal#' @keywords data import USGS web service
-#' @return retval dataframe raw data returned from the Water Quality Portal. Additionally, a POSIXct dateTime column is supplied for
-#' start and end times.
-#' @export
-#' @import RCurl
-#' @importFrom lubridate parse_date_time
-#' @examples
-#' # These examples require an internet connection to run
-#' \dontrun{
-#' ## Examples take longer than 5 seconds:
-#' rawSampleURL <- constructNWISURL('USGS-01594440','01075', '1985-01-01', '1985-03-31',"wqp")
-#' rawSample <- readWQPData(rawSampleURL)
-#' }
-readWQPData <- function(url){
-
- h <- basicHeaderGatherer()
-
- retval = tryCatch({
- doc <- getURL(url, headerfunction = h$update)
-
- }, warning = function(w) {
- message(paste("URL caused a warning:", url))
- message(w)
- }, error = function(e) {
- message(paste("URL does not seem to exist:", url))
- message(e)
- return(NA)
- })
-
- if(h$value()["Content-Type"] == "text/tab-separated-values;charset=UTF-8"){
-
- numToBeReturned <- as.numeric(h$value()["Total-Result-Count"])
-
- if (!is.na(numToBeReturned) | numToBeReturned != 0){
-
-
- namesData <- read.delim(textConnection(doc), header = TRUE, quote="\"",
- dec=".", sep='\t',
- colClasses='character',
- fill = TRUE,nrow=1)
- classColumns <- setNames(rep('character',ncol(namesData)),names(namesData))
-
- classColumns[grep("MeasureValue",names(classColumns))] <- NA
-
- retval <- read.delim(textConnection(doc), header = TRUE, quote="\"",
- dec=".", sep='\t',
- colClasses=as.character(classColumns),
- fill = TRUE)
- actualNumReturned <- nrow(retval)
-
- retval[,names(which(sapply(retval[,grep("MeasureValue",names(retval))], function(x)all(is.na(x)))))] <- ""
-
- if(actualNumReturned != numToBeReturned) warning(numToBeReturned, " sample results were expected, ", actualNumReturned, " were returned")
-
- timeZoneLibrary <- setNames(c("America/New_York","America/New_York","America/Chicago","America/Chicago",
- "America/Denver","America/Denver","America/Los_Angeles","America/Los_Angeles",
- "America/Anchorage","America/Anchorage","America/Honolulu","America/Honolulu"),
- c("EST","EDT","CST","CDT","MST","MDT","PST","PDT","AKST","AKDT","HAST","HST"))
- timeZoneStart <- as.character(timeZoneLibrary[retval$ActivityStartTime.TimeZoneCode])
- timeZoneEnd <- as.character(timeZoneLibrary[retval$ActivityEndTime.TimeZoneCode])
- timeZoneStart[is.na(timeZoneStart)] <- ""
- timeZoneEnd[is.na(timeZoneEnd)] <- ""
-
- if("ActivityStartDate" %in% names(retval)){
- if(any(retval$ActivityStartDate != "")){
- suppressWarnings(retval$ActivityStartDate <- as.Date(parse_date_time(retval$ActivityStartDate, c("Ymd", "mdY"))))
- }
- }
-
- if("ActivityEndDate" %in% names(retval)){
- if(any(retval$ActivityEndDate != "")){
- suppressWarnings(retval$ActivityEndDate <- as.Date(parse_date_time(retval$ActivityEndDate, c("Ymd", "mdY"))))
- }
- }
-
- if(any(!is.na(timeZoneStart))){
- if(length(unique(timeZoneStart)) == 1){
- retval$ActivityStartDateTime <- with(retval, as.POSIXct(paste(ActivityStartDate, ActivityStartTime.Time),format="%Y-%m-%d %H:%M:%S", tz=unique(timeZoneStart)))
- } else {
-
- mostCommonTZ <- names(sort(summary(as.factor(timeZoneStart)),decreasing = TRUE)[1])
-
- retval$ActivityStartDateTime <- with(retval, as.POSIXct(paste(ActivityStartDate, ActivityStartTime.Time),
- format="%Y-%m-%d %H:%M:%S",
- tz=mostCommonTZ))
- additionalTZs <- names(sort(summary(as.factor(timeZoneStart)),decreasing = TRUE)[-1])
- for(i in additionalTZs){
- retval$ActivityStartDateTime[timeZoneStart == i] <- with(retval[timeZoneStart == i,],
- as.POSIXct(paste(ActivityStartDate, ActivityStartTime.Time),
- format="%Y-%m-%d %H:%M:%S",
- tz=i))
- }
- }
- }
-
- if(any(!is.na(timeZoneEnd))){
- if(length(unique(timeZoneEnd)) == 1){
- retval$ActivityEndDateTime <- with(retval, as.POSIXct(paste(ActivityEndDate, ActivityEndTime.Time), format="%Y-%m-%d %H:%M:%S",tz=unique(timeZoneEnd)))
- } else {
- mostCommonTZ <- names(sort(summary(as.factor(timeZoneEnd)),decreasing = TRUE)[1])
-
- retval$ActivityEndDateTime <- with(retval, as.POSIXct(paste(ActivityEndDate, ActivityEndTime.Time),
- format="%Y-%m-%d %H:%M:%S",
- tz=mostCommonTZ))
- additionalTZs <- names(sort(summary(as.factor(timeZoneEnd)),decreasing = TRUE)[-1])
- for(i in additionalTZs){
- retval$ActivityEndDateTime[timeZoneEnd == i] <- with(retval[timeZoneEnd == i,],
- as.POSIXct(paste(ActivityEndDate, ActivityEndTime.Time),
- format="%Y-%m-%d %H:%M:%S",
- tz=i))
- }
- }
- }
-
- return(retval)
-
- } else {
- warning("No data to retrieve")
- return(NA)
- }
- } else {
- message(paste("URL caused an error:", url))
- message("Content-Type=",h$value()["Content-Type"])
- return(NA)
- }
-}
\ No newline at end of file
--
GitLab