Merge pull request #384 from ldecicco-USGS/wqGraph_updates

Bug fixes

Author: ldecicco-USGS

.Rbuildignore

@@ -62,4 +62,5 @@ deploy_simple.R
 cobertura.xml
 test-out.xml
 ^_pkgdown\.yml$
-review/*
+review/*
+docs/*

.gitignore

@@ -7,7 +7,6 @@ Meta/
 Newstuff/
 *.docx
 vignettes/*.html
-vignettes/*.R
 vignettes/EGRET.R
 vignettes/Enhancements.R
 vignettes/TrendsByMonth.R

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: EGRET
 Type: Package
 Title: Exploration and Graphics for RivEr Trends
-Version: 3.0.9
+Version: 3.0.10
 Authors@R: c( person("Robert", "Hirsch", role = c("aut"),
     email = "[email protected]", 
     comment=c(ORCID="0000-0002-4534-075X")),
@@ -58,6 +58,6 @@ Copyright: This software is in the public domain because it contains materials
     the United States Department of Interior. For more information, see the
     official USGS copyright policy at
     https://www.usgs.gov/information-policies-and-instructions/copyrights-and-credits
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.2
 Roxygen: list(old_usage = TRUE)
 Encoding: UTF-8

NAMESPACE

@@ -140,35 +140,12 @@ exportClasses(fluxUnit)
 exportClasses(monthLabel)
 exportClasses(qUnit)
 import(methods)
-importFrom(grDevices,colorRampPalette)
-importFrom(graphics,abline)
 importFrom(graphics,axis)
-importFrom(graphics,box)
-importFrom(graphics,boxplot)
-importFrom(graphics,contour)
-importFrom(graphics,filled.contour)
-importFrom(graphics,grconvertX)
-importFrom(graphics,grconvertY)
-importFrom(graphics,legend)
 importFrom(graphics,lines)
 importFrom(graphics,mtext)
 importFrom(graphics,par)
 importFrom(graphics,plot)
 importFrom(graphics,points)
 importFrom(graphics,segments)
 importFrom(graphics,title)
-importFrom(stats,aggregate)
-importFrom(stats,filter)
-importFrom(stats,lm)
-importFrom(stats,median)
-importFrom(stats,na.omit)
-importFrom(stats,predict)
-importFrom(stats,quantile)
-importFrom(stats,reshape)
-importFrom(stats,rnorm)
-importFrom(stats,sd)
 importFrom(stats,var)
-importFrom(utils,URLencode)
-importFrom(utils,read.delim)
-importFrom(utils,tail)
-importFrom(utils,write.table)

NEWS

@@ -1,3 +1,12 @@
+EGRET 3.0.10
+===========
+* Fix bug with 0 concentration values in readWQPSample.
+* Style updates.
+* Port readNWISSample to Water Quality Portal. NWIS services are retired.
+* Move removing the rows of Sample data with 0 concentration to outside compressData
+* Add columns from raw WQP data to be retained in Sample dataframe.
+
+
 EGRET 3.0.9
 ===========
 * Bug fix for the monthly concentration trend results in runPairs.

R/EGRET.R

@@ -3,7 +3,7 @@
   if (!interactive()) return()
   EGRET_version = utils::packageVersion("EGRET")
   packageStartupMessage("EGRET ", EGRET_version,"
-Extended Documentation: https://rconnect.usgs.gov/EGRET")
+Extended Documentation: https://doi-usgs.github.io/EGRET")
 
 }
 
@@ -26,43 +26,20 @@ Extended Documentation: https://rconnect.usgs.gov/EGRET")
 #'
 #' @name EGRET-package
 #' @docType package
-#' @importFrom utils write.table
-#' @importFrom utils read.delim
-#' @importFrom utils URLencode
-#' @importFrom utils tail
-#' @importFrom stats aggregate
-#' @importFrom stats lm
-#' @importFrom stats median
-#' @importFrom stats sd
-#' @importFrom stats reshape
-#' @importFrom stats filter
-#' @importFrom stats rnorm
-#' @importFrom stats na.omit
 #' 
-#' @importFrom graphics abline
 #' @importFrom graphics axis
-#' @importFrom graphics box
-#' @importFrom graphics boxplot
-#' @importFrom graphics contour
-#' @importFrom graphics filled.contour
-#' @importFrom graphics grconvertX
-#' @importFrom graphics grconvertY
-#' @importFrom graphics legend
 #' @importFrom graphics lines
 #' @importFrom graphics mtext
 #' @importFrom graphics par
 #' @importFrom graphics points
 #' @importFrom graphics segments
 #' @importFrom graphics title
-#' @importFrom stats predict
-#' @importFrom stats quantile
-#' @importFrom grDevices colorRampPalette
 #' @author Robert M. Hirsch \email{rhirsch@@usgs.gov}, Laura De Cicco \email{ldecicco@@usgs.gov}
 #' @references Hirsch, R.M., and De Cicco, L.A., 2014, User guide to Exploration and Graphics for RivEr Trends 
 #' (EGRET) and dataRetrieval: R packages for hydrologic data: U.S. Geological Survey Techniques and Methods book 4, 
 #' chap. A10, 94 p., \doi{10.3133/tm4A10}
-#' @keywords water-quality graphics streamflow statistics 
-NULL
+#' @keywords internal  
+"_PACKAGE"
 
 #' Example eList
 #'
@@ -85,10 +62,10 @@ NULL
 
 #' Constants included with EGRET
 #' 
-#'\itemize{
-#'  \item{fluxConst}{Flux conversion object}
-#'  \item{qConst}{Flow conversion object}
-#'  \item{monthInfo}{Month object}
+#'\tabular{ll}{
+#' fluxConst \tab Flux conversion object\cr
+#' qConst \tab Flow conversion object\cr
+#' monthInfo \tab Month object\cr
 #'}
 #'
 #'@aliases fluxConst qConst monthInfo concConst

R/boxConcMonth.R

@@ -17,7 +17,7 @@
 #' @param tinyPlot logical variable, if TRUE plot is designed to be plotted small as part of a multi-plot figure, default is FALSE.
 #' @param logScale logical if TRUE y plotted in log axis
 #' @param customPar logical defaults to FALSE. If TRUE, par() should be set by user before calling this function 
-#' @param las numeric in {0,1,2,3}; the style of axis labels, see ?par
+#' @param las numeric in c(0,1,2,3); the style of axis labels, see ?par
 #' @param showXLabels logical defaults to TRUE. If FALSE, the x axis label is not plotted
 #' @param showYLabels logical defaults to TRUE. If FALSE, the y axis label is not plotted
 #' @param showXAxis logical defaults to TRUE. If FALSE, the x axis is not plotted
@@ -124,7 +124,7 @@ boxConcMonth <- function(eList, printTitle = TRUE,
                        units = localINFO$param.units)
   yTicksLab <- prettyNum(yInfo$ticks)
 
-  boxplot(tempDF$conc ~ tempDF$month,
+  graphics::boxplot(tempDF$conc ~ tempDF$month,
           ylim = c(yInfo$bottom,yInfo$top),
           yaxs = "i",
           yTicks = yInfo$ticks,

R/boxConcThree.R

@@ -107,7 +107,7 @@ boxConcThree<-function (eList, tinyPlot=FALSE,
   yTicks <- yPretty(yMax)
   yTop <- yTicks[length(yTicks)]
 
-  boxplot(concV ~ index,varwidth=TRUE,
+  graphics::boxplot(concV ~ index,varwidth=TRUE,
           names = groupNames,xlab = "", ylab = yLab,
           ylim = c(0,yTop), axes = FALSE,
           main = plotTitle, font.main = font.main, cex = cex,
@@ -119,7 +119,7 @@ boxConcThree<-function (eList, tinyPlot=FALSE,
   axis(2,tcl=0.5,las=1,at=yTicks,cex.axis=cex.axis)
   axis(3,tcl=0.5,at=c(1,2,3),labels=FALSE)
   axis(4,tcl=0.5,at=yTicks,labels=FALSE)
-  box()
+  graphics::box()
   if (!tinyPlot) mtext(title2,side=3,line=-1.5)
   invisible(eList)
 }

R/boxQTwice.R

@@ -27,7 +27,7 @@
 #' @param logScale logical if TRUE y plotted in log axis. Defaults to TRUE.
 #' @param tinyPlot logical variable, if TRUE plot is designed to be plotted small as part of a multi-plot figure, default is FALSE.
 #' @param customPar logical defaults to FALSE. If TRUE, par() should be set by user before calling this function 
-#' @param las numeric in {0,1,2,3}; the style of axis labels, see ?par
+#' @param las numeric in c(0,1,2,3); the style of axis labels, see ?par
 #' @param usgsStyle logical option to use USGS style guidelines. Setting this option
 #' to TRUE does NOT guarantee USGS compliance. It will only change automatically
 #' generated labels. 
@@ -111,7 +111,7 @@ boxQTwice<-function(eList,
     logScaleText <- ""
   }
 
-  boxplot(bigQ~index,varwidth=TRUE,
+  graphics::boxplot(bigQ~index,varwidth=TRUE,
           names=groupNames,xlab="",
           ylim=c(yInfo$bottom,yInfo$top),
           main=plotTitle,cex=cex,ylab=yLabel,

R/boxResidMonth.R

@@ -21,7 +21,7 @@
 #' @param cex.main magnification to be used for main titles relative to the current setting of cex
 #' @param font.main font to be used for plot main titles
 #' @param customPar logical defaults to FALSE. If TRUE, par() should be set by user before calling this function 
-#' @param las numeric in {0,1,2,3}; the style of axis labels
+#' @param las numeric in c(0,1,2,3); the style of axis labels
 #' @param randomCensored logical. Show censored residuals as randomized. Default = FALSE.
 #' @param monthLab object of monthLabel class, or numeric represented the short code, 
 #' or character representing the descriptive name.
@@ -104,7 +104,7 @@ boxResidMonth <- function(eList,
   monthList <- singleMonthList[localSample$Month]
   monthList <- factor(monthList, namesListFactor)
 
-  boxplot(resid ~ monthList,
+  graphics::boxplot(resid ~ monthList,
           varwidth = TRUE,
           xlab = "Month", ylab = yLab,
           main = plotTitle,
@@ -114,7 +114,7 @@ boxResidMonth <- function(eList,
           cex.axis = cex.axis,
           las = las,
           ...)
-  abline(h = 0)  
+  graphics::abline(h = 0)  
   if (!tinyPlot) mtext(title2, side = 3, line = -1.5)
   invisible(eList)
 }

R/calculateMonthlyResults.R

@@ -16,22 +16,22 @@ calculateMonthlyResults <- function(eList){
 
   localDaily <- getDaily(eList)
 
-  nDays <- aggregate(localDaily$ConcDay, by=list(localDaily$MonthSeq), function(x) sum(!is.na(x)))$x
+  nDays <- stats::aggregate(localDaily$ConcDay, by=list(localDaily$MonthSeq), function(x) sum(!is.na(x)))$x
 
-  Q <- aggregate(localDaily$Q, by=list(localDaily$MonthSeq), mean)$x
-  DecYear <- aggregate(localDaily$DecYear, by=list(localDaily$MonthSeq), mean)$x
+  Q <- stats::aggregate(localDaily$Q, by=list(localDaily$MonthSeq), mean)$x
+  DecYear <- stats::aggregate(localDaily$DecYear, by=list(localDaily$MonthSeq), mean)$x
   Year <- trunc(DecYear)
-  Month <- aggregate(localDaily$Month, by=list(localDaily$MonthSeq), mean)$x
-  Conc <- aggregate(localDaily$ConcDay, by=list(localDaily$MonthSeq), mean)$x
-  Flux <- aggregate(localDaily$FluxDay, by=list(localDaily$MonthSeq), mean)$x
-  FNConc <- aggregate(localDaily$FNConc, by=list(localDaily$MonthSeq), mean)$x
-  FNFlux <- aggregate(localDaily$FNFlux, by=list(localDaily$MonthSeq), mean)$x
+  Month <- stats::aggregate(localDaily$Month, by=list(localDaily$MonthSeq), mean)$x
+  Conc <- stats::aggregate(localDaily$ConcDay, by=list(localDaily$MonthSeq), mean)$x
+  Flux <- stats::aggregate(localDaily$FluxDay, by=list(localDaily$MonthSeq), mean)$x
+  FNConc <- stats::aggregate(localDaily$FNConc, by=list(localDaily$MonthSeq), mean)$x
+  FNFlux <- stats::aggregate(localDaily$FNFlux, by=list(localDaily$MonthSeq), mean)$x
 
   kalman <- all(c("GenConc","GenFlux") %in% names(localDaily))
 
   if(kalman){
-    GenConc <- aggregate(localDaily$GenConc, by=list(localDaily$MonthSeq), mean)$x
-    GenFlux <- aggregate(localDaily$GenFlux, by=list(localDaily$MonthSeq), mean)$x
+    GenConc <- stats::aggregate(localDaily$GenConc, by=list(localDaily$MonthSeq), mean)$x
+    GenFlux <- stats::aggregate(localDaily$GenFlux, by=list(localDaily$MonthSeq), mean)$x
 
     MonthlyResults <- data.frame(Month, Year, nDays,
                                  DecYear, Q,

R/compressData.r

@@ -51,24 +51,28 @@ compressData <- function(data, verbose = TRUE){
     i <- i + 1
   }
 
-  names(data) <- c('dateTime', 'code', 'value')
-  returnDataFrame <- as.data.frame(matrix(ncol=3,nrow=nrow(data)))
-  names(returnDataFrame) <- c('dateTime', 'ConcLow', 'ConcHigh')
+  names(data)[1:3] <- c('dateTime', 'code', 'value')
 
   data$dateTime <- as.character(data$dateTime)
   if(dateFormatCheck(data$dateTime)){
-    returnDataFrame$dateTime <- as.Date(data$dateTime)  
+    data$dateTime <- as.Date(data$dateTime)  
   } else {
     data$dateTime <- as.Date(data$dateTime,format="%m/%d/%Y")
-    returnDataFrame$dateTime <- as.Date(data$dateTime,format="%m/%d/%Y")
   }
-  returnDataFrame$ConcLow <- as.numeric(lowConcentration)
-  returnDataFrame$ConcHigh <- as.numeric(highConcentration)
-  Uncen1<-ifelse(returnDataFrame$ConcLow==returnDataFrame$ConcHigh,1,0)
-  returnDataFrame$Uncen<-ifelse(is.na(returnDataFrame$ConcLow)|is.na(returnDataFrame$ConcHigh),0,Uncen1)
+
+  
+  data$ConcLow <- as.numeric(lowConcentration)
+  data$ConcHigh <- as.numeric(highConcentration)
+  Uncen1<-ifelse(data$ConcLow==data$ConcHigh,1,0)
+  data$Uncen<-ifelse(is.na(data$ConcLow)|is.na(data$ConcHigh),0,Uncen1)
 
-  flaggedData1 <- returnDataFrame[(returnDataFrame$ConcLow == 0 & returnDataFrame$ConcHigh == 0),]
-  returnDataFrame <- returnDataFrame[!(returnDataFrame$ConcLow == 0 & returnDataFrame$ConcHigh == 0),]
+  return(data)
+}
+
+
+remove_zeros <- function(data, verbose){
+  flaggedData1 <- data[(data$ConcLow == 0 & data$ConcHigh == 0),]
+  data <- data[!(data$ConcLow == 0 & data$ConcHigh == 0),]
 
   if (nrow(flaggedData1) > 0){
     WarningMessage <- paste("Deleted", nrow(flaggedData1), "rows of data because concentration was reported as 0.0, the program is unable to interpret that result and is therefore deleting it.")    
@@ -78,6 +82,5 @@ compressData <- function(data, verbose = TRUE){
       print(flaggedData1)
     }
   }
-
-  return(returnDataFrame)
+  return(data)
 }

R/cumQdate.R

@@ -27,7 +27,7 @@
 #' annualFlow <- cumQdate(eList)
 #' head(annualFlow)
 #' plot(annualFlow)
-#' mod1 <- lm(annualFlow[,2] ~ annualFlow[,1])
+#' mod1 <- stats::lm(annualFlow[,2] ~ annualFlow[,1])
 #' summary(mod1)
 cumQdate <- function(eList, 
                      paStart = 10, paLong = 12, 
@@ -65,6 +65,6 @@ cumQdate <- function(eList,
     }  
   }
 
-  annualSeries <- na.omit(annualSeries)
+  annualSeries <- stats::na.omit(annualSeries)
   return(annualSeries)
 }

R/errorStats.R

@@ -22,7 +22,7 @@ errorStats <- function(eList) {
 
   eListR <- makeAugmentedSample(eList)
   Sample <- eListR$Sample
-  # n <- length(Sample$Date)
+
   Sample$Pred <- log(Sample$rObserved) - Sample$rResid
   Sample$trueFlux <- Sample$rObserved * Sample$Q * 86.4
   Sample$trueLogF <- log(Sample$trueFlux)

R/estSurfaces.R

@@ -92,7 +92,7 @@ estSurfaces<-function(eList, surfaceStart=NA, surfaceEnd=NA, localSample=NA,
 
     sliceIndex <- which(vectorYear >= decimalDate(as.Date(surfaceStart)) & vectorYear <= 
                           decimalDate(as.Date(surfaceEnd)))
-    Year <- vectorYear[c(sliceIndex[1]-1, sliceIndex, tail(sliceIndex, n = 1)+1)]
+    Year <- vectorYear[c(sliceIndex[1]-1, sliceIndex, utils::tail(sliceIndex, n = 1)+1)]
 
     nVectorYear <- length(Year)
     estPtYear <- rep(Year,each=14)

R/genericEGRETplot.R

@@ -84,9 +84,9 @@ genericEGRETDotPlot <- function(x,y, xlim, ylim,
        ylim=ylim,yaxs=yaxs,ylab=if(showYLabels) ylab else "", main=plotTitle,col=col,lwd=lwd,
        pch=pch,cex=cex,cex.main=cex.main,font.main=font.main,cex.lab=cex.lab,...)
 
-  box()
-  if (hLine) abline(h = 0)
-  if (oneToOneLine) abline(a=0,b=1)
+  graphics::box()
+  if (hLine) graphics::abline(h = 0)
+  if (oneToOneLine) graphics::abline(a=0,b=1)
 
   if(rmSciX){
     xTicksLab <- prettyNum(xTicks)

R/kalman_functions.R

@@ -106,7 +106,7 @@ WRTDSKalman <- function(eList, rho = 0.90, niter = 200,
       endFill <- zends[iGap]+1
       nFill <- zz$length[iGap]+2
       if(i == 1 | i == numGap) {
-        z <- rnorm(nFill - 2)
+        z <- stats::rnorm(nFill - 2)
         xfill <- c(xxP[startFill], z, xxP[endFill])
       } else {
         xfill <- genmissing(xxP[startFill], xxP[endFill], rho, nFill)
@@ -385,7 +385,7 @@ plotWRTDSKalman <- function(eList, sideBySide = FALSE,
                       ylab = ylab, 
                       cex.main = 0.9, 
                       plotTitle = title2)
-  abline(a = 0, b = 1)
+  graphics::abline(a = 0, b = 1)
 
   if(sideBySide){
     mtext(mainTitle, line = -1, side = 3, outer = TRUE, cex= 1)