Merge pull request #127 from ldecicco-USGS/master

WQP update.

DESCRIPTION

 Package: dataRetrieval
 Type: Package
 Title: Retrieval Functions for USGS and EPA Hydrologic and Water Quality Data
-Version: 2.2.1
-Date: 2015-04-22
+Version: 2.2.2
+Date: 2015-06-05
 Authors@R: c( person("Robert", "Hirsch", role = c("aut"),
     email = "rhirsch@usgs.gov"),
     person("Laura", "DeCicco", role = c("aut","cre"),

NAMESPACE

@@ -33,5 +33,6 @@ export(zeroPad)
 import(RCurl)
 import(XML)
 import(lubridate)
-import(reshape2)
 importFrom(plyr,rbind.fill.matrix)
+importFrom(reshape2,dcast)
+importFrom(reshape2,melt)

R/checkWQPdates.r

@@ -6,6 +6,7 @@
 #' @param values named list with arguments to send to the Water Quality Portal
 #' @return values named list with corrected arguments to send to the Water Quality Portal
 #' @export
+#' @keywords internal
 #' @examples
 #' values <- list(startDateLo="01-01-2002", characteristicName="Phosphorous", 
 #'           endDate=as.Date("2014-01-01"))

R/constructNWISURL.r

@@ -267,7 +267,7 @@ constructWQPURL <- function(siteNumber,parameterCd,startDate,endDate){
     url <- paste0(url, "&startDateHi=",endDate)
   }
   
-  url <- paste0(url,"&countrycode=US&mimeType=tsv")
+  url <- paste0(url,"&sorted=no&mimeType=tsv")
   return(url)
 
 }

R/importWQP.R

@@ -72,19 +72,15 @@ importWQP <- function(obs_url, zip=FALSE, tz=""){
   
   if (!is.na(numToBeReturned) & numToBeReturned != 0){
 
-    suppressWarnings(namesData <- read.delim(if(zip) doc else textConnection(doc) , header = TRUE, quote="\"",
-                                             dec=".", sep='\t',
-                                             colClasses='character',
-                                             fill = TRUE,nrow=1))
+    suppressWarnings(namesData <- read.delim(if(zip) doc else textConnection(doc) , header = TRUE, quote="",
+                                             dec=".", sep='\t', colClasses='character',nrow=1))
           
     classColumns <- setNames(rep('character',ncol(namesData)),names(namesData))
     
     classColumns[grep("MeasureValue",names(classColumns))] <- NA
     
-    suppressWarnings(retval <- read.delim(if(zip) doc else textConnection(doc), header = TRUE, quote="\"", 
-                         dec=".", sep='\t', 
-                         colClasses=as.character(classColumns), 
-                         fill = TRUE))
+    suppressWarnings(retval <- read.delim(if(zip) doc else textConnection(doc), header = TRUE, quote="", 
+                         dec=".", sep='\t', colClasses=as.character(classColumns)))
     
     actualNumReturned <- nrow(retval)
     
@@ -142,6 +138,10 @@ importWQP <- function(obs_url, zip=FALSE, tz=""){
       unlink(doc)
     }
     
+    retval <- retval[order(retval$OrganizationIdentifier, 
+                           retval$MonitoringLocationIdentifier, 
+                           retval$ActivityStartDateTime, decreasing = FALSE),]
+    
     return(retval)
   
   } else {

R/importWaterML1.r

@@ -40,7 +40,8 @@
 #' @export
 #' @import XML
 #' @import RCurl
-#' @import reshape2
+#' @importFrom  reshape2 melt
+#' @importFrom reshape2 dcast
 #' @examples
 #' siteNumber <- "02177000"
 #' startDate <- "2012-09-01"
@@ -403,8 +404,11 @@ importWaterML1 <- function(obs_url,asDateTime=FALSE, tz=""){
     qualColumns <- unique(qualColumns)
     
     sortingColumns <- names(mergedDF)[!(names(mergedDF) %in% c(dataColumns,qualColumns))]
-  
-    meltedmergedDF  <- melt(mergedDF,id.vars=sortingColumns)
+
+    meltedmergedDF <- reshape2::melt(mergedDF, measure.vars =  c(dataColumns,qualColumns),
+                            variable.name = "variable", value.name = "value", na.rm = FALSE)
+    rownames(meltedmergedDF) <- NULL
+    # meltedmergedDF  <- reshape2::melt(mergedDF,id.vars=sortingColumns)
     meltedmergedDF  <- meltedmergedDF[!is.na(meltedmergedDF$value),] 
     
     meltedmergedDF <- meltedmergedDF[!duplicated(meltedmergedDF),]
@@ -416,7 +420,7 @@ importWaterML1 <- function(obs_url,asDateTime=FALSE, tz=""){
     indexDups <- as.numeric(row.names(qualDups))
   
     if(length(indexDups) > 0){
-      mergedDF2 <- dcast(meltedmergedDF[-indexDups,], castFormula, drop=FALSE, value.var = "value",)
+      mergedDF2 <- reshape2::dcast(meltedmergedDF[-indexDups,], castFormula, drop=FALSE, value.var = "value")
       
       # Need to get value....
       dupInfo <- meltedmergedDF[indexDups, sortingColumns]
@@ -434,7 +438,7 @@ importWaterML1 <- function(obs_url,asDateTime=FALSE, tz=""){
       dataColumns2 <- !(names(mergedDF2) %in% sortingColumns)
       
     } else {
-      mergedDF2 <- dcast(meltedmergedDF, castFormula, drop=FALSE, value.var = "value")
+      mergedDF2 <- reshape2::dcast(meltedmergedDF, castFormula, drop=FALSE, value.var = "value")
       dataColumns2 <- !(names(mergedDF2) %in% sortingColumns)
     }
     

R/readNWISqw.r

@@ -71,7 +71,8 @@
 #' variableInfo \tab data frame \tab A data frame containing information on the requested parameters \cr
 #' }
 #' @export
-#' @import reshape2
+#' @importFrom reshape2 melt
+#' @importFrom reshape2 dcast
 #' @seealso \code{\link{readWQPdata}}, \code{\link{whatWQPsites}}, 
 #' \code{\link{readWQPqw}}, \code{\link{constructNWISURL}}
 #' @examples
@@ -139,18 +140,21 @@ readNWISqw <- function (siteNumbers,parameterCd,startDate="",endDate="",
                          "sample_end_dt","sample_end_tm","sample_start_time_datum_cd","tm_datum_rlbty_cd",
                          "parm_cd","startDateTime","endDateTime","coll_ent_cd", "medium_cd","project_cd",
                          "aqfr_cd","tu_id","body_part_id", "hyd_cond_cd", "samp_type_cd",
-                         "hyd_event_cd","sample_lab_cm_tx")
-      columnsToMelt <- columnsToMelt[columnsToMelt %in% names(data)]
+                         "hyd_event_cd","sample_lab_cm_tx","tz_cd","startDateTime","endDateTime")
+      measureCols <- names(data)[!(names(data) %in% columnsToMelt)]
+      columnsToMelt <- names(data)[(names(data) %in% columnsToMelt)]
       dataWithPcodes <- data[data$parm_cd != "",]
       if(sum(data$parm_cd == "") > 0){
         warning("Some or all data returned without pCodes, those data will not be included in reshape")
       }
-      longDF <- melt(dataWithPcodes, columnsToMelt)
-      wideDF <- dcast(longDF, ... ~ variable + parm_cd )
+      # longDF <- reshape2::melt(dataWithPcodes, measure.vars =  columnsToMelt)
+      longDF <- reshape2::melt(dataWithPcodes, measure.vars =  measureCols,
+                     variable.name = "variable", value.name = "value", na.rm = FALSE)
+      wideDF <- reshape2::dcast(longDF, ... ~ variable + parm_cd )
       wideDF[,grep("_va_",names(wideDF))] <- sapply(wideDF[,grep("_va_",names(wideDF))], function(x) as.numeric(x))
       pCodesReturned <- unique(dataWithPcodes$parm_cd)
       groupByPCode <- as.vector(sapply(pCodesReturned, function(x) grep(x, names(wideDF)) ))
-      data <- wideDF[,c(1:length(columnsToMelt)-1,groupByPCode)]
+      data <- wideDF[,c(1:length(columnsToMelt),groupByPCode)]
       comment(data) <- originalHeader
     } else {
       warning("Reshape can only be used with expanded data. Reshape request will be ignored.")

R/readWQPdata.R

@@ -100,7 +100,7 @@ readWQPdata <- function(...){
   
   matchReturn <- list(...)
 
-  values <- sapply(matchReturn, function(x) URLencode(as.character(paste(eval(x),collapse=";",sep=""))))
+  values <- sapply(matchReturn, function(x) as.character(paste(eval(x),collapse=";",sep="")))
   
   if("bBox" %in% names(values)){
     values['bBox'] <- gsub(pattern = ";", replacement = ",", x = values['bBox'])
@@ -141,19 +141,15 @@ readWQPdata <- function(...){
   } else {
     tz <- ""
   }
-  
-  values <- gsub(",","%2C",values)
-  values <- gsub(";","%3B",values)
+
   values <- gsub("%20","+",values)
-  values <- gsub(":","%3A",values)
   
   urlCall <- paste(paste(names(values),values,sep="="),collapse="&")
   
-  
   baseURL <- "http://www.waterqualitydata.us/Result/search?"
   urlCall <- paste0(baseURL,
                    urlCall,
-                   "&mimeType=tsv")
+                   "&sorted=no&mimeType=tsv")
   
   retval <- importWQP(urlCall,FALSE, tz=tz)
   

R/tabbedDataRetrievals.R

@@ -44,7 +44,7 @@ NULL
 #'
 #'@docType data
 #'@export parameterCdFile 
-#'@keywords datasets
+#'@keywords internal
 #'@examples
 #'head(parameterCdFile[,1:2])
 NULL
@@ -74,7 +74,7 @@ NULL
 #' }
 #' @docType data
 #' @export pCodeToName 
-#' @keywords USGS parameterCd
+#' @keywords internal
 #' @examples
 #' head(pCodeToName[,1:2])
 NULL

R/whatWQPsites.R

@@ -59,7 +59,7 @@ whatWQPsites <- function(...){
 
   matchReturn <- list(...)
   
-  values <- sapply(matchReturn, function(x) URLencode(as.character(paste(eval(x),collapse=";",sep=""))))
+  values <- sapply(matchReturn, function(x) as.character(paste(eval(x),collapse=";",sep="")))
   
   if("tz" %in% names(values)){
     values <- values[!(names(values) %in% "tz")]
@@ -79,11 +79,8 @@ whatWQPsites <- function(...){
     }
     names(values)[names(values) == "stateCd"] <- "statecode"
   }
-  
-  values <- gsub(",","%2C",values)
-  values <- gsub(";","%3B",values)
+
   values <- gsub("%20","+",values)
-  values <- gsub(":","%3A",values)
   
   if("bBox" %in% names(values)){
     values['bBox'] <- gsub(pattern = ";", replacement = ",", x = values['bBox'])
@@ -97,7 +94,7 @@ whatWQPsites <- function(...){
   baseURL <- "http://www.waterqualitydata.us/Station/search?"
   urlCall <- paste(baseURL,
                urlCall,
-               "&mimeType=tsv",sep = "")
+               "&mimeType=tsv&sorted=no",sep = "")
   
   doc <- getWebServiceData(urlCall)
   headerInfo <- attr(doc, "headerInfo")

man/checkWQPdates.Rd

@@ -21,4 +21,5 @@ values <- list(startDateLo="01-01-2002", characteristicName="Phosphorous",
           endDate=as.Date("2014-01-01"))
 values <- checkWQPdates(values)
 }
+\keyword{internal}
 

man/pCodeToName.Rd

@@ -30,6 +30,5 @@ Data pulled from Water Quality Portal on November 25, 2014. The data was pulled
 \examples{
 head(pCodeToName[,1:2])
 }
-\keyword{USGS}
-\keyword{parameterCd}
+\keyword{internal}
 

man/parameterCdFile.Rd

@@ -25,5 +25,5 @@ format=rdb&show=parameter_group_nm&show=parameter_nm&show=casrn&show=srsname&sho
 \examples{
 head(parameterCdFile[,1:2])
 }
-\keyword{datasets}
+\keyword{internal}
 

tests/testthat/tests_general.R

@@ -32,17 +32,17 @@ test_that("General NWIS retrievals working", {
 test_that("General WQP retrievals working", {
   testthat::skip_on_cran()
   # Bring back when WQP is back
-#   nameToUse <- "pH"
-#   pHData <- readWQPdata(siteid="USGS-04024315",characteristicName=nameToUse)
-#   expect_is(pHData$ActivityStartDateTime, 'POSIXct')
-#   
-#   pHDataExpanded2 <- readWQPdata(bBox=c(-90.10,42.67,-88.64,43.35),
-#                                  characteristicName=nameToUse)
-#   expect_is(pHDataExpanded2$ActivityStartDateTime, 'POSIXct')
-#   
-#   startDate <- as.Date("2013-01-01")
-#   nutrientDaneCounty <- readWQPdata(countycode="US:55:025",startDate=startDate,
-#                          characteristicType="Nutrient")
-#   expect_is(nutrientDaneCounty$ActivityStartDateTime, 'POSIXct')
+  nameToUse <- "pH"
+  pHData <- readWQPdata(siteid="USGS-04024315",characteristicName=nameToUse)
+  expect_is(pHData$ActivityStartDateTime, 'POSIXct')
+  
+  pHDataExpanded2 <- readWQPdata(bBox=c(-90.1,42.9,-89.9,43.1),
+                                 characteristicName=nameToUse)
+  expect_is(pHDataExpanded2$ActivityStartDateTime, 'POSIXct')
+  
+  startDate <- as.Date("2013-01-01")
+  nutrientDaneCounty <- readWQPdata(countycode="US:55:025",startDate=startDate,
+                         characteristicType="Nutrient")
+  expect_is(nutrientDaneCounty$ActivityStartDateTime, 'POSIXct')
    expect_that(1==1, is_true())                      
 })

tests/testthat/tests_imports.R

@@ -99,12 +99,12 @@ test_that("External importWaterML1 test", {
   expect_is(unitData$dateTime, 'POSIXct')
   
   
-  # Two sites, two pcodes, one site has two data descriptors:
-  siteNumber <- c('01480015',"04085427")
+  # Two sites, two pcodes, one site has two data descriptors
+  siteNumber <- c('01480015',"04085427") #one site seems to have lost it's 2nd dd
   obs_url <- constructNWISURL(siteNumber,c("00060","00010"),startDate,endDate,'dv')
   data <- importWaterML1(obs_url)
   expect_that(length(unique(data$site_no)) == 2, is_true())
-  expect_that(ncol(data) == 10, is_true()) # 3 data, 3 remark codes, and 4 (agency, site, dateTime, tz)
+  expect_that(ncol(data) == 8, is_true()) # 3 data, 3 remark codes, and 4 (agency, site, dateTime, tz)
 
   inactiveSite <- "05212700"
   inactiveSite <- constructNWISURL(inactiveSite, "00060", "2014-01-01", "2014-01-10",'dv')
@@ -123,15 +123,15 @@ context("importWQP_noCRAN")
 test_that("External WQP tests", {
   testthat::skip_on_cran()
   expect_that(1==1, is_true())   
-#   rawSampleURL <- constructWQPURL('USGS-01594440','01075', '', '')
-#   rawSample <- importWQP(rawSampleURL)
-#   expect_is(rawSample$ActivityStartDateTime, 'POSIXct')
-#   
-#   url2 <- paste0(rawSampleURL,"&zip=yes")
-#   rawSample2 <- suppressWarnings(importWQP(url2, TRUE))
-#   expect_is(rawSample2$ActivityStartDateTime, 'POSIXct')
-#   
-#   STORETex <- constructWQPURL('WIDNR_WQX-10032762','Specific conductance', '', '')
-#   STORETdata <- importWQP(STORETex)
-#   expect_is(STORETdata$ActivityStartDateTime, 'POSIXct')
+  rawSampleURL <- constructWQPURL('USGS-01594440','01075', '', '')
+  rawSample <- importWQP(rawSampleURL)
+  expect_is(rawSample$ActivityStartDateTime, 'POSIXct')
+  
+  url2 <- paste0(rawSampleURL,"&zip=yes")
+  rawSample2 <- suppressWarnings(importWQP(url2, TRUE))
+  expect_is(rawSample2$ActivityStartDateTime, 'POSIXct')
+  
+  STORETex <- constructWQPURL('WIDNR_WQX-10032762','Specific conductance', '', '')
+  STORETdata <- importWQP(STORETex)
+  expect_is(STORETdata$ActivityStartDateTime, 'POSIXct')
 })