context("EGRET utils") test_that("axis functions generate correct ticks", { #logPretty, generalAxis axis1 <- logPretty1(0.7, 990000) expect_is(axis1, "numeric") expect_equal(range(axis1), c(1e-1, 1e6)) axis3 <- logPretty3(3,60) expect_is(axis3, "numeric") expect_equal(range(axis3), c(2, 100)) q <- Choptank_eList$Daily$Q genAx <- generalAxis(x = q, max = max(q), min = min(q), units = getInfo(Choptank_eList)$param.units) expect_is(genAx, "list") expect_is(genAx$ticks, "numeric") expect_equal(genAx$bottom, 0) expect_equal(genAx$top, 250) expect_equal(range(genAx$ticks), c(0,250)) }) test_that("censoredSegments doesn't error", { x <- c(1,2,3,4,5,6) y <- c(1,3,4,3.3,4.4,7) xlim <- c(min(x)*.75,max(x)*1.25) ylim <- c(0,1.25*max(y)) xlab <- "Date" ylab <- "Concentration" xTicks <- pretty(xlim) yTicks <- pretty(ylim) genericEGRETDotPlot(x=x, y=y, xlim=xlim, ylim=ylim, xlab=xlab, ylab=ylab, xTicks=xTicks, yTicks=yTicks, plotTitle="Test") yBottom <- 0 yLow <- c(NA,3,4,3.3,4,7) yHigh <- c(1,3,4,3.3,5,NA) Uncen <- c(0,1,1,1,0,0) expect_silent({ censoredSegments(yBottom=yBottom,yLow=yLow,yHigh=yHigh,x=x,Uncen=Uncen) }) }) test_that("date functions work", { correctDates <- checkStartEndDate("2016-01-01", "2017-01-01") expect_length(correctDates, 2) expect_warning(checkStartEndDate("2017-01-01", "2016-01-01", interactive = FALSE)) expect_true(dateFormatCheck("2017-01-01")) expect_false(dateFormatCheck("2017-1-1")) }) test_that("data functions work", { testthat::skip_on_cran() dateTime <- c('1985-01-01', '1985-01-02', '1985-01-03') comment1 <- c("","","") value1 <- c(1,2,3) comment2 <- c("","<","") value2 <- c(2,3,4) comment3 <- c("","","<") value3 <- c(3,4,5) dataInput <- data.frame(dateTime, comment1, value1, comment2, value2, comment3, value3, stringsAsFactors=FALSE) compressed <- compressData(dataInput) expect_is(compressed, "data.frame") expect_gt(nrow(compressed), 1) expect_true(all(c("dateTime", "ConcLow", "ConcHigh", "Uncen") %in% names(compressed))) #mergeReport siteNumber <- '01594440' pCode <- '01075' Daily <- readNWISDaily(siteNumber,'00060', '1985-01-01', '1990-03-31') Sample <- readNWISSample(siteNumber,pCode, '1985-01-01', '1990-03-31') INFO <- readNWISInfo(siteNumber,pCode,interactive=FALSE) eList <- mergeReport(INFO, Daily, Sample) expect_equal(names(eList), c("INFO", "Daily", "Sample", "surfaces")) expect_is(eList$INFO, "data.frame") expect_is(eList$Daily, "data.frame") expect_is(eList$Sample, "data.frame") expect_gt(nrow(eList$Daily), 1) expect_gt(nrow(eList$Sample), 1) expect_gt(nrow(eList$INFO), 0) code <- c("","<","") value <- c(1,2,3) dataInput <- data.frame(value, code, stringsAsFactors=FALSE) concentrationDF <- populateConcentrations(dataInput) expect_is(concentrationDF, "data.frame") expect_equal(0, concentrationDF$ConcLow[2]) expect_equal(names(concentrationDF), c("ConcLow", "ConcHigh", "Uncen")) expect_gt(nrow(concentrationDF), 0) Daily <- getDaily(Arkansas_eList) DailySubset <- selectDays(Daily, 4, 11) expect_is(DailySubset, "data.frame") months <- as.numeric(format(as.Date(DailySubset$Date), "%m")) expect_true(all(months %in% c(11,12,1,2))) }) test_that("Other miscellaneous functions work", { dailyMeas <- getDaily(Choptank_eList) lab <- setSeasonLabel(setupYears(dailyMeas)) expect_equal(lab, "Water Year") lab_calendar <- setSeasonLabel(setupYears(dailyMeas, paStart = 1)) expect_equal(lab_calendar, "Calendar Year") eList <- setPA(Arkansas_eList, paStart=12, paLong=3, window = 30) param.nm <- getInfo(eList) expect_equal(param.nm$paStart, 12) expect_equal(param.nm$paLong, 3) expect_equal(param.nm$window, 30) }) test_that("nDischarge returns correct numbers", { expect_equal(nDischarge(Arkansas_eList), 8401) expect_equal(nDischarge(Choptank_eList), 11688) }) test_that("nObservations returns correct numbers", { expect_equal(nObservations(Arkansas_eList), 254) expect_equal(nObservations(Choptank_eList), 606) }) test_that("nCensored returns correct numbers", { expect_equal(nCensoredVals(Arkansas_eList), 115) expect_equal(nCensoredVals(Choptank_eList), 1) }) context("plot method for egret objects") test_that("plot method for egret objects work", { testthat::skip_on_cran() graphics.off() dev_start <- dev.cur() eList <- Choptank_eList plot(eList) expect_true(dev_start + 1 == dev.cur()) }) test_that("plot.egret passes correct arguments", { graphics.off() dev_start <- dev.cur() eList <- Choptank_eList plot(eList, logScaleConc = TRUE) expect_true(dev_start + 1 == dev.cur()) }) test_that("other plot functions don't error", { testthat::skip_on_cran() eList <- Choptank_eList graphics.off() dev_start <- dev.cur() expect_silent(boxConcMonth(eList)) expect_true(dev_start + 1 == dev.cur()) graphics.off() dev_start <- dev.cur() expect_silent(boxQTwice(eList)) expect_true(dev_start + 1 == dev.cur()) graphics.off() dev_start <- dev.cur() expect_silent(plotConcTime(eList)) expect_true(dev_start + 1 == dev.cur()) graphics.off() dev_start <- dev.cur() expect_silent(plotConcQ(eList)) expect_true(dev_start + 1 == dev.cur()) graphics.off() dev_start <- dev.cur() expect_silent(multiPlotDataOverview(eList)) expect_true(dev_start + 1 == dev.cur()) graphics.off() dev_start <- dev.cur() expect_message(plotConcTimeDaily(eList)) expect_true(dev_start + 1 == dev.cur()) graphics.off() dev_start <- dev.cur() expect_silent(plotConcTimeDaily(eList, plotGenConc = FALSE)) expect_true(dev_start + 1 == dev.cur()) graphics.off() dev_start <- dev.cur() expect_message(plotFluxTimeDaily(eList)) expect_message(plotFluxTimeDaily(eList, fluxUnit = 4)) expect_true(dev_start + 1 == dev.cur()) graphics.off() dev_start <- dev.cur() expect_silent(plotFluxTimeDaily(eList, plotGenFlux = FALSE)) expect_true(dev_start + 1 == dev.cur()) graphics.off() dev_start <- dev.cur() expect_silent(plotConcPred(eList)) expect_true(dev_start + 1 == dev.cur()) graphics.off() dev_start <- dev.cur() expect_silent(plotFluxPred(eList)) expect_silent(plotFluxPred(eList, fluxUnit = 4)) expect_silent(plotFluxPred(eList, fluxUnit = "poundsDay")) 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(plotFluxQ(eList, fluxUnit = 4, qUnit = 1)) 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)) expect_true(dev_start + 1 == dev.cur()) graphics.off() dev_start <- dev.cur() expect_silent(plotResidQ(eList)) expect_true(dev_start + 1 == dev.cur()) graphics.off() dev_start <- dev.cur() expect_silent(plotResidTime(eList)) expect_true(dev_start + 1 == dev.cur()) graphics.off() dev_start <- dev.cur() expect_silent(boxResidMonth(eList)) expect_true(dev_start + 1 == dev.cur()) graphics.off() dev_start <- dev.cur() expect_silent(boxConcThree(eList)) expect_true(dev_start + 1 == dev.cur()) graphics.off() dev_start <- dev.cur() expect_silent(plotConcHist(eList)) expect_true(dev_start + 1 == dev.cur()) graphics.off() dev_start <- dev.cur() expect_silent(plotFluxHist(eList)) expect_silent(plotFluxHist(eList, fluxUnit = 4)) expect_true(dev_start + 1 == dev.cur()) graphics.off() dev_start <- dev.cur() date1 <- "2000-09-01" date2 <- "2005-09-01" date3 <- "2009-09-01" qBottom<-100 qTop<-5000 expect_silent(plotConcQSmooth(eList, date1, date2, date3, qBottom, qTop, concMax=2,qUnit=1, legendLeft = 1000, legendTop = 2)) expect_true(dev_start + 1 == dev.cur()) graphics.off() dev_start <- dev.cur() q1 <- 10 q2 <- 25 q3 <- 75 centerDate <- "07-01" yearEnd <- 2009 yearStart <- 2000 expect_silent(plotConcTimeSmooth(eList, q1, q2, q3, centerDate, yearStart, yearEnd)) expect_true(dev_start + 1 == dev.cur()) graphics.off() dev_start <- dev.cur() expect_silent(fluxBiasMulti(eList)) expect_true(dev_start + 1 == dev.cur()) graphics.off() dev_start <- dev.cur() expect_silent(fluxBiasMulti(eList, qUnit = 1, fluxUnit = 4)) expect_true(dev_start + 1 == dev.cur()) graphics.off() dev_start <- dev.cur() clevel <- seq(0,3.5,0.5) yearStart <- 2001 yearEnd <- 2010 qBottom <- 0.5 qTop<- 22 expect_silent(plotContours(eList, yearStart,yearEnd,qBottom,qTop, contourLevels = clevel) ) expect_true(dev_start + 1 == dev.cur()) graphics.off() dev_start <- dev.cur() year0<-2001 year1<-2009 qBottom<-0.33 qTop<-22 maxDiff<-0.5 expect_silent(plotDiffContours(eList, year0,year1)) expect_true(dev_start + 1 == dev.cur()) graphics.off() dev_start <- dev.cur() expect_silent(plotFourStats(eList)) expect_true(dev_start + 1 == dev.cur()) pair1 <- runPairs(eList, year1 = 1985, year2 = 2010, windowSide = 0) graphics.off() dev_start <- dev.cur() expect_silent(plotMonthTrend(pair1)) expect_true(dev_start + 1 == dev.cur()) }) test_that("plot.egret passes correct arguments", { expect_error(plot(eList, col='blue')) }) test_that("flexPlotAddOn functions properly", { testthat::skip_on_cran() eList <- Choptank_eList graphics.off() dev_start <- dev.cur() expect_silent(genericEGRETDotPlot(1:2, 1:2, 1:2, 1:2)) graphics.off() 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)) }) test_that("mergeReport",{ expect_type(eList_orig_Ch, "list") expect_true(all(names(eList_orig_Ch) %in% c("INFO","Daily","Sample","surfaces"))) expect_equal(round(head(eList_orig_Ch$Sample$Q), 3), c(3.200,2.973,2.945,10.902,3.228,6.371)) }) test_that("startEnd",{ paStart <- 10 paLong <- 12 year <- 2000 firstLast <- startEnd(paStart, paLong, year) expect_equal(firstLast[["startDate"]], as.Date("1999-10-01")) expect_equal(firstLast[["endDate"]], as.Date("2000-09-30")) paStart <- 1 paLong <- 3 firstLast <- startEnd(paStart, paLong, year) expect_equal(firstLast[["startDate"]], as.Date("2000-01-01")) expect_equal(firstLast[["endDate"]], as.Date("2000-03-31")) paStart <- 3 paLong <- 12 firstLast <- startEnd(paStart, paLong, year) expect_equal(firstLast[["startDate"]], as.Date("1999-03-01")) expect_equal(firstLast[["endDate"]], as.Date("2000-02-29")) year <- 2001 firstLast <- startEnd(paStart, paLong, year) expect_equal(firstLast[["startDate"]], as.Date("2000-03-01")) expect_equal(firstLast[["endDate"]], as.Date("2001-02-28")) }) test_that("surfaceStartEnd",{ paStart <- 10 paLong <- 12 Date1 <- "2000-10-15" Date2 <- "2010-01-01" firstLast <- surfaceStartEnd(paStart, paLong, Date1, Date2) expect_equal(firstLast[["surfaceStart"]], as.Date("2000-10-01")) expect_equal(firstLast[["surfaceEnd"]], as.Date("2010-09-30")) #Leap years paStart <- 3 paLong <- 12 Date1 <- "1976-10-15" Date2 <- "1980-02-01" firstLast <- surfaceStartEnd(paStart, paLong, Date1, Date2) expect_equal(firstLast[["surfaceStart"]], as.Date("1976-03-01")) expect_equal(firstLast[["surfaceEnd"]], as.Date("1980-02-29")) #Not water years: paStart <- 1 paLong <- 12 Date1 <- "2000-10-15" Date2 <- "2010-01-01" firstLast <- surfaceStartEnd(paStart, paLong, Date1, Date2) expect_equal(firstLast[["surfaceStart"]], as.Date("2000-01-01")) expect_equal(firstLast[["surfaceEnd"]], as.Date("2010-12-31")) paStart <- 3 paLong <- 6 Date1 <- "2000-04-15" Date2 <- "2012-05-01" firstLast <- surfaceStartEnd(paStart, paLong, Date1, Date2) expect_equal(firstLast[["surfaceStart"]], as.Date("2000-03-01")) expect_equal(firstLast[["surfaceEnd"]], as.Date("2012-08-30")) }) test_that("fixSampleFrame", { eList <- Choptank_eList Sample <- eList$Sample Sample[1,c("ConcLow","ConcHigh")] <- c(NA, 0.01) # Adjusted to left-censored Sample[2,c("ConcLow","ConcHigh")] <- c(1.1, 1.3) # Adjusted to interval-censored Sample[3,c("ConcLow","ConcHigh")] <- c(1.3, 1.3) # Simple adjustment eListNew <- eList eListNew$Sample <- Sample eListNew <- fixSampleFrame(eListNew) expect_equal(eList$Sample$Uncen[1:3], c(1,1,1)) expect_equal(eListNew$Sample$Uncen[1:3], c(0,0,1)) }) test_that("removeDuplicates", { DecYear <- c('1985.01', '1985.01', '1985.02', '1985.02', '1985.03') ConcHigh <- c(1,2,3,3,5) dataInput <- data.frame(DecYear, ConcHigh, stringsAsFactors=FALSE) dataInput_removed <- removeDuplicates(dataInput) expect_equal(nrow(dataInput), 5) expect_equal(nrow(dataInput_removed), 4) })