Added new site finding function for NWIS.

R/getNWISSites.R

+#' Site Data Import from NWIS
+#'
+#' Returns a list of sites from the NWIS web service. This function gets the data from: \url{http://waterservices.usgs.gov/rest/Site-Test-Tool.html}.
+#' Arguments to the function should be based on \url{http://waterservices.usgs.gov/rest/Site-Service.html#Service}
+#'
+#' @param \dots see \url{http://waterservices.usgs.gov/rest/Site-Service.html#Service} for a complete list of options
+#' @keywords data import NWIS web service
+#' @return retval dataframe 
+#' @export
+#' @examples
+#' siteListPhos <- getNWISSites(stateCd="OH",parameterCd="00665")
+getNWISSites <- function(...){
+  
+  matchReturn <- match.call()
+
+  values <- sapply(matchReturn[-1], function(x) URLencode(as.character(paste(x,collapse="",sep=""))))
+  
+  urlCall <- paste(paste(names(values),values,sep="="),collapse="&")
+  
+  
+  baseURL <- "http://waterservices.usgs.gov/nwis/site/?format=rdb&siteOutput=expanded&"
+  urlCall <- paste(baseURL,
+                   urlCall,sep = "")
+
+  retval <- getRDB1Data(urlCall)
+
+  return(retval)
+}

R/getRDB1Data.r

@@ -31,15 +31,19 @@ getRDB1Data <- function(obs_url,asDateTime=FALSE){
   dataType <- tmp[1,]
   data <- tmp[-1,]
   
-  if (asDateTime){
-    data[,regexpr('d$', dataType) > 0] <- as.POSIXct(strptime(data[,regexpr('d$', dataType) > 0], "%Y-%m-%d %H:%M"))
-  } else {
-    data[,regexpr('d$', dataType) > 0] <- as.Date(data[,regexpr('d$', dataType) > 0])
+  if(sum(regexpr('d$', dataType) > 0) > 0){
+    if (asDateTime){
+      data[,regexpr('d$', dataType) > 0] <- as.POSIXct(strptime(data[,regexpr('d$', dataType) > 0], "%Y-%m-%d %H:%M"))
+    } else {
+      data[,regexpr('d$', dataType) > 0] <- as.Date(data[,regexpr('d$', dataType) > 0])
+    }
   }
   
-  tempDF <- data[,which(regexpr('n$', dataType) > 0)]
-  tempDF <- suppressWarnings(sapply(tempDF, function(x) as.numeric(x)))  
-  data[,which(regexpr('n$', dataType) > 0)] <- tempDF
+  if (sum(regexpr('n$', dataType) > 0) > 0){
+    tempDF <- data[,which(regexpr('n$', dataType) > 0)]
+    tempDF <- suppressWarnings(sapply(tempDF, function(x) as.numeric(x)))  
+    data[,which(regexpr('n$', dataType) > 0)] <- tempDF
+  }
   row.names(data) <- NULL
   return(data)
 }