Added option to get extended qw results from NWIS.

R/constructNWISURL.r

@@ -13,6 +13,7 @@
 #' @param format string, can be "tsv" or "xml", and is only applicable for daily and unit value requests.  "tsv" returns results faster, but there is a possiblitiy that an incomplete file is returned without warning. XML is slower, 
 #' but will offer a warning if the file was incomplete (for example, if there was a momentary problem with the internet connection). It is possible to safely use the "tsv" option, 
 #' but the user must carefully check the results to see if the data returns matches what is expected. The default is therefore "xml". 
+#' @param expanded logical defaults to FALSE. If TRUE, retrieves additional information, only applicable for qw data.
 #' @param interactive logical Option for interactive mode.  If TRUE, there is user interaction for error handling and data checks.
 #' @keywords data import USGS web service
 #' @return url string
@@ -28,7 +29,7 @@
 #' url_qw <- constructNWISURL(siteNumber,c('01075','00029','00453'),startDate,endDate,'qw')
 #' url_wqp <- constructNWISURL(siteNumber,c('01075','00029','00453'),startDate,endDate,'wqp')
 #' url_daily_tsv <- constructNWISURL(siteNumber,pCode,startDate,endDate,'dv',statCd=c("00003","00001"),format="tsv")
-constructNWISURL <- function(siteNumber,parameterCd,startDate,endDate,service,statCd="00003", format="xml",interactive=TRUE){
+constructNWISURL <- function(siteNumber,parameterCd,startDate,endDate,service,statCd="00003", format="xml",expanded=FALSE,interactive=TRUE){
 
   startDate <- formatCheckDate(startDate, "StartDate", interactive=interactive)
   endDate <- formatCheckDate(endDate, "EndDate", interactive=interactive)
@@ -67,8 +68,13 @@ constructNWISURL <- function(siteNumber,parameterCd,startDate,endDate,service,st
                           "group_key=NONE&sitefile_output_format=html_table&column_name=agency_cd",
                           "column_name=site_no&column_name=station_nm&inventory_output=0&rdb_inventory_output=file",
                           "TZoutput=0&pm_cd_compare=Greater%20than&radio_parm_cds=previous_parm_cds&qw_attributes=0",
-                          "format=rdb&qw_sample_wide=separated_wide&rdb_qw_attributes=0&date_format=YYYY-MM-DD",
+                          "format=rdb&rdb_qw_attributes=0&date_format=YYYY-MM-DD",
                           "rdb_compression=value", sep = "&")
+             if(expanded){
+               url <- paste(url,"&qw_sample_wide=0",sep="")
+             } else {
+               url <- paste(url,"&qw_sample_wide=separated_wide",sep="")
+             }
              
              if (nzchar(startDate)) {
                url <- paste(url,"&begin_date=",startDate,sep="")

R/retrieveNWISqwData.r

@@ -8,10 +8,12 @@
 #' @param pCodes string or vector of USGS parameter code.  This is usually an 5 digit number.
 #' @param startDate string starting date for data retrieval in the form YYYY-MM-DD.
 #' @param endDate string ending date for data retrieval in the form YYYY-MM-DD.
+#' @param expanded logical defaults to FALSE. If TRUE, retrieves additional information.
 #' @param interactive logical Option for interactive mode.  If true, there is user interaction for error handling and data checks.
 #' @keywords data import USGS web service
 #' @return data dataframe with agency, site, dateTime, value, and code columns
 #' @export
+#' @import reshape2
 #' @examples
 #' # These examples require an internet connection to run
 #' siteNumber <- c('04024430','04024000')
@@ -19,14 +21,15 @@
 #' endDate <- ''
 #' pCodes <- c('34247','30234','32104','34220')
 #' rawNWISqwData <- retrieveNWISqwData(siteNumber,pCodes,startDate,endDate)
+#' rawNWISqwDataExpand <- retrieveNWISqwData(siteNumber,pCodes,startDate,endDate,expanded=TRUE)
 #' # To get data in Sample dataframe format:
 #' data <- rawNWISqwData[,names(rawNWISqwData) != "site"]
 #' data$dateTime <- as.Date(data$dateTime)
 #' compressedData <- compressData(data)
 #' Sample <- populateSampleColumns(compressedData)
-retrieveNWISqwData <- function (siteNumber,pCodes,startDate,endDate,interactive=TRUE){  
+retrieveNWISqwData <- function (siteNumber,pCodes,startDate,endDate,expanded=FALSE,interactive=TRUE){  
   
-  url <- constructNWISURL(siteNumber,pCodes,startDate,endDate,"qw",interactive=interactive)
+  url <- constructNWISURL(siteNumber,pCodes,startDate,endDate,"qw",expanded=expanded,interactive=interactive)
   
   tmp <- read.delim(  
     url, 
@@ -41,20 +44,47 @@ retrieveNWISqwData <- function (siteNumber,pCodes,startDate,endDate,interactive=
   dataType <- tmp[1,]
   data <- tmp[-1,]
   row.names(data) <- NULL
-  data$site <- with(data,paste(agency_cd,site_no,sep="-"))
-  data$dateTime <- with(data, as.POSIXct(paste(sample_dt,sample_tm,sep=" "),tz="UTC"))
   
-  rmCol <- c("agency_cd","site_no","tm_datum_rlbty_cd",
-             "coll_ent_cd","medium_cd","tu_id","body_part_id",
-             "sample_end_dt","sample_end_tm","sample_dt","sample_tm","sample_start_time_datum_cd")
-  data <- data[,!(names(data) %in% rmCol)]
   
-  names(data) <- c(gsub("r", "qualifier_",names(data)[1:(length(names(data))-2)]),names(data)[(length(names(data))-1):length(names(data))])
-  names(data) <- c(gsub("p", "value_",names(data)[1:(length(names(data))-2)]),names(data)[(length(names(data))-1):length(names(data))])
   
-  data[,grep("value",names(data))] <- sapply( data[,grep("value",names(data))], function(x) as.numeric(x))
-  
-  data <- data[,c(ncol(data):(ncol(data)-1),(1:(ncol(data)-2)))]
+  if(expanded){
+    data$site <- with(data,paste(agency_cd,site_no,sep="-"))
+    data$dateTime <- with(data, as.POSIXct(paste(sample_dt,sample_tm,sep=" "),tz="UTC"))
+    
+    if (any("" != data[["sample_end_dt"]])){
+      data$dateTimeEnd <- with(data, as.POSIXct(paste(sample_end_dt,sample_end_tm,sep=" "),tz="UTC"))
+    } 
+    
+    data$result_va <- as.numeric(data$result_va)
+    data$rpt_lev_va <- as.numeric(data$rpt_lev_va)
+    rmCol <- c("agency_cd","site_no","tm_datum_rlbty_cd",
+               "coll_ent_cd","medium_cd","tu_id","body_part_id",
+               "sample_end_dt","sample_end_tm","sample_dt","sample_tm",
+               "sample_start_time_datum_cd","anl_ent_cd","lab_std_va")
+    data <- data[,!(names(data) %in% rmCol)]
+    
+    longDF <- melt(data, c("parm_cd","dateTime","site"))
+    wideDF <- dcast(longDF, ... ~ variable + parm_cd )
+    wideDF[,grep("_va_",names(wideDF))] <- sapply(wideDF[,grep("_va_",names(wideDF))], function(x) as.numeric(x))
+    order(sapply(strsplit(names(wideDF)[c(-1:-2)],"_"), function(x) x[length(x)]))
+    
+    data <- wideDF[,c(1,2,(2+order(sapply(strsplit(names(wideDF)[c(-1:-2)],"_"), function(x) x[length(x)]))))]
+    
+  } else {
+    data$site <- with(data,paste(agency_cd,site_no,sep="-"))
+    data$dateTime <- with(data, as.POSIXct(paste(sample_dt,sample_tm,sep=" "),tz="UTC"))
+    rmCol <- c("agency_cd","site_no","tm_datum_rlbty_cd",
+               "coll_ent_cd","medium_cd","tu_id","body_part_id",
+               "sample_end_dt","sample_end_tm","sample_dt","sample_tm","sample_start_time_datum_cd")
+    data <- data[,!(names(data) %in% rmCol)]
+    
+    names(data) <- c(gsub("r", "qualifier_",names(data)[1:(length(names(data))-2)]),names(data)[(length(names(data))-1):length(names(data))])
+    names(data) <- c(gsub("p", "value_",names(data)[1:(length(names(data))-2)]),names(data)[(length(names(data))-1):length(names(data))])
+    
+    data[,grep("value",names(data))] <- sapply( data[,grep("value",names(data))], function(x) as.numeric(x))
+    
+    data <- data[,c(ncol(data):(ncol(data)-1),(1:(ncol(data)-2)))]
+  }
   
   return (data)
 }

man/constructNWISURL.Rd

@@ -3,7 +3,8 @@
 \title{Construct NWIS url for data retrieval}
 \usage{
 constructNWISURL(siteNumber, parameterCd, startDate, endDate, service,
-  statCd = "00003", format = "xml", interactive = TRUE)
+  statCd = "00003", format = "xml", expanded = FALSE,
+  interactive = TRUE)
 }
 \arguments{
   \item{siteNumber}{string or vector of strings USGS site
@@ -38,6 +39,10 @@ constructNWISURL(siteNumber, parameterCd, startDate, endDate, service,
   the results to see if the data returns matches what is
   expected. The default is therefore "xml".}
 
+  \item{expanded}{logical defaults to FALSE. If TRUE,
+  retrieves additional information, only applicable for qw
+  data.}
+
   \item{interactive}{logical Option for interactive mode.
   If TRUE, there is user interaction for error handling and
   data checks.}

man/retrieveNWISqwData.Rd

@@ -2,7 +2,8 @@
 \alias{retrieveNWISqwData}
 \title{Raw Data Import for USGS NWIS QW Data}
 \usage{
-retrieveNWISqwData(siteNumber, pCodes, startDate, endDate, interactive = TRUE)
+retrieveNWISqwData(siteNumber, pCodes, startDate, endDate, expanded = FALSE,
+  interactive = TRUE)
 }
 \arguments{
   \item{siteNumber}{string or vector of strings USGS site
@@ -17,6 +18,9 @@ retrieveNWISqwData(siteNumber, pCodes, startDate, endDate, interactive = TRUE)
   \item{endDate}{string ending date for data retrieval in
   the form YYYY-MM-DD.}
 
+  \item{expanded}{logical defaults to FALSE. If TRUE,
+  retrieves additional information.}
+
   \item{interactive}{logical Option for interactive mode.
   If true, there is user interaction for error handling and
   data checks.}
@@ -41,6 +45,7 @@ startDate <- '2010-01-01'
 endDate <- ''
 pCodes <- c('34247','30234','32104','34220')
 rawNWISqwData <- retrieveNWISqwData(siteNumber,pCodes,startDate,endDate)
+rawNWISqwDataExpand <- retrieveNWISqwData(siteNumber,pCodes,startDate,endDate,expanded=TRUE)
 # To get data in Sample dataframe format:
 data <- rawNWISqwData[,names(rawNWISqwData) != "site"]
 data$dateTime <- as.Date(data$dateTime)