diff --git a/DESCRIPTION b/DESCRIPTION index 304a3273..23d82406 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ 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"), diff --git a/NAMESPACE b/NAMESPACE index 8e891425..4a0b9c2f 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/checkWQPdates.r b/R/checkWQPdates.r index 637783ab..5453865d 100644 --- a/R/checkWQPdates.r +++ b/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")) diff --git a/R/constructNWISURL.r b/R/constructNWISURL.r index d8ce58a9..c5326c8d 100644 --- a/R/constructNWISURL.r +++ b/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) } diff --git a/R/importWQP.R b/R/importWQP.R index fa1b8c64..4ccf266a 100644 --- a/R/importWQP.R +++ b/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 { diff --git a/R/importWaterML1.r b/R/importWaterML1.r index a67b988c..0931e4dc 100644 --- a/R/importWaterML1.r +++ b/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) } diff --git a/R/readNWISqw.r b/R/readNWISqw.r index 5c59d4b7..b41bd7fa 100644 --- a/R/readNWISqw.r +++ b/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.") diff --git a/R/readWQPdata.R b/R/readWQPdata.R index 51b2525b..ba93904b 100644 --- a/R/readWQPdata.R +++ b/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) diff --git a/R/tabbedDataRetrievals.R b/R/tabbedDataRetrievals.R index 03c896bb..4a5103dc 100644 --- a/R/tabbedDataRetrievals.R +++ b/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 diff --git a/R/whatWQPsites.R b/R/whatWQPsites.R index e7533219..7c7fbd07 100644 --- a/R/whatWQPsites.R +++ b/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") diff --git a/man/checkWQPdates.Rd b/man/checkWQPdates.Rd index eb7c847c..0266e260 100644 --- a/man/checkWQPdates.Rd +++ b/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} diff --git a/man/pCodeToName.Rd b/man/pCodeToName.Rd index c4e1fd2d..440d7b8f 100644 --- a/man/pCodeToName.Rd +++ b/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} diff --git a/man/parameterCdFile.Rd b/man/parameterCdFile.Rd index 29be9129..bf5f3fe1 100644 --- a/man/parameterCdFile.Rd +++ b/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} diff --git a/tests/testthat/tests_general.R b/tests/testthat/tests_general.R index 21871738..ebde09c4 100644 --- a/tests/testthat/tests_general.R +++ b/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()) }) diff --git a/tests/testthat/tests_imports.R b/tests/testthat/tests_imports.R index 11bb421b..5f5052c7 100644 --- a/tests/testthat/tests_imports.R +++ b/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') }) diff --git a/vignettes/figure/getNWIStemperaturePlot-1.pdf b/vignettes/figure/getNWIStemperaturePlot-1.pdf index f13c842b..4615091c 100644 Binary files a/vignettes/figure/getNWIStemperaturePlot-1.pdf and b/vignettes/figure/getNWIStemperaturePlot-1.pdf differ