areasel argument added to anlz_enteromap and show_enteromap, title re…

…moved from show_enteromap, analyze entero functions returned as tibble, fib vignette updated

R/anlz_enteromap.R

@@ -3,13 +3,16 @@
 #' @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 areasel optional character string to filter output by stations in the \code{long_name} column of \code{enterodata}, see details
 #' @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{catchprecip}} has this data from 1995-2023 for select Enterococcus stations. If \code{NULL}, defaults to \code{\link{catchprecip}}.
 #' @param temporal_window numeric; required if \code{wetdry} is \code{TRUE}. 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{wetdry} is \code{TRUE}. 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.
 #'
+#' The \code{areasel} argument can indicate valid entries in the \code{long_name} column of \code{enterodata}.  For example, use \code{"Old Tampa Bay"} for stations in the subwatershed of Old Tampa Bay, where rows in  \code{enterodata} are filtered based on the the selection.  All stations are returned if this argument is set as \code{NULL} (default). All valid options for \code{areasel} include \code{"Old Tampa Bay"}, \code{"Hillsborough Bay"}, \code{"Middle Tampa Bay"}, \code{"Lower Tampa Bay"}, \code{"Boca Ciega Bay"}, or \code{"Manatee River"}.  One to any of the options can be used.
+#'
 #' @return A \code{data.frame} similar to \code{fibdata} with additional columns describing station categories and optionally filtered by arguments passed to the function
 #'
 #' @export
@@ -20,20 +23,22 @@
 #' # 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,
+anlz_enteromap <- function (fibdata, yrsel = NULL, mosel = NULL, areasel = NULL, wetdry = FALSE,
                             precipdata = NULL, temporal_window = NULL,
-                            wet_threshold = NULL)
-{
+                            wet_threshold = NULL){
+
   levs <- util_fiblevs()
   cols <- c("#2DC938", "#E9C318", "#EE7600", "#CC3231")
-  out <- fibdata %>% select(station, yr,
-                            mo, Latitude, Longitude, ecocci) %>%
+
+  out <- fibdata %>%
+    select(station, long_name, yr, mo, Latitude, Longitude, ecocci) %>%
     dplyr::mutate(cat = cut(ecocci, breaks = levs$ecoccilev, right = F, levs$ecoccilbs),
                   col = cut(ecocci, breaks = levs$ecoccilev, right = F, cols),
                   col = as.character(col),
                   ind = "Enterococcus",
                   indnm = "ecocci",
                   conc = ecocci)
+
   if (wetdry == TRUE) {
       # 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)
@@ -49,17 +54,38 @@ anlz_enteromap <- function (fibdata, yrsel = NULL, mosel = NULL, wetdry = FALSE,
                             wet_threshold = wet_threshold)
     out$wet_sample = wetdry$wet_sample
   }
+
+  # filter by area
+  if(!is.null(areasel)){
+
+    areasvc <- c("Old Tampa Bay", "Hillsborough Bay", "Middle Tampa Bay", "Lower Tampa Bay",
+        "Boca Ciega Bay", "Manatee River")
+
+    areasel <- match.arg(areasel, areasvc, several.ok = TRUE)
+
+    out <- out %>%
+      dplyr::filter(long_name %in% areasel)
+
+  }
+
   if (!is.null(yrsel)) {
     yrsel <- match.arg(as.character(yrsel), unique(out$yr))
-    out <- out %>% dplyr::filter(yr %in% yrsel)
+    out <- out %>%
+      dplyr::filter(yr %in% yrsel)
   }
   if (!is.null(mosel)) {
     mosel <- match.arg(as.character(mosel), 1:12)
-    out <- out %>% dplyr::filter(mo %in% mosel)
+    out <- out %>%
+      dplyr::filter(mo %in% mosel)
   }
+
   chk <- length(na.omit(out$cat)) == 0
   if (chk)
     stop("No FIB data for ", paste(lubridate::month(mosel,
                                                     label = T), yrsel, sep = " "))
+
+  out <- tibble::tibble(out)
+
   return(out)
+
 }

R/anlz_fibmap.R

@@ -7,7 +7,7 @@
 #'
 #' @details This function is used to create FIB categories for mapping using \code{\link{show_fibmap}}.  Categories based on relevant thresholds are assigned to each observation.  The categories are specific to E. coli or Enterococcus and are assigned based on the station class as freshwater (\code{class} as 1 or 3F) or marine (\code{class} as 2 or 3M), respectively.  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.
 #'
-#' The \code{areasel} argument can indicate valid entries in the \code{area} column of \code{fibdata}.  For example, use either \code{"Alafia River"} or \code{"Hillsborough River"} for the corresponding river basins, where rows in  \code{fibdata} are filtered based on the the selection.  All stations are returned if this argument is set as \code{NULL} (default). The Alafia River basin includes values in the \code{area} column of \code{fibdata} as \code{"Alafia River"} and \code{"Alafia River Tributary"}.  The Hillsborough River basin includes values in the \code{area} column of \code{fibdat} as \code{"Hillsborough River"}, \code{"Hillsborough River Tributary"}, \code{"Lake Thonotosassa"}, \code{"Lake Thonotosassa Tributary"}, and \code{"Lake Roberta"}.  Not all areas may be present based on the selection.  All valid options for \code{areasel} include \code{"Alafia River"}, \code{"Hillsborough River"}, \code{"Big Bend"}, \code{"Cockroach Bay"}, \code{"East Lake Outfall"}, \code{"Hillsborough Bay"}, \code{"Little Manatee"}, \code{"Lower Tampa Bay"}, \code{"McKay Bay"}, \code{"Middle Tampa Bay"}, \code{"Old Tampa Bay"}, \code{"Palm River"}, \code{"Tampa Bypass Canal"}, or \code{"Valrico Lake"}.
+#' The \code{areasel} argument can indicate valid entries in the \code{area} column of \code{fibdata}.  For example, use either \code{"Alafia River"} or \code{"Hillsborough River"} for the corresponding river basins, where rows in  \code{fibdata} are filtered based on the the selection.  All stations are returned if this argument is set as \code{NULL} (default). The Alafia River basin includes values in the \code{area} column of \code{fibdata} as \code{"Alafia River"} and \code{"Alafia River Tributary"}.  The Hillsborough River basin includes values in the \code{area} column of \code{fibdat} as \code{"Hillsborough River"}, \code{"Hillsborough River Tributary"}, \code{"Lake Thonotosassa"}, \code{"Lake Thonotosassa Tributary"}, and \code{"Lake Roberta"}.  Not all areas may be present based on the selection.  All valid options for \code{areasel} include \code{"Alafia River"}, \code{"Hillsborough River"}, \code{"Big Bend"}, \code{"Cockroach Bay"}, \code{"East Lake Outfall"}, \code{"Hillsborough Bay"}, \code{"Little Manatee"}, \code{"Lower Tampa Bay"}, \code{"McKay Bay"}, \code{"Middle Tampa Bay"}, \code{"Old Tampa Bay"}, \code{"Palm River"}, \code{"Tampa Bypass Canal"}, or \code{"Valrico Lake"}. One to any of the options can be used.
 #'
 #' @return A \code{data.frame} similar to \code{fibdata} with additional columns describing station categories and optionally filtered by arguments passed to the function
 #'

R/anlz_fibwetdry.R

@@ -50,7 +50,8 @@ anlz_fibwetdry <- function(fibdata,
   # use threshold to show wet or dry
   out <- dplyr::left_join(fibdata, prcp_calcd,
                    by = c("station", "date")) %>%
-    dplyr::mutate(wet_sample = rain_total >= wet_threshold)
+    dplyr::mutate(wet_sample = rain_total >= wet_threshold) %>%
+    tibble::tibble()
 
   return(out)
 

R/show_enteromap.R

@@ -17,14 +17,17 @@
 #' # wet/dry samples
 #' show_enteromap(enterodata, yrsel = 2020, mosel = 9, wetdry = TRUE,
 #'                temporal_window = 2, wet_threshold = 0.5)
-show_enteromap <- function(fibdata, yrsel, mosel, wetdry = FALSE,
+#'
+#' # Old Tampa Bay only
+#' show_enteromap(enterodata, yrsel = 2020, mosel = 9, areasel = "Old Tampa Bay")
+show_enteromap <- function(fibdata, yrsel, mosel, areasel = NULL, wetdry = FALSE,
                            precipdata = NULL, temporal_window = NULL,
                            wet_threshold = NULL){
 
   # get categories
-  fibmap <- anlz_enteromap(fibdata, yrsel = yrsel, mosel = mosel, wetdry = wetdry,
-                           precipdata = precipdata, temporal_window = temporal_window,
-                           wet_threshold = wet_threshold)
+  fibmap <- anlz_enteromap(fibdata, yrsel = yrsel, mosel = mosel, areasel = areasel,
+                           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
@@ -115,8 +118,6 @@ show_enteromap <- function(fibdata, yrsel, mosel, wetdry = FALSE,
     grep('ecoli', ., value = T) %>%
     paste(collapse = '<br/>') %>%
     paste0('<b>All samples</b><br/>#/100mL<br/>', .)
-  title <- paste0('<b><em>Enterococcus</em><br/>', yrsel, '-', mosel, '</b')
-
 
   # create map
   out <- util_map(tomap) %>%
@@ -126,8 +127,7 @@ show_enteromap <- function(fibdata, yrsel, mosel, wetdry = FALSE,
       lat = ~Latitude,
       icon = ~icons[as.numeric(grp)],
       label = ~lapply(as.list(lab), util_html)
-    ) %>%
-    leaflet::addControl(html = title, position = 'topright')
+    )
 
   # add appropriate legends
   if(wetdry == TRUE){
@@ -139,8 +139,6 @@ show_enteromap <- function(fibdata, yrsel, mosel, wetdry = FALSE,
       leaflet::addControl(html = ecocciallleg, position = 'topright')
   }
 
-
-
   return(out)
 
 }

tests/testthat/test-anlz_enteromap.R

@@ -1,17 +1,17 @@
 # These tests are copied and lightly modified from test-anlz_fibmap.R
 
-# Test case 1: Check if the output has the expected columns
+# Check if the output has the expected columns
 test_that("Output has the expected columns for anlz_enteromap", {
 
   result <- anlz_enteromap(enterodata)
-  expected_columns <- c("station", "yr", "mo",
+  expected_columns <- c("station", "long_name", "yr", "mo",
                         "Latitude", "Longitude", "ecocci",
                         "cat", "col", "ind", "indnm", "conc")
   expect_equal(colnames(result), expected_columns)
 
 })
 
-# Test case 2: Check if filtering by year works correctly
+# Check if filtering by year works correctly
 test_that("Filtering by year works correctly for anlz_enteromap", {
 
   result <- anlz_enteromap(enterodata, yrsel = 2020)
@@ -20,7 +20,7 @@ test_that("Filtering by year works correctly for anlz_enteromap", {
 
 })
 
-# Test case 3: Check if filtering by month works correctly
+# Check if filtering by month works correctly
 test_that("Filtering by month works correctly for anlz_enteromap", {
 
   result <- anlz_enteromap(enterodata, mosel = 7)
@@ -29,7 +29,16 @@ test_that("Filtering by month works correctly for anlz_enteromap", {
 
 })
 
-# Test case 4: Check error no data
+# Check if filtering by area works correctly
+test_that("Filtering by area works correctly for anlz_enteromap", {
+
+  result <- anlz_enteromap(enterodata, areasel = 'Old Tampa Bay', mosel = 7)
+  expected_area <- 'Old Tampa Bay'
+  expect_equal(unique(result$long_name), expected_area)
+
+})
+
+# Check error no data
 test_that("Checking error for no data with anlz_enteromap", {
 
   expect_error(anlz_enteromap(enterodata, yrsel = 1900, mosel = 5))