anlz_ and show_enteromap now allow for within-function wet/dry subset…

…ting. tests included.
tbep-tech · Jul 13, 2024 · a2f6386 · a2f6386
1 parent daa369d
commit a2f6386
Show file tree

Hide file tree

Showing 11 changed files with 114 additions and 39 deletions.
diff --git a/R/anlz_enteromap.R b/R/anlz_enteromap.R
@@ -3,7 +3,10 @@
 #' @param fibdata data frame of Enterococcus sample data as returned by \code{\link{enterodata}} or \code{\link{anlz_fibwetdry}}
 #' @param yrsel optional numeric to filter data by year
 #' @param mosel optional numeric to filter data by month
-#' @param wetdry logical; if \code{TRUE}, incorporate wet/dry differences. if \code{FALSE} (default), do not differentiate between wet and dry samples.
+#' @param wetdry logical; if \code{TRUE}, incorporate wet/dry differences (this will result in a call to \code{\link{anlz_fibwetdry}}, in which case \code{temporal_window} and \code{wet_threshold} are required). if \code{FALSE} (default), do not differentiate between wet and dry samples.
+#' @param precipdata input data frame as returned by \code{\link{read_importrain}}. columns should be: station, date (yyyy-mm-dd), rain (in inches). The object \code{\link{catch_precip}} has this data from 1995-2023 for select Enterococcus stations.
+#' @param temporal_window numeric; required if \code{subset_wetdry} is not \code{"all"}. number of days precipitation should be summed over (1 = day of sample only; 2 = day of sample + day before; etc.)
+#' @param wet_threshold  numeric; required if \code{subset_wetdry} is not \code{"all"}. inches accumulated through the defined temporal window, above which a sample should be defined as being from a 'wet' time period
 #'
 #' @details This function is based on \code{\link{anlz_fibmap}}, but is specific to Enterococcus data downloaded via \code{\link{read_importentero}}. It creates categories for mapping using \code{\link{show_enteromap}}. Optionally, if samples have been defined as 'wet' or not via \code{\link{anlz_fibwetdry}}, this can be represented via symbols on the map.  Categories based on relevant thresholds are assigned to each observation.  The categories are specific to Enterococcus in marine waters (\code{class} of 2 or 3M). A station is categorized into one of four ranges defined by the thresholds as noted in the \code{cat} column of the output, with corresponding colors appropriate for each range as noted in the \code{col} column of the output.
 #'
@@ -14,13 +17,12 @@
 #' @examples
 #' anlz_enteromap(enterodata, yrsel = 2020, mosel = 9)
 #'
-#' # wet/dry samples
-#' entero_wetdry <- anlz_fibwetdry(enterodata, catch_precip)
-#' anlz_enteromap(entero_wetdry, yrsel = 2020, mosel = 9, wetdry = TRUE)
-#'
-#' # this will give the same output as the first example
-#' anlz_enteromap(entero_wetdry, yrsel = 2020, mosel = 9, wetdry = FALSE)
-anlz_enteromap <- function (fibdata, yrsel = NULL, mosel = NULL, wetdry = FALSE)
+#' # differentiate wet/dry samples in that time frame
+#' anlz_enteromap(enterodata, yrsel = 2020, mosel = 9, wetdry = TRUE,
+#'                temporal_window = 2, wet_threshold = 0.5)
+anlz_enteromap <- function (fibdata, yrsel = NULL, mosel = NULL, wetdry = FALSE,
+                            precipdata = NULL, temporal_window = NULL,
+                            wet_threshold = NULL)
 {
   levs <- util_fiblevs()
   cols <- c("#2DC938", "#E9C318", "#EE7600", "#CC3231")
@@ -33,8 +35,20 @@ anlz_enteromap <- function (fibdata, yrsel = NULL, mosel = NULL, wetdry = FALSE)
                   indnm = "ecocci",
                   conc = ecocci)
   if (wetdry == TRUE) {
-    stopifnot("fibdat does not contain a 'wet_sample' column" = exists("wet_sample", fibdata))
-    out$wet_sample = fibdata['wet_sample']
+      # make sure necessary info is provided
+      stopifnot("temporal_window and wet_threshold must both be provided in order to subset to wet or dry samples" = !is.null(temporal_window) & !is.null(wet_threshold)
+      )
+      # if precip data isn't specified, use the catch_precip object
+      if(is.null(precipdata)){
+        precipdata <- catch_precip
+        message("precipdata not specified; defaulting to tbeptools catch_precip object")
+      }
+      # run the anlz_fibwetdry function
+      wetdry <- anlz_fibwetdry(fibdata = fibdata,
+                            precipdata = precipdata,
+                            temporal_window = temporal_window,
+                            wet_threshold = wet_threshold)
+    out$wet_sample = wetdry$wet_sample
   }
   if (!is.null(yrsel)) {
     yrsel <- match.arg(as.character(yrsel), unique(out$yr))

diff --git a/R/anlz_fibmatrix.R b/R/anlz_fibmatrix.R
@@ -39,10 +39,12 @@
 #' anlz_fibmatrix(enterodata, indic = 'ecocci', lagyr = 1, threshold = 30)
 #'
 #' # subset to only wet samples
-#' anlz_fibmatrix(enterodata, indic = 'ecocci', lagyr = 1, subset_wetdry = "wet", temporal_window = 2, wet_threshold = 0.5)
+#' anlz_fibmatrix(enterodata, indic = 'ecocci', lagyr = 1, subset_wetdry = "wet",
+#'                temporal_window = 2, wet_threshold = 0.5)
 #'
 #' # subset to only dry samples
-#' anlz_fibmatrix(enterodata, indic = 'ecocci', lagyr = 1, subset_wetdry = "dry", temporal_window = 2, wet_threshold = 0.5)
+#' anlz_fibmatrix(enterodata, indic = 'ecocci', lagyr = 1, subset_wetdry = "dry",
+#'                temporal_window = 2, wet_threshold = 0.5)
 anlz_fibmatrix <- function(fibdata,
                            yrrng = NULL,
                            stas = NULL,

diff --git a/R/globalVariables.R b/R/globalVariables.R
@@ -74,7 +74,7 @@ globalVariables(c("Chlorophyll_aQ", "Latitude", "Longitude", "SampleTime", "Samp
                   "ActivityStartTime.TimeZoneCode", "DetectionQuantitationLimitMeasure.MeasureValue",
                   "MeasureQualifierCode", "ResultLaboratoryCommentText", "V1", "V2", "V3", "Var3",
                   "ecocci_censored", "rain", "rain_total", "sumgt", "wet_sample",
-                  "LabComments", "ecocci_units", "qualifier")
+                  "LabComments", "ecocci_units", "qualifier", "catch_precip", "wetdry")
 )
 
 #' @importFrom grDevices rgb

diff --git a/R/show_enteromap.R b/R/show_enteromap.R
@@ -16,17 +16,18 @@
 #' show_enteromap(enterodata, yrsel = 2020, mosel = 9)
 #'
 #' # wet/dry samples
-#' entero_wetdry <- anlz_fibwetdry(enterodata, catch_precip)
-#' show_enteromap(entero_wetdry, yrsel = 2020, mosel = 9, wetdry = TRUE)
-#'
-#' # this will give the same output as anlz_enteromap(enterodata)
-#' show_enteromap(entero_wetdry, yrsel = 2020, mosel = 9, wetdry = FALSE)
+#' show_enteromap(enterodata, yrsel = 2020, mosel = 9, wetdry = TRUE,
+#'                temporal_window = 2, wet_threshold = 0.5)
 #' }
 
-show_enteromap <- function(fibdata, yrsel, mosel, wetdry = FALSE){
+show_enteromap <- function(fibdata, yrsel, mosel, wetdry = FALSE,
+                           precipdata = NULL, temporal_window = NULL,
+                           wet_threshold = NULL){
 
   # get categories
-  fibmap <- anlz_enteromap(fibdata, yrsel = yrsel, mosel = mosel, wetdry = wetdry)
+  fibmap <- anlz_enteromap(fibdata, yrsel = yrsel, mosel = mosel, wetdry = wetdry,
+                           precipdata = precipdata, temporal_window = temporal_window,
+                           wet_threshold = wet_threshold)
 
   # make a column even if wetdry wasn't selected
   # and if it was, give it something other than true/false

diff --git a/R/show_fibmatrix.R b/R/show_fibmatrix.R
@@ -34,7 +34,8 @@
 #' show_fibmatrix(fibdata, indic = 'ecocci')
 #'
 #' # show matrix for only dry samples
-#' show_fibmatrix(enterodata, indic = 'ecocci', lagyr = 1, subset_wetdry = "dry", temporal_window = 2, wet_threshold = 0.5)
+#' show_fibmatrix(enterodata, indic = 'ecocci', lagyr = 1, subset_wetdry = "dry",
+#'                temporal_window = 2, wet_threshold = 0.5)
 show_fibmatrix <- function(fibdata, yrrng = NULL,
                            stas = NULL, indic = NULL, threshold = NULL, lagyr = 3,
                            subset_wetdry = c("all", "wet", "dry"), precipdata = NULL,

diff --git a/man/anlz_enteromap.Rd b/man/anlz_enteromap.Rd
diff --git a/man/anlz_fibmatrix.Rd b/man/anlz_fibmatrix.Rd
diff --git a/man/show_enteromap.Rd b/man/show_enteromap.Rd
diff --git a/man/show_fibmatrix.Rd b/man/show_fibmatrix.Rd
diff --git a/tests/testthat/test-anlz_enteromap.R b/tests/testthat/test-anlz_enteromap.R
@@ -36,3 +36,29 @@ test_that("Checking error for no data with anlz_enteromap", {
 
 })
 
+
+# Test wet/dry subsetting
+test_that("anlz_enteromap errors if wetdry info is not provided", {
+  expect_error(anlz_enteromap(enterodata, wetdry = TRUE, temporal_window = 2),
+               regxp = 'temporal_window and wet_threshold must both be provided in order to in order to differentiate wet vs. dry samples')
+})
+
+test_that("FALSE default for wetdry works", {
+
+  result_a <- anlz_enteromap(enterodata)
+  result_b <- anlz_enteromap(enterodata, wetdry = FALSE)
+
+  expect_equivalent(result_a, result_b)
+
+})
+
+test_that("wet/dry subsetting does lead to different data frames", {
+
+  result_a <- anlz_enteromap(enterodata)
+  result_b <- anlz_enteromap(enterodata, wetdry = TRUE, temporal_window = 2, wet_threshold = 0.5)
+
+  expect_failure(expect_equivalent(result_a, result_b))
+})
+
+
+
diff --git a/tests/testthat/test-show_enteromap.R b/tests/testthat/test-show_enteromap.R
@@ -7,3 +7,9 @@ test_that("show_enteromap correctly creates a leaflet map", {
   expect_s3_class(result, "leaflet")
 
 })
+
+
+test_that("show_enteromap errors if wetdry info is not provided", {
+  expect_error(show_enteromap(enterodata, wetdry = TRUE, temporal_window = 2),
+               regxp = 'temporal_window and wet_threshold must both be provided in order to differentiate wet vs. dry samples')
+})