From a2f6386550aa27119fbaf2a02ea1ac1170e794d1 Mon Sep 17 00:00:00 2001 From: Kim Cressman Date: Sat, 13 Jul 2024 11:30:18 -0500 Subject: [PATCH] anlz_ and show_enteromap now allow for within-function wet/dry subsetting. tests included. --- R/anlz_enteromap.R | 34 ++++++++++++++++++++-------- R/anlz_fibmatrix.R | 6 +++-- R/globalVariables.R | 2 +- R/show_enteromap.R | 15 ++++++------ R/show_fibmatrix.R | 3 ++- man/anlz_enteromap.Rd | 27 +++++++++++++++------- man/anlz_fibmatrix.Rd | 6 +++-- man/show_enteromap.Rd | 25 ++++++++++++++------ man/show_fibmatrix.Rd | 3 ++- tests/testthat/test-anlz_enteromap.R | 26 +++++++++++++++++++++ tests/testthat/test-show_enteromap.R | 6 +++++ 11 files changed, 114 insertions(+), 39 deletions(-) diff --git a/R/anlz_enteromap.R b/R/anlz_enteromap.R index 68d570c8..9489a43e 100644 --- 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 index 6743328a..89834d8f 100644 --- 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 index 518ffcef..5c681952 100644 --- 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 index ca9d0e2a..d97920f2 100644 --- 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 index 7f2d7db8..9514342e 100644 --- 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 index e470236a..f1e1b47c 100644 --- a/man/anlz_enteromap.Rd +++ b/man/anlz_enteromap.Rd @@ -4,7 +4,15 @@ \alias{anlz_enteromap} \title{Assign threshold categories to Enterococcus data} \usage{ -anlz_enteromap(fibdata, yrsel = NULL, mosel = NULL, wetdry = FALSE) +anlz_enteromap( + fibdata, + yrsel = NULL, + mosel = NULL, + wetdry = FALSE, + precipdata = NULL, + temporal_window = NULL, + wet_threshold = NULL +) } \arguments{ \item{fibdata}{data frame of Enterococcus sample data as returned by \code{\link{enterodata}} or \code{\link{anlz_fibwetdry}}} @@ -13,7 +21,13 @@ anlz_enteromap(fibdata, yrsel = NULL, mosel = NULL, wetdry = FALSE) \item{mosel}{optional numeric to filter data by month} -\item{wetdry}{logical; if \code{TRUE}, incorporate wet/dry differences. if \code{FALSE} (default), do not differentiate between wet and dry samples.} +\item{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.} + +\item{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.} + +\item{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.)} + +\item{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} } \value{ A \code{data.frame} similar to \code{fibdata} with additional columns describing station categories and optionally filtered by arguments passed to the function @@ -27,10 +41,7 @@ This function is based on \code{\link{anlz_fibmap}}, but is specific to Enteroco \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) +# differentiate wet/dry samples in that time frame +anlz_enteromap(enterodata, yrsel = 2020, mosel = 9, wetdry = TRUE, + temporal_window = 2, wet_threshold = 0.5) } diff --git a/man/anlz_fibmatrix.Rd b/man/anlz_fibmatrix.Rd index 8bab8451..4438b1b7 100644 --- a/man/anlz_fibmatrix.Rd +++ b/man/anlz_fibmatrix.Rd @@ -61,10 +61,12 @@ anlz_fibmatrix(enterodata, indic = 'ecocci', lagyr = 1) 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) } \seealso{ \code{\link{show_fibmatrix}} diff --git a/man/show_enteromap.Rd b/man/show_enteromap.Rd index 25c66e09..3160446b 100644 --- a/man/show_enteromap.Rd +++ b/man/show_enteromap.Rd @@ -4,7 +4,15 @@ \alias{show_enteromap} \title{Map Enterococcus results by month, year, and location} \usage{ -show_enteromap(fibdata, yrsel, mosel, wetdry = FALSE) +show_enteromap( + fibdata, + yrsel, + mosel, + wetdry = FALSE, + precipdata = NULL, + temporal_window = NULL, + wet_threshold = NULL +) } \arguments{ \item{fibdata}{data frame of Enterococcus sample data as returned by \code{\link{enterodata}} or \code{\link{anlz_fibwetdry}}} @@ -13,7 +21,13 @@ show_enteromap(fibdata, yrsel, mosel, wetdry = FALSE) \item{mosel}{optional numeric to filter data by month} -\item{wetdry}{logical; if \code{TRUE}, incorporate wet/dry differences. if \code{FALSE} (default), do not differentiate between wet and dry samples.} +\item{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.} + +\item{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.} + +\item{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.)} + +\item{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} } \value{ A \code{leaflet} map for the selected year, month, and area showing stations and FIB concentration category @@ -29,11 +43,8 @@ Placing the mouse cursor over an item on the map will reveal additional informat 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) } } \seealso{ diff --git a/man/show_fibmatrix.Rd b/man/show_fibmatrix.Rd index db35fca0..d94fbdb7 100644 --- a/man/show_fibmatrix.Rd +++ b/man/show_fibmatrix.Rd @@ -80,6 +80,7 @@ show_fibmatrix(fibdata, threshold = 200) 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) } \concept{show} diff --git a/tests/testthat/test-anlz_enteromap.R b/tests/testthat/test-anlz_enteromap.R index ecc38874..1679a542 100644 --- 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 index 00b00baf..d7db1465 100644 --- 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') +})