Merge pull request #211 from ldecicco-USGS/master

Lots more tests

R/egret_objects.R

@@ -24,7 +24,11 @@
 #' plotFluxQ(eList_full)
 as.egret <- function(INFO, Daily, Sample=NA, surfaces=NA) {
 
-  if(!all(is.na(Daily))){
+  if(exists("Daily") && !all(is.na(Daily))){
+
+    if(!("Q" %in% names(Daily))){
+      stop("Missing column 'Q' in Daily dataframe.")
+    }
 
     expectedCols <- c("Date","Q","LogQ","Julian","Month","Day","DecYear","MonthSeq")
     if(!all(expectedCols %in% names(Daily))){
@@ -40,38 +44,34 @@ as.egret <- function(INFO, Daily, Sample=NA, surfaces=NA) {
     }
   }
 
-  if(!all(is.na(Sample))){
+  if(exists("Sample") && !all(is.na(Sample))){
     if(any(duplicated(Sample$Date))){
       message("\nThere are ",sum(duplicated(Sample$Date))," duplicated Sample dates.")
     }
     if(is.unsorted(Sample$Date)){
       Sample <- Sample[order(Sample$Date, decreasing = FALSE),]
       message("\nThe Sample data frame was sorted chronologically.")
     }
+
+    if(!all((c("ConcLow","ConcHigh","Uncen","ConcAve") %in% names(Sample)))){
+      message("\nPlease double check that the Sample dataframe is correctly defined.")
+      message("\nMissing columns:", c("ConcLow","ConcHigh","Uncen","ConcAve")[!(c("ConcLow","ConcHigh","Uncen","ConcAve") %in% names(Sample))])
+    }
   }
 
-  eList <- list(INFO=INFO, 
-                Daily=Daily, 
-                Sample=Sample, 
-                surfaces=surfaces)
-
-  if(!all(is.na(Daily)) && !("Q" %in% names(Daily))){
-    stop("Missing column 'Q' in Daily dataframe.")
-  }
-
-  if(!all(is.na(Sample)) && !all((c("ConcLow","ConcHigh","Uncen","ConcAve") %in% names(Sample)))){
-    message("\nPlease double check that the Sample dataframe is correctly defined.")
-    message("\nMissing columns:", c("ConcLow","ConcHigh","Uncen","ConcAve")[!(c("ConcLow","ConcHigh","Uncen","ConcAve") %in% names(Sample))])
-  }
-
-  if(!any(c("param.units", "shortName", "paramShortName", "constitAbbrev", "drainSqKm") %in% names(INFO))){
+  if(exists("INFO") && !any(c("param.units", "shortName", "paramShortName", "constitAbbrev", "drainSqKm") %in% names(INFO))){
     message("\nPlease double check that the INFO dataframe is correctly defined.")
   }
 
   if(exists("surfaces") && isTRUE(14 != nrow(surfaces))){
     message("\nPlease double check that the surfaces matrix is correctly defined.")
   }
 
+  eList <- list(INFO=INFO, 
+                Daily=Daily, 
+                Sample=Sample, 
+                surfaces=surfaces)
+
   attr(eList, "param.units") <- INFO$param.units
   attr(eList, "shortName") <- INFO$shortName
   attr(eList, "paramShortName") <- INFO$paramShortName

R/mergeReport.r

@@ -49,12 +49,12 @@ mergeReport <- function(INFO, Daily, Sample = NA, surfaces=NA, verbose = TRUE, i
     dataOverview(Daily, Sample)  
   }
 
-  if(!is.na(Daily) && !("Q" %in% names(Daily))){
+  if(exists("Daily") && !all(is.na(Daily)) && !("Q" %in% names(Daily))){
     message("Please double check that the Daily dataframe is correctly defined.")
   }
 
 
-  if(!any(c("param.units", "shortName", "paramShortName", "constitAbbrev", "drainSqKm") %in% names(INFO))){
+  if(exists("INFO") && !any(c("param.units", "shortName", "paramShortName", "constitAbbrev", "drainSqKm") %in% names(INFO))){
     message("Please double check that the INFO dataframe is correctly defined.")
   }
 

R/readUserSample.r

@@ -35,7 +35,7 @@
 #' @examples
 #' filePath <- system.file("extdata", package="EGRET")
 #' fileName <- 'ChoptankRiverNitrate.csv'
-#' Sample <- readUserSample(filePath,fileName, separator=";",interactive=FALSE)
+#' Sample <- readUserSample(filePath,fileName, separator=";",verbose=FALSE)
 readUserSample <- function (filePath,fileName,hasHeader=TRUE,separator=",", verbose=TRUE, interactive=NULL){
 
   if(!is.null(interactive)) {

tests/testthat/tests_imports.R

@@ -57,11 +57,9 @@ test_that("External WQP Sample tests", {
   SampleNames <- c("Date","ConcLow","ConcHigh","Uncen","ConcAve","Julian","Month",   
                    "Day","DecYear","MonthSeq","waterYear","SinDY","CosDY")
 
-  # Sample_Chloride <- readWQPSample('USGS-01594440',
-  #                               'Chloride', 
-  #                               '', '')
+  Sample_All <- readWQPSample('WIDNR_WQX-10032762','Specific conductance', '', '')
 
-  # expect_that(all(names(Sample_Chloride) %in% SampleNames),is_true())
+  expect_that(all(names(Sample_All) %in% SampleNames),is_true())
 
 })
 
@@ -83,4 +81,36 @@ test_that("External INFO tests", {
   expect_that(all(requiredColumns %in% names(INFO2)),is_true())
 
 
-})
+})
+
+test_that("User tests", {
+
+  filePath <- system.file("extdata", package="EGRET")
+  fileName <- 'ChoptankRiverFlow.txt'
+  ChopData <- readDataFromFile(filePath,fileName, separator="\t")
+
+  expect_equal(ncol(ChopData), 2)
+  fileNameDaily <- "ChoptankRiverFlow.txt"
+  Daily_user <- readUserDaily(filePath,fileNameDaily,separator="\t",verbose=FALSE)
+
+  DailyNames <- c("Date","Q","Julian","Month","MonthSeq","waterYear",  
+                  "Day","DecYear","Qualifier","i","LogQ","Q7","Q30")
+  expect_that(all(names(Daily_user) %in% DailyNames),is_true())
+
+  fileNameSample <- 'ChoptankRiverNitrate.csv'
+  Sample_user <- readUserSample(filePath,fileNameSample, separator=";",verbose=FALSE)
+
+  SampleNames <- c("Date","ConcLow","ConcHigh","Uncen","ConcAve","Julian","Month",   
+                   "Day","DecYear","MonthSeq","waterYear","SinDY","CosDY")
+
+  expect_that(all(names(Sample_user) %in% SampleNames),is_true())
+
+})
+
+
+test_that("processQWData", {
+  testthat::skip_on_cran()
+  rawWQP <- dataRetrieval::readWQPqw('WIDNR_WQX-10032762','Specific conductance', '2012-01-01', '2012-12-31')
+  Sample2 <- processQWData(rawWQP, pCode=FALSE)
+  expect_true(all(Sample2[[2]] == ""))
+})

tests/testthat/tests_utils.R

@@ -303,6 +303,35 @@ test_that("other plot functions don't error", {
   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()
+  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())
 
 })
 
@@ -314,38 +343,6 @@ test_that("flexPlotAddOn functions properly", {
   testthat::skip_on_cran()
 
   eList <- Choptank_eList
-  # eList <- setUpEstimation(eList)
-  # sampleSegStart <- c(1980,1985,2000)
-  # flowSegStart <- c(1980,1990,2000)
-  # flowSegEnd <- c(1990,2000,2010)
-  # dateInfo <- data.frame(sampleSegStart, flowSegStart, flowSegEnd)
-  # eList <- flexFN(eList, dateInfo)
-  # 
-  # graphics.off()
-  # dev_start <- dev.cur()
-  # expect_message(plotFluxHist(eList))
-  # expect_silent(flexPlotAddOn(eList))
-  # expect_true(dev_start + 1 == dev.cur())
-  # 
-  # graphics.off()
-  # dev_start <- dev.cur()
-  # expect_message(plotFluxHist(eList))
-  # expect_silent(flexPlotAddOn(eList, customPalette = 
-  #                               c("#02df77", "#dc28b2", "#2137a6")))
-  # expect_true(dev_start + 1 == dev.cur())
-  # 
-  # sampleSegStart <- seq(1980,2011)
-  # flowSegStart <- seq(1980,2011)
-  # flowSegEnd <- seq(1981,2012)
-  # dateInfo <- data.frame(sampleSegStart, flowSegStart, flowSegEnd)
-  # eList <- flexFN(eList, dateInfo)
-  # 
-  # graphics.off()
-  # dev_start <- dev.cur()
-  # expect_message(plotFluxHist(eList))
-  # expect_error(flexPlotAddOn(eList), 
-  #              "The number of segments exceed the length of the color palette. Supply custom palette of length 32")
-  # expect_true(dev_start + 1 == dev.cur())
 
   graphics.off()
   dev_start <- dev.cur()
@@ -453,3 +450,28 @@ test_that("surfaceStartEnd",{
   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)
+})

vignettes/Enhancements.Rmd

@@ -235,16 +235,21 @@ fluxPercents
 
 ```
 
-
-One final note about this output is that we can also express the flux information as yields, by dividing by the drainage area.  So we can do a matrix multiplication and end up with a new object that still has concentrations in the first row but has yields in the second row.  For example if we want to do yield in kg/km^2/year.  We could do this.  First we see **pairResults** and second we see **pairResultsYield**.
+We can provide a nice looking table of these results as follows (with a specified number of significant digits):
 
 ```{r tableOut}
 knitr::kable(pairResults, digits = 4)
 # note that you don't have to use the kable function from knitr to 
 # see the results, you can just give the command pairResults
 # and you will get the output, it just won't look as nice as this
+```
+
+One final note about this output is that we can also express the flux information as yields, by dividing by the drainage area. This can be very handy when looking at many watersheds. It would be nice to see how their flux trends compare on a unit area basis.  To get the yields we can do a matrix multiplication and end up with a new object that still has concentrations in the first row but has yields in the second row. For example if we want to do yield in kg/km^2/year. We could do this. First we can create another data frame called **pairResultsYield**, and then print it as a table.
+
+```{r tableOutYield}
 pairResultsYield <- pairResults * c(1, 1000000 / eList$INFO$drainSqKm )
 knitr::kable(pairResultsYield, digits = 4)
+
 ```
 
 ## Attributes of **pairResults**