diff --git a/DESCRIPTION b/DESCRIPTION index 71e1b223..26c1c4c9 100644 --- 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 index 3b01e471..d2b1ccbc 100644 --- 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 index 153682a0..babf6d79 100644 --- 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 index a1476cc6..a9af3144 100644 --- 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 index 6f88db45..ae0c444c 100644 --- 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 index b8acd65a..a81e4eac 100644 --- 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 index 51fdb4b5..cbfbc8c7 100644 --- a/R/tableResults.R +++ b/R/tableResults.R @@ -15,6 +15,7 @@ #' @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') @@ -22,6 +23,7 @@ #' # 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 index eb92b85a..cd60657e 100644 --- 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 index 47d19487..8646d6d0 100644 --- 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: @@ -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 new file mode 100644 index 00000000..001b82ee --- /dev/null +++ b/man/estFNyears.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/flexFNnew.R +\name{estFNyears} +\alias{estFNyears} +\title{Estimates for flow normalization by year} +\usage{ +estFNyears(eList, years, waterYear = TRUE) +} +\arguments{ +\item{eList}{named list with at least the Daily, Sample, and INFO dataframes} + +\item{years}{vector of years} + +\item{waterYear}{logical. Should years be water years (\code{TRUE}) or calendar years (\code{FALSE})} +} +\description{ +Estimates for flow normalization by year +} diff --git a/man/plotConcHist.Rd b/man/plotConcHist.Rd index cba2ee02..de838701 100644 --- a/man/plotConcHist.Rd +++ b/man/plotConcHist.Rd @@ -60,15 +60,17 @@ Although there are a lot of optional arguments to this function, most are set to 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) } +} \seealso{ \code{\link{setupYears}}, \code{\link{genericEGRETDotPlot}} } diff --git a/man/plotFluxHist.Rd b/man/plotFluxHist.Rd index 0c54d427..54b41cd0 100644 --- a/man/plotFluxHist.Rd +++ b/man/plotFluxHist.Rd @@ -69,10 +69,12 @@ plotFluxHist(eList, yearStart, yearEnd, fluxUnit = 'kgDay') # Graphs consisting of Jun-Aug eList <- setPA(eList, paStart=6,paLong=3) plotFluxHist(eList) +\dontrun{ # Flow normalized (excluding extremes from 2003-04): yearVector <- c(1980:2002, 2005:2015) plotFluxHist(eList, flowNormYears=yearVector) } +} \seealso{ \code{\link{setupYears}} } diff --git a/man/subFN.Rd b/man/subFN.Rd index d28f3ccb..4f668f21 100644 --- a/man/subFN.Rd +++ b/man/subFN.Rd @@ -24,4 +24,5 @@ eList <- Choptank_eList flowNormYears <- c(1985:2002,2006:2010) temp_daily <- subFN(eList, flowNormYears) +plotFluxHist(eList, flowNormYears = c(1985:2002,2006:2010)) } diff --git a/man/tableChange.Rd b/man/tableChange.Rd index a6be69e8..680d58fe 100644 --- a/man/tableChange.Rd +++ b/man/tableChange.Rd @@ -27,6 +27,7 @@ they can be set by the program to be the final year of the record and a set of y \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)) @@ -34,5 +35,6 @@ tableChange(eList, fluxUnit=9, flowNormYear=c(2001:2006, 2008:2009)) eList <- setPA(eList, paStart=12,paLong=3) tableChange(eList, fluxUnit=6,yearPoints=c(2001,2005,2008,2009)) } +} \keyword{statistics} \keyword{water-quality} diff --git a/man/tableChangeSingle.Rd b/man/tableChangeSingle.Rd index 68fc073e..a68bea43 100644 --- a/man/tableChangeSingle.Rd +++ b/man/tableChangeSingle.Rd @@ -33,16 +33,19 @@ they can be set by the program to be the final year of the record and a set of y } \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) } +} \keyword{statistics} \keyword{water-quality} diff --git a/man/tableResults.Rd b/man/tableResults.Rd index 3ad311fa..6089b99e 100644 --- a/man/tableResults.Rd +++ b/man/tableResults.Rd @@ -30,6 +30,7 @@ mean flux, and flow-normalized flux. \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') @@ -38,5 +39,6 @@ returnedTable <- tableResults(eList, fluxUnit = 1) eList <- setPA(eList, paLong=3,paStart=12) tableResults(eList, fluxUnit = 1) } +} \keyword{statistics} \keyword{water-quality} diff --git a/tests/testthat/tests_flow_normalization.R b/tests/testthat/tests_flow_normalization.R index ef815ae6..3931b299 100644 --- a/tests/testthat/tests_flow_normalization.R +++ b/tests/testthat/tests_flow_normalization.R @@ -51,4 +51,62 @@ test_that("setupYears", { ar_calendarYear_fn <- setupYears(eList$Daily, paLong = 12, paStart = 1) expect_equal(signif(ar_calendarYear_fn$FNConc[1], digits = 7), 1.021644) expect_equal(signif(ar_calendarYear_fn$FNFlux[1], digits = 7), 271.6512) -}) \ No newline at end of file +}) + +test_that("setupYears", { + testthat::skip_on_cran() + + eList <- Choptank_eList + + tC <- tableChange(eList) + expect_null(tC) + + tCS <- tableChangeSingle(eList) + expect_equal(ncol(tCS), 6) + expect_equal(tCS$Year1, c(1981,1981,1981,1981,1981,1981,1986,1986,1986,1986,1986,1991, + 1991,1991,1991,1996,1996,1996,2001,2001,2006)) + + expect_equal(tCS$Year2, c(1986,1991,1996,2001,2006,2011,1991,1996,2001,2006,2011,1996, + 2001,2006,2011,2001,2006,2011,2006,2011,2011)) + + expect_equal(tCS$`change[mg/L]`[1], 0.039) + expect_equal(tCS$`slope[mg/L/yr]`[1], 0.0079) + expect_equal(tCS$`change[%]`[1], 3.9) + expect_equal(tCS$`slope [%/yr]`[1], 0.79) + + tR <- tableResults(eList) + expect_true(all(names(tR) %in% c("Year","Discharge [cms]", + "Conc [mg/L]","FN Conc [mg/L]", + "Flux [10^6kg/yr]","FN Flux [10^6kg/yr]"))) + + expect_equal(tR$Year[1], 1980) + expect_equal(tR$`Discharge [cms]`[1], 4.25) + expect_equal(tR$`Conc [mg/L]`[1], 0.949) + expect_equal(tR$`FN Conc [mg/L]`[1], 1.003) + expect_equal(tR$`Flux [10^6kg/yr]`[1], 0.1154) + expect_equal(tR$`FN Flux [10^6kg/yr]`[1], 0.106) + + tR_2 <- tableResults(eList, fluxUnit = 'kgDay', qUnit = 'cms') + expect_true(all(names(tR_2) %in% c("Year","Discharge [cms]", + "Conc [mg/L]","FN Conc [mg/L]", + "Flux [kg/day]","FN Flux [kg/day]"))) + + eList <- Choptank_eList + tFC <- tableFlowChange(eList, istat=5, yearPoints=c(1985,1990,1995,2001,2005,2009)) + expect_true(all(names(tFC) %in% c("year1","year2","change[cfs]","slope[cfs/yr]", + "change[%]","slope[%/yr]"))) + expect_equal(tFC$`change[cfs]`[1], 7.5) + expect_equal(tFC$`slope[cfs/yr]`[1], 1.5) + expect_equal(tFC$`change[%]`[1], 6.5) + expect_equal(tFC$`slope[%/yr]`[1], 1.3) + + printReturn <- printSeries(eList, 5) + expect_true(all(names(printReturn) %in% c("years","qActual","qSmooth"))) + + expect_equal(printReturn$qActual[2], 78.3) + expect_equal(printReturn$qSmooth[2], 109) + + expect_equal(setSeasonLabelByUser(), "Water Year") + expect_equal(setSeasonLabelByUser(paStartInput = 12,paLongInput = 3), "Season Consisting of Dec Jan Feb") +}) + \ No newline at end of file diff --git a/tests/testthat/tests_utils.R b/tests/testthat/tests_utils.R index 68ed2e69..b81b9a4e 100644 --- a/tests/testthat/tests_utils.R +++ b/tests/testthat/tests_utils.R @@ -205,6 +205,46 @@ test_that("other plot functions don't error", { expect_silent(plotFluxPred(eList)) expect_true(dev_start + 1 == dev.cur()) + graphics.off() + dev_start <- dev.cur() + expect_silent(plotQTimeDaily(eList)) + expect_true(dev_start + 1 == dev.cur()) + + graphics.off() + dev_start <- dev.cur() + expect_silent(plotFluxQ(eList)) + expect_true(dev_start + 1 == dev.cur()) + + graphics.off() + dev_start <- dev.cur() + expect_silent(plotFlowSingle(eList, istat = 1)) + expect_true(dev_start + 1 == dev.cur()) + + graphics.off() + dev_start <- dev.cur() + expect_silent(plotFour(eList)) + expect_true(dev_start + 1 == dev.cur()) + + graphics.off() + dev_start <- dev.cur() + expect_silent(plotFour(eList)) + expect_true(dev_start + 1 == dev.cur()) + + graphics.off() + dev_start <- dev.cur() + expect_silent(plot1of15(eList, yearStart = 1995, yearEnd = 2005, qf = 1)) + expect_true(dev_start + 1 == dev.cur()) + + graphics.off() + dev_start <- dev.cur() + expect_silent(plotSDLogQ(eList)) + expect_true(dev_start + 1 == dev.cur()) + + graphics.off() + dev_start <- dev.cur() + expect_silent(plot15(eList = eList, yearStart = 1995, yearEnd = 2005)) + expect_true(dev_start + 1 == dev.cur()) + graphics.off() dev_start <- dev.cur() expect_silent(plotResidPred(eList)) @@ -307,4 +347,26 @@ test_that("flexPlotAddOn functions properly", { "The number of segments exceed the length of the color palette. Supply custom palette of length 32") expect_true(dev_start + 1 == dev.cur()) + startBlank <- "1995-01-01" + endBlank <- "2005-01-01" + + blank_eList <- blankTime(eList, startBlank, endBlank) + expect_is(blank_eList, "egret") + blank_daily <- getDaily(blank_eList) + expect_true(all(is.na(blank_daily$FNConc[blank_daily$Date > startBlank & + blank_daily$Date < endBlank]))) + + not_blank <- getDaily(eList) + expect_false(all(is.na(not_blank$FNConc[not_blank$Date > startBlank & + not_blank$Date < endBlank]))) + + expect_output(printFluxUnitCheatSheet(), +"The following codes apply to the fluxUnit list", ignore.case = TRUE) + + expect_output(printqUnitCheatSheet(), + "The following codes apply to the qUnit list:", ignore.case = TRUE) + + bias <- fluxBiasStat(localSample = eList$Sample) + rounded <- as.numeric(signif(bias)) + expect_equal(rounded, c(-0.0235532,-0.0235429,-0.023548)) })