Merge pull request #131 from ldecicco-USGS/master

More tests + fn
DOI-USGS · Aug 3, 2017 · e939352 · e939352
2 parents fc2d98b + ca2c759
commit e939352
Show file tree

Hide file tree

Showing 18 changed files with 262 additions and 42 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -41,6 +41,7 @@ Suggests:
     parallel
 LazyLoad: yes
 LazyData: yes
+BugReports: https://github.com/USGS-R/EGRET/issues
 VignetteBuilder: knitr
 BuildVignettes: true
 URL: https://pubs.usgs.gov/tm/04/a10/, https://github.com/USGS-R/EGRET/wiki

diff --git a/R/flexFNnew.R b/R/flexFNnew.R
@@ -49,7 +49,6 @@ flexFN <- function(eList, dateInfo, waterYear = TRUE,sampleStart="sampleSegStart
     Sample$WaterYear <- floor(Sample$DecYear)
     Daily$WaterYear <- floor(Daily$DecYear)
   }
-
 
   dateInfo$sampleSegEnd <- c(dateInfo[2:nrow(dateInfo),sampleStart]-1,max(Sample$WaterYear))
 
@@ -63,7 +62,6 @@ flexFN <- function(eList, dateInfo, waterYear = TRUE,sampleStart="sampleSegStart
     DailyFN$WaterYear <- floor(DailyFN$DecYear)
   }
 
-
   newList <- as.egret(eList$INFO,DailyFN,Sample,eList$surfaces)
 
   for(i in seq(nrow(dateInfo))){
@@ -105,24 +103,12 @@ flexFN <- function(eList, dateInfo, waterYear = TRUE,sampleStart="sampleSegStart
 #' 
 #' flowNormYears <- c(1985:2002,2006:2010)
 #' temp_daily <- subFN(eList, flowNormYears)
+#' plotFluxHist(eList, flowNormYears =  c(1985:2002,2006:2010))
 subFN <- function(eList, flowNormYears = "all", 
                   waterYear = TRUE){
 
   if(any(tolower(flowNormYears) != "all")){
-    sampleSegStart <- min(floor(eList$Sample$DecYear), na.rm = TRUE)
-    total_por <- FALSE
-    flowNormYears <- flowNormYears[!is.na(flowNormYears)]
-    split_years <- split(flowNormYears, cumsum(c(1, diff(flowNormYears) != 1)))
-
-    flowSegStart <- as.numeric(sapply(split_years, min))
-    flowSegEnd <- as.numeric(sapply(split_years, max))
-
-    dateInfo <- data.frame(sampleSegStart,
-                           flowSegStart,
-                           flowSegEnd)
-
-    eList <- flexFN(eList, dateInfo, waterYear = FALSE)
-    Daily <- getDaily(eList)
+    Daily <- estFNyears(eList = eList, years = flowNormYears, waterYear = waterYear)
   } else {
     Daily <- estDailyFromSurfaces(eList = eList)
   }
@@ -146,14 +132,7 @@ estFNsegs <- function(eList, dateInfo){
   # "target" x-y points.
   LogQ <- seq(localINFO$bottomLogQ, by=localINFO$stepLogQ, length.out=localINFO$nVectorLogQ)
   Year <- seq(localINFO$bottomYear, by=localINFO$stepYear, length.out=localINFO$nVectorYear)
-  # localDaily$yHat <- interp.surface(obj=list(x=LogQ,y=Year,z=localsurfaces[,,1]), 
-  #                                   loc=data.frame(localDaily$LogQ, localDaily$DecYear))
-  # localDaily$SE <- interp.surface(obj=list(x=LogQ,y=Year,z=localsurfaces[,,2]), 
-  #                                 loc=data.frame(localDaily$LogQ, localDaily$DecYear))
-  # localDaily$ConcDay <- interp.surface(obj=list(x=LogQ,y=Year,z=localsurfaces[,,3]), 
-  #                                      loc=data.frame(localDaily$LogQ, localDaily$DecYear))
-  # localDaily$FluxDay <- as.numeric(localDaily$ConcDay * localDaily$Q * 86.4)
-
+
   # Calculate "flow-normalized" concentration and flux:
   sampleIndex <- localDaily$WaterYear >= dateInfo$sampleSegStart & localDaily$WaterYear <= dateInfo$sampleSegEnd
   flowIndex <- localDaily$WaterYear >= dateInfo$flowSegStart & localDaily$WaterYear <= dateInfo$flowSegEnd
@@ -188,4 +167,62 @@ estFNsegs <- function(eList, dateInfo){
 
 }
 
+#' Estimates for flow normalization by year
+#' 
+#' @param eList named list with at least the Daily, Sample, and INFO dataframes
+#' @param years vector of years
+#' @param waterYear logical. Should years be water years (\code{TRUE}) or calendar years (\code{FALSE})
+#' @importFrom fields interp.surface
+#' @importFrom dataRetrieval calcWaterYear
+estFNyears <- function(eList, years, waterYear = TRUE){
+
+  localDaily <- getDaily(eList)
+  localINFO <- getInfo(eList)
+  localsurfaces <- getSurfaces(eList)
+
+  if(waterYear){
+    localDaily$WaterYear <- calcWaterYear(localDaily$Date)
+  } else {
+    localDaily$WaterYear <- floor(localDaily$DecYear)
+  }
+
+  # First argument in calls below is the "known" x-y-z surface, second argument is matrix of 
+  # "target" x-y points.
+  LogQ <- seq(localINFO$bottomLogQ, by=localINFO$stepLogQ, length.out=localINFO$nVectorLogQ)
+  Year <- seq(localINFO$bottomYear, by=localINFO$stepYear, length.out=localINFO$nVectorYear)
+
+  # Calculate "flow-normalized" concentration and flux:
+
+  flowIndex <- which(localDaily$WaterYear %in% years)
+
+  # First, bin the LogQ values by day-of-year.
+  allLogQsByDayOfYear <- split(localDaily$LogQ[flowIndex], localDaily$Day[flowIndex])
+
+  allLogQsByDayOfYear[['59']] <- c(unlist(allLogQsByDayOfYear['59']),   # Bob's convention
+                                   unlist(allLogQsByDayOfYear['60']))
+  allLogQsByDayOfYear['60'] <- allLogQsByDayOfYear['59']
+
+  # Using the above data structure as a "look-up" table, list all LogQ values that occured on every
+  # day of the entire daily record. When "unlisted" into a vector, these will become the "x" values 
+  # for the interpolation.
+  allLogQsReplicated <- allLogQsByDayOfYear[localDaily$Day]
+
+  # Replicate the decimal year field for each day of the record to correspond to all the LogQ 
+  # values listed for that day. These are the "y" values for the interpolation.
+  allDatesReplicated <- rep(localDaily$DecYear, lapply(allLogQsReplicated, length))
+
+  # Interpolate.
+  allConcReplicated <- interp.surface( obj=list(x=LogQ,y=Year,z=localsurfaces[,,3]), 
+                                       loc=data.frame(unlist(x=allLogQsReplicated),
+                                                      y=allDatesReplicated))
+  allFluxReplicated <- allConcReplicated * exp(unlist(allLogQsReplicated)) * 86.4
+
+  # Finally bin the collective results by days (the decimal year), and calculate the desired means.
+  localDaily$FNConc <-  as.numeric(tapply(allConcReplicated, allDatesReplicated, "mean"))
+  localDaily$FNFlux <-  as.numeric(tapply(allFluxReplicated, allDatesReplicated, "mean"))
+
+  return(localDaily)
+
+}
+
 
diff --git a/R/plotConcHist.R b/R/plotConcHist.R
@@ -36,14 +36,16 @@
 #' yearStart <- 2001
 #' yearEnd <- 2010
 #' eList <- Choptank_eList
+#' 
 #' # Water year:
 #' plotConcHist(eList, yearStart, yearEnd)
 #' # Graphs consisting of Jun-Aug
 #' eList <- setPA(eList, paStart=6,paLong=3)
 #' plotConcHist(eList)
-#' 
+#' \dontrun{
 #' flowNormYears <- c(1985:2002,2006:2010)
 #' plotConcHist(eList, flowNormYears=flowNormYears)
+#' }
 plotConcHist<-function(eList, yearStart = NA, yearEnd = NA, 
                        flowNormYears = "all", waterYear = TRUE,
                        concMax = NA, printTitle = TRUE, 

diff --git a/R/plotFluxHist.R b/R/plotFluxHist.R
@@ -37,15 +37,18 @@
 #' yearEnd <- 2010
 #' eList <- Choptank_eList
 #' # Water year:
+#' \dontrun{
 #' plotFluxHist(eList)
 #' plotFluxHist(eList, yearStart, yearEnd, fluxUnit = 1)
 #' plotFluxHist(eList, yearStart, yearEnd, fluxUnit = 'kgDay')
 #' # Graphs consisting of Jun-Aug
 #' eList <- setPA(eList, paStart=6,paLong=3)
 #' plotFluxHist(eList) 
+#' 
 #' # Flow normalized (excluding extremes from 2003-04):
 #' yearVector <- c(1980:2002, 2005:2015)
 #' plotFluxHist(eList, flowNormYears=yearVector)
+#' }
 plotFluxHist<-function(eList, yearStart = NA, yearEnd = NA, flowNormYears = "all", 
     waterYear = TRUE, fluxUnit = 9, fluxMax = NA, printTitle = TRUE, 
     plotFlowNorm = TRUE, tinyPlot=FALSE, col="black", col.pred="green",

diff --git a/R/tableChange.R b/R/tableChange.R
@@ -15,12 +15,14 @@
 #' @examples
 #' eList <- Choptank_eList
 #' # Water Year:
+#' \dontrun{
 #' tableChange(eList, fluxUnit=6, yearPoints=c(2001,2005,2008,2009))
 #' tableChange(eList, fluxUnit=9) 
 #' tableChange(eList, fluxUnit=9, flowNormYear=c(2001:2006, 2008:2009)) 
 #' # Winter:
 #' eList <- setPA(eList, paStart=12,paLong=3)
 #' tableChange(eList, fluxUnit=6,yearPoints=c(2001,2005,2008,2009))
+#' }
 tableChange<-function(eList, fluxUnit = 9, yearPoints = NA, 
                       flowNormYears = "all", waterYear = TRUE) {
 

diff --git a/R/tableChangeSingle.R b/R/tableChangeSingle.R
@@ -17,16 +17,19 @@
 #' @return dataframe with Year1, Year2, change[mg/L], slope[mg/L], change[percent], slope[percent] columns. The data in each row is the change or slope calculated from Year1 to Year2
 #' @examples
 #' eList <- Choptank_eList
+#' \dontrun{
 #' # Water Year:
 #' #This returns concentration ASCII table in the console:
 #' tableChangeSingle(eList, fluxUnit=6,yearPoints=c(2001,2005,2008,2009), flux=FALSE)
-#' tableChangeSingle(eList, fluxUnit=6,yearPoints=c(2001,2005,2008,2009), 
+#' #Returns a data frame:
+#' change <- tableChangeSingle(eList, fluxUnit=6,yearPoints=c(2001,2005,2008,2009), 
 #'                   flowNormYears=c(2003:2004, 2006:2009), flux=FALSE)
 #' #This returns flux values ASCII table in the console
-#' tableChangeSingle(eList, fluxUnit=6,yearPoints=c(2001,2005,2008,2009), flux=TRUE)  
+#' df <- tableChangeSingle(eList, fluxUnit=6,yearPoints=c(2001,2005,2008,2009), flux=TRUE)  
 #' # Winter:
 #' eList <- setPA(eList, paStart=12,paLong=3)
 #' tableChangeSingle(eList, fluxUnit=6,yearPoints=c(2001,2005,2008,2009), flux=FALSE)
+#' }
 tableChangeSingle<-function(eList, fluxUnit = 9, yearPoints = NA, flux = FALSE,
                             flowNormYears = "all", waterYear = TRUE) {
 

diff --git a/R/tableResults.R b/R/tableResults.R
@@ -15,13 +15,15 @@
 #' @examples
 #' eList <- Choptank_eList
 #' # Water Year:
+#' \dontrun{
 #' tableResults(eList, fluxUnit = 1)
 #' tableResults(eList, fluxUnit = 1, flowNormYears = c(1980:1995, 1997:2002, 2004:2011))
 #' tableResults(eList, fluxUnit = 'kgDay', qUnit = 'cms')
 #' returnedTable <- tableResults(eList, fluxUnit = 1)
 #' # Winter:
 #' eList <- setPA(eList, paLong=3,paStart=12)
 #' tableResults(eList, fluxUnit = 1)
+#' }
 tableResults<-function(eList, qUnit = 2, fluxUnit = 9, flowNormYears = "all", 
                        waterYear = TRUE) {
 

diff --git a/README.Rmd b/README.Rmd
@@ -25,6 +25,13 @@ The link for the official USGS publication user guide is here:
 |----------|------------|------------|------------|
 | [![travis](https://travis-ci.org/USGS-R/EGRET.svg?branch=master)](https://travis-ci.org/USGS-R/EGRET)|[![Build status](https://ci.appveyor.com/api/projects/status/a2kogyfplo3valdg?svg=true)](https://ci.appveyor.com/project/ldecicco-USGS/EGRET)| [![Coverage Status](https://coveralls.io/repos/github/USGS-R/EGRET/badge.svg?branch=master)](https://coveralls.io/github/USGS-R/EGRET?branch=master)|[![status](https://img.shields.io/badge/USGS-Research-blue.svg)](https://owi.usgs.gov/R/packages.html#research)|
 
+### Current CRAN information:
+
+|Version|Monthly Downloads|Total Downloads|
+|----------|------------|------------|
+|[![CRAN version](http://www.r-pkg.org/badges/version/EGRET)](https://cran.r-project.org/package=EGRET)|[![](http://cranlogs.r-pkg.org/badges/EGRET)](https://cran.r-project.org/package=EGRET)|[![](http://cranlogs.r-pkg.org/badges/grand-total/EGRET)](https://cran.r-project.org/package=EGRET)|
+
+
 ### Reporting bugs
 
 Please consider reporting bugs and asking questions on the Issues page:
@@ -45,12 +52,15 @@ Additionally, to subscribe to an email list concerning updates to these R packag
 
 We want to encourage a warm, welcoming, and safe environment for contributing to this project. See the [code of conduct](https://github.com/USGS-R/EGRET/blob/master/CONDUCT.md) for more information.
 
+### Package Support
 
-### Current CRAN information:
+The Water Mission Area of the USGS has supported the development and maintenance of the `EGRET` R-package. Further maintenance is expected to be stable through September 2018. Resources are available primarily for maintenance and responding to user questions. Priorities on the development of new features are determined by the `EGRET` development team.
 
-|Version|Monthly Downloads|Total Downloads|
-|----------|------------|------------|
-|[![CRAN version](http://www.r-pkg.org/badges/version/EGRET)](https://cran.r-project.org/package=EGRET)|[![](http://cranlogs.r-pkg.org/badges/EGRET)](https://cran.r-project.org/package=EGRET)|[![](http://cranlogs.r-pkg.org/badges/grand-total/EGRET)](https://cran.r-project.org/package=EGRET)|
+![USGS](http://usgs-r.github.io/images/usgs.png)
+
+### Sunset date 
+
+Funding for `EGRET` currently expires summer 2018. Expectations are that maintenance and customer service will continue to be supported past that date.
 
 ### Research software impact:
 
@@ -103,7 +113,7 @@ Note: As of February 5, 2015 a new version of the user guide has been posted at
 ```{r eval=FALSE}
 library(EGRET)
 Daily <- readNWISDaily("06934500","00060","1979-10-01","2010-09-30")
-Sample <-readNWISSample("06934500","00631","1970-10-01","2011-09-30")
+Sample <-readNWISSample("06934500","00631","1979-10-01","2010-09-30")
 INFO <-readNWISInfo("06934500","00631", interactive=FALSE)
 
 eList <-mergeReport(INFO, Daily, Sample)

diff --git a/README.md b/README.md
@@ -16,6 +16,12 @@ Package Status
 |-------------------------------------------------------------------------------------------------------|-----------------------------------------------------------------------------------------------------------------------------------------------|------------------------------------------------------------------------------------------------------------------------------------------------------|-----------------------------------------------------------------------------------------------------------------|
 | [![travis](https://travis-ci.org/USGS-R/EGRET.svg?branch=master)](https://travis-ci.org/USGS-R/EGRET) | [![Build status](https://ci.appveyor.com/api/projects/status/a2kogyfplo3valdg?svg=true)](https://ci.appveyor.com/project/ldecicco-USGS/EGRET) | [![Coverage Status](https://coveralls.io/repos/github/USGS-R/EGRET/badge.svg?branch=master)](https://coveralls.io/github/USGS-R/EGRET?branch=master) | [![status](https://img.shields.io/badge/USGS-Research-blue.svg)](https://owi.usgs.gov/R/packages.html#research) |
 
+### Current CRAN information:
+
+| Version                                                                                                | Monthly Downloads                                                                       | Total Downloads                                                                                     |
+|--------------------------------------------------------------------------------------------------------|-----------------------------------------------------------------------------------------|-----------------------------------------------------------------------------------------------------|
+| [![CRAN version](http://www.r-pkg.org/badges/version/EGRET)](https://cran.r-project.org/package=EGRET) | [![](http://cranlogs.r-pkg.org/badges/EGRET)](https://cran.r-project.org/package=EGRET) | [![](http://cranlogs.r-pkg.org/badges/grand-total/EGRET)](https://cran.r-project.org/package=EGRET) |
+
 ### Reporting bugs
 
 Please consider reporting bugs and asking questions on the Issues page: <https://github.com/USGS-R/EGRET/issues>
@@ -34,11 +40,15 @@ Additionally, to subscribe to an email list concerning updates to these R packag
 
 We want to encourage a warm, welcoming, and safe environment for contributing to this project. See the [code of conduct](https://github.com/USGS-R/EGRET/blob/master/CONDUCT.md) for more information.
 
-### Current CRAN information:
+### Package Support
 
-| Version                                                                                                | Monthly Downloads                                                                       | Total Downloads                                                                                     |
-|--------------------------------------------------------------------------------------------------------|-----------------------------------------------------------------------------------------|-----------------------------------------------------------------------------------------------------|
-| [![CRAN version](http://www.r-pkg.org/badges/version/EGRET)](https://cran.r-project.org/package=EGRET) | [![](http://cranlogs.r-pkg.org/badges/EGRET)](https://cran.r-project.org/package=EGRET) | [![](http://cranlogs.r-pkg.org/badges/grand-total/EGRET)](https://cran.r-project.org/package=EGRET) |
+The Water Mission Area of the USGS has supported the development and maintenance of the `EGRET` R-package. Further maintenance is expected to be stable through September 2018. Resources are available primarily for maintenance and responding to user questions. Priorities on the development of new features are determined by the `EGRET` development team.
+
+![USGS](http://usgs-r.github.io/images/usgs.png)
+
+### Sunset date
+
+Funding for `EGRET` currently expires summer 2018. Expectations are that maintenance and customer service will continue to be supported past that date.
 
 ### Research software impact:
 
@@ -96,7 +106,7 @@ Sample Workflow
 ``` r
 library(EGRET)
 Daily <- readNWISDaily("06934500","00060","1979-10-01","2010-09-30")
-Sample <-readNWISSample("06934500","00631","1970-10-01","2011-09-30")
+Sample <-readNWISSample("06934500","00631","1979-10-01","2010-09-30")
 INFO <-readNWISInfo("06934500","00631", interactive=FALSE)
 
 eList <-mergeReport(INFO, Daily, Sample)
@@ -349,7 +359,7 @@ endDate <- "" # Get latest date
 Daily <- readNWISDaily(siteID,"00060",startDate,endDate)
 ```
 
-    ## There are 25410 data points, and 25410 days.
+    ## There are 25416 data points, and 25416 days.
 
 ``` r
 # Gather site and parameter information:

diff --git a/man/estFNyears.Rd b/man/estFNyears.Rd
diff --git a/man/plotConcHist.Rd b/man/plotConcHist.Rd
diff --git a/man/plotFluxHist.Rd b/man/plotFluxHist.Rd
diff --git a/man/subFN.Rd b/man/subFN.Rd
diff --git a/man/tableChange.Rd b/man/tableChange.Rd