update benthic and sediment data with 2022 results

tbep-tech · Dec 14, 2023 · f11a9f7 · f11a9f7
1 parent edfd56c
commit f11a9f7
Show file tree

Hide file tree

Showing 41 changed files with 74 additions and 63 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: tbeptools
 Title: Data and Indicators for the Tampa Bay Estuary Program
-Version: 2.0.1.9014
-Date: 2023-12-06
+Version: 2.0.1.9015
+Date: 2023-12-14
 Authors@R: c(
     person(given = "Marcus",
       family = "Beck",

diff --git a/R/anlz_sedimentaddtot.R b/R/anlz_sedimentaddtot.R
@@ -14,7 +14,7 @@
 #'
 #' @examples
 #' anlz_sedimentaddtot(sedimentdata)
-anlz_sedimentaddtot <- function(sedimentdata, yrrng = c(1993, 2021), bay_segment = c('HB', 'OTB', 'MTB', 'LTB', 'TCB', 'MR', 'BCB'), funding_proj = 'TBEP', param = NULL, pelave = TRUE){
+anlz_sedimentaddtot <- function(sedimentdata, yrrng = c(1993, 2022), bay_segment = c('HB', 'OTB', 'MTB', 'LTB', 'TCB', 'MR', 'BCB'), funding_proj = 'TBEP', param = NULL, pelave = TRUE){
 
   # make yrrng two if only one year provided
   if(length(yrrng) == 1)

diff --git a/R/anlz_sedimentave.R b/R/anlz_sedimentave.R
@@ -19,7 +19,7 @@
 #'
 #' @examples
 #' anlz_sedimentave(sedimentdata, param = 'Arsenic')
-anlz_sedimentave <- function(sedimentdata, param, yrrng = c(1993, 2021), bay_segment = c('HB', 'OTB', 'MTB', 'LTB', 'TCB', 'MR', 'BCB'), funding_proj = 'TBEP'){
+anlz_sedimentave <- function(sedimentdata, param, yrrng = c(1993, 2022), bay_segment = c('HB', 'OTB', 'MTB', 'LTB', 'TCB', 'MR', 'BCB'), funding_proj = 'TBEP'){
 
   # add totals
   sedimentdata <- anlz_sedimentaddtot(sedimentdata, yrrng = yrrng, bay_segment = bay_segment,

diff --git a/R/anlz_sedimentpel.R b/R/anlz_sedimentpel.R
@@ -21,7 +21,7 @@
 #'
 #' @examples
 #' anlz_sedimentpel(sedimentdata)
-anlz_sedimentpel <- function(sedimentdata, yrrng = c(1993, 2021), bay_segment = c('HB', 'OTB', 'MTB', 'LTB', 'TCB', 'MR', 'BCB'), funding_proj = 'TBEP'){
+anlz_sedimentpel <- function(sedimentdata, yrrng = c(1993, 2022), bay_segment = c('HB', 'OTB', 'MTB', 'LTB', 'TCB', 'MR', 'BCB'), funding_proj = 'TBEP'){
 
   # combine all, take average, get grade
   out <- anlz_sedimentaddtot(sedimentdata, yrrng = yrrng, bay_segment = bay_segment, funding_proj = funding_proj, pelave = TRUE) %>%

diff --git a/R/anlz_sedimentpelave.R b/R/anlz_sedimentpelave.R
@@ -15,7 +15,7 @@
 #'
 #' @examples
 #' anlz_sedimentpelave(sedimentdata)
-anlz_sedimentpelave <- function(sedimentdata, yrrng = c(1993, 2021), bay_segment = c('HB', 'OTB', 'MTB', 'LTB', 'TCB', 'MR', 'BCB'), funding_proj = 'TBEP'){
+anlz_sedimentpelave <- function(sedimentdata, yrrng = c(1993, 2022), bay_segment = c('HB', 'OTB', 'MTB', 'LTB', 'TCB', 'MR', 'BCB'), funding_proj = 'TBEP'){
 
   levs <- c('HB', 'OTB', 'MTB', 'LTB', 'TCB', 'MR', 'BCB')
 

diff --git a/R/anlz_tbbimed.R b/R/anlz_tbbimed.R
@@ -20,7 +20,7 @@
 #' @examples
 #' tbbiscr <- anlz_tbbiscr(benthicdata)
 #' anlz_tbbimed(tbbiscr)
-anlz_tbbimed <- function(tbbiscr, bay_segment = c('HB', 'OTB', 'MTB', 'LTB', 'TCB', 'MR', 'BCB',  'All', 'All (wt)'), rev = FALSE, yrrng = c(1993, 2021)) {
+anlz_tbbimed <- function(tbbiscr, bay_segment = c('HB', 'OTB', 'MTB', 'LTB', 'TCB', 'MR', 'BCB',  'All', 'All (wt)'), rev = FALSE, yrrng = c(1993, 2022)) {
 
   # sanity checks
   stopifnot(length(yrrng) == 2)

diff --git a/R/benthicdata.R b/R/benthicdata.R
@@ -1,13 +1,15 @@
-#' Benthic data for the Tampa Bay Benthic Index current as of 12092022
+#' Benthic data for the Tampa Bay Benthic Index current as of 12142023
 #'
-#' Benthic data for the Tampa Bay Benthic Index current as of 12092022
+#' Benthic data for the Tampa Bay Benthic Index current as of 12142023
 #'
 #' @format A nested \code{\link[tibble]{tibble}} with 3 rows and 2 variables:
 #' \describe{
-#'   \item{name}{chr}
-#'   \item{value}{list}
+#'   \item{name}{chr identifying the dataset as stations, fieldsamples, or taxacounts}
+#'   \item{value}{list of dataframes for each dataset}
 #'   }
 #'
+#' @details Index the corresponding list element in the \code{value} column to view each dataset. For example, the stations data in the first row can be viewed as \code{benthicdata$value[[1]]}.
+#'
 #' @concept data
 #'
 #' @examples

diff --git a/R/read_formsediment.R b/R/read_formsediment.R
@@ -60,6 +60,8 @@ read_formsediment <- function(pathin){
       FundingProject = gsub('\\s+$', '', FundingProject),
       Replicate = tolower(Replicate),
       Units = gsub('Kg$', 'kg', Units),
+      PEL = as.numeric(gsub('^NULL$', NA, PEL)),
+      TEL = as.numeric(gsub('^NULL$', NA, TEL)),
       BetweenTELPEL = ifelse(`ValueAdjusted` > TEL & `ValueAdjusted` <= PEL & !grepl('U|T', Qualifier), 'Yes', 'No'),
       ExceedsPEL = ifelse(`ValueAdjusted` > PEL & !grepl('U|T', Qualifier), 'Yes', 'No'),
       PELRatio = `ValueAdjusted` / PEL

diff --git a/R/read_importbenthic.R b/R/read_importbenthic.R
@@ -4,11 +4,13 @@
 #' @param download_latest logical to download latest if a more recent dataset is available
 #' @param remove logical if the downloaded folder is removed after unzipping
 #'
-#' @return A nested \code{tibble} of station, taxa, and field sample data
+#' @return A nested \code{tibble} of station, taxa, and field sample data.
 #'
 #' @details
 #' This function downloads and unzips a folder of base tables used to calculate the benthic index from \url{https://epcbocc.sharepoint.com/:u:/s/Share/EQUCWBuwCNdGuMREYAyAD1gBKC98mYtCHMWX0FYLrbT4KA?e=nDfnnQ&download=1} (viewable at \url{https://epcbocc.sharepoint.com/:f:/s/Share/EtOJfziTTa9FliL1oROb9OsBRZU-nO60fu_0NRC162hHjQ?e=4gUXgJ}).
 #'
+#' Index the corresponding list element in the \code{value} column to view each dataset. For example, the stations data in the first row can be viewed as \code{benthicdata$value[[1]]}.
+#'
 #' @export
 #'
 #' @concept read

diff --git a/R/sedimentdata.R b/R/sedimentdata.R
@@ -1,6 +1,6 @@
-#' Sediment data for the Tampa Bay current as of 01062023
+#' Sediment data for the Tampa Bay current as of 12142023
 #'
-#' Sediment data for the Tampa Bay current as of 01062023
+#' Sediment data for the Tampa Bay current as of 12142023
 #'
 #' @format A \code{data.frame} with 216627 rows and 24 variables:
 #' \describe{

diff --git a/R/show_sedimentalratio.R b/R/show_sedimentalratio.R
@@ -28,7 +28,7 @@
 #'
 #' @examples
 #' show_sedimentalratio(sedimentdata, param = 'Arsenic')
-show_sedimentalratio <- function(sedimentdata, param, yrrng = c(1993, 2021), bay_segment = c('HB', 'OTB', 'MTB', 'LTB', 'TCB', 'MR', 'BCB'), funding_proj = 'TBEP', lnsz = 1, base_size = 12, plotly = FALSE, family = NA, width = NULL, height = NULL){
+show_sedimentalratio <- function(sedimentdata, param, yrrng = c(1993, 2022), bay_segment = c('HB', 'OTB', 'MTB', 'LTB', 'TCB', 'MR', 'BCB'), funding_proj = 'TBEP', lnsz = 1, base_size = 12, plotly = FALSE, family = NA, width = NULL, height = NULL){
 
   # check paramater is an available metal
   metals <- sedimentdata %>%

diff --git a/R/show_sedimentave.R b/R/show_sedimentave.R
@@ -20,7 +20,7 @@
 #'
 #' @examples
 #' show_sedimentave(sedimentdata, param = 'Arsenic')
-show_sedimentave <- function(sedimentdata, param, yrrng = c(1993, 2021), bay_segment = c('HB', 'OTB', 'MTB', 'LTB', 'TCB', 'MR', 'BCB'), funding_proj = 'TBEP', lnsz = 1, base_size = 12, plotly = FALSE, family = NA, width = NULL, height = NULL){
+show_sedimentave <- function(sedimentdata, param, yrrng = c(1993, 2022), bay_segment = c('HB', 'OTB', 'MTB', 'LTB', 'TCB', 'MR', 'BCB'), funding_proj = 'TBEP', lnsz = 1, base_size = 12, plotly = FALSE, family = NA, width = NULL, height = NULL){
 
   toplo <- anlz_sedimentave(sedimentdata, param = param, yrrng = yrrng, bay_segment = bay_segment, funding_proj = funding_proj)
 

diff --git a/R/show_sedimentmap.R b/R/show_sedimentmap.R
@@ -17,7 +17,7 @@
 #'
 #' @examples
 #' show_sedimentmap(sedimentdata, param = 'Arsenic')
-show_sedimentmap <- function(sedimentdata, param, yrrng = c(1993, 2021), funding_proj = 'TBEP', weight = 1.5){
+show_sedimentmap <- function(sedimentdata, param, yrrng = c(1993, 2022), funding_proj = 'TBEP', weight = 1.5){
 
   # add totals
   sedimentdata <- anlz_sedimentaddtot(sedimentdata, yrrng = yrrng, funding_proj = funding_proj, param = param, pelave = FALSE)

diff --git a/R/show_sedimentpelave.R b/R/show_sedimentpelave.R
@@ -22,7 +22,7 @@
 #'
 #' @examples
 #' show_sedimentpelave(sedimentdata)
-show_sedimentpelave <- function(sedimentdata, yrrng = c(1993, 2021), bay_segment = c('HB', 'OTB', 'MTB', 'LTB', 'TCB', 'MR', 'BCB'), funding_proj = 'TBEP', alph = 1, ylim = c(0, 0.4), lnsz = 1, base_size = 12, plotly = FALSE, family = NA, width = NULL, height = NULL){
+show_sedimentpelave <- function(sedimentdata, yrrng = c(1993, 2022), bay_segment = c('HB', 'OTB', 'MTB', 'LTB', 'TCB', 'MR', 'BCB'), funding_proj = 'TBEP', alph = 1, ylim = c(0, 0.4), lnsz = 1, base_size = 12, plotly = FALSE, family = NA, width = NULL, height = NULL){
 
   # get avg pel ratios by station, then get averages
   toplo <- anlz_sedimentpelave(sedimentdata, yrrng = yrrng, bay_segment = bay_segment, funding_proj = funding_proj)

diff --git a/R/show_sedimentpelmap.R b/R/show_sedimentpelmap.R
@@ -14,7 +14,7 @@
 #'
 #' @examples
 #' show_sedimentpelmap(sedimentdata)
-show_sedimentpelmap <- function(sedimentdata, yrrng = c(1993, 2021), bay_segment = c('HB', 'OTB', 'MTB', 'LTB', 'TCB', 'MR', 'BCB'), funding_proj = 'TBEP', weight = 1.5){
+show_sedimentpelmap <- function(sedimentdata, yrrng = c(1993, 2022), bay_segment = c('HB', 'OTB', 'MTB', 'LTB', 'TCB', 'MR', 'BCB'), funding_proj = 'TBEP', weight = 1.5){
 
   # map prep
   tomap <- anlz_sedimentpel(sedimentdata, yrrng = yrrng, bay_segment = bay_segment, funding_proj = funding_proj) %>%

diff --git a/R/show_tbbimatrix.R b/R/show_tbbimatrix.R
@@ -28,7 +28,7 @@
 #' tbbiscr <- anlz_tbbiscr(benthicdata)
 #' show_tbbimatrix(tbbiscr)
 show_tbbimatrix <- function(tbbiscr, bay_segment = c('HB', 'OTB', 'MTB', 'LTB', 'TCB', 'MR', 'BCB', 'All', 'All (wt)'),
-                            yrrng = c(1993, 2021), alph = 1, txtsz = 3, family = NA, rev = FALSE, position = 'top',
+                            yrrng = c(1993, 2022), alph = 1, txtsz = 3, family = NA, rev = FALSE, position = 'top',
                             plotly = FALSE, width = NULL, height = NULL){
 
   # annual average by segment

diff --git a/data/benthicdata.RData b/data/benthicdata.RData
diff --git a/data/sedimentdata.RData b/data/sedimentdata.RData
diff --git a/man/anlz_sedimentaddtot.Rd b/man/anlz_sedimentaddtot.Rd
diff --git a/man/anlz_sedimentave.Rd b/man/anlz_sedimentave.Rd
diff --git a/man/anlz_sedimentpel.Rd b/man/anlz_sedimentpel.Rd
diff --git a/man/anlz_sedimentpelave.Rd b/man/anlz_sedimentpelave.Rd
diff --git a/man/anlz_tbbimed.Rd b/man/anlz_tbbimed.Rd
diff --git a/man/benthicdata.Rd b/man/benthicdata.Rd
diff --git a/man/read_importbenthic.Rd b/man/read_importbenthic.Rd
diff --git a/man/sedimentdata.Rd b/man/sedimentdata.Rd
diff --git a/man/show_sedimentalratio.Rd b/man/show_sedimentalratio.Rd
diff --git a/man/show_sedimentave.Rd b/man/show_sedimentave.Rd
diff --git a/man/show_sedimentmap.Rd b/man/show_sedimentmap.Rd
diff --git a/man/show_sedimentpelave.Rd b/man/show_sedimentpelave.Rd
diff --git a/man/show_sedimentpelmap.Rd b/man/show_sedimentpelmap.Rd
diff --git a/man/show_tbbimatrix.Rd b/man/show_tbbimatrix.Rd
diff --git a/tests/testthat/test-anlz_sedimentave.R b/tests/testthat/test-anlz_sedimentave.R
@@ -1,4 +1,4 @@
 test_that("Checking anlz_sedimentave class", {
-  result <- anlz_sedimentave(sedimentdata, param = 'Arsenic', yrrng = 2021)
+  result <- anlz_sedimentave(sedimentdata, param = 'Arsenic', yrrng = 2022)
   expect_is(result, 'tbl_df')
 })
diff --git a/tests/testthat/test-anlz_sedimentpel.R b/tests/testthat/test-anlz_sedimentpel.R
@@ -1,4 +1,4 @@
 test_that("Checking anlz_sedimentpel class", {
-  result <- anlz_sedimentpel(sedimentdata, yrrng = 2021)
+  result <- anlz_sedimentpel(sedimentdata, yrrng = 2022)
   expect_is(result, 'tbl_df')
 })
diff --git a/tests/testthat/test-anlz_sedimentpelave.R b/tests/testthat/test-anlz_sedimentpelave.R
@@ -1,4 +1,4 @@
 test_that("Checking anlz_sedimentpelave class", {
-  result <- anlz_sedimentpelave(sedimentdata, yrrng = 2021)
+  result <- anlz_sedimentpelave(sedimentdata, yrrng = 2022)
   expect_is(result, 'tbl_df')
 })
diff --git a/tests/testthat/test-show_sedimentalratio.R b/tests/testthat/test-show_sedimentalratio.R
@@ -11,11 +11,11 @@ test_that("Checking show_sedimentalratio sanity checks", {
 
 
 test_that("Checking show_sedimentalratio class", {
-  result <- show_sedimentalratio(sedimentdata, param = 'Arsenic', yrrng = 2021)
+  result <- show_sedimentalratio(sedimentdata, param = 'Arsenic', yrrng = 2022)
   expect_is(result, 'ggplot')
 })
 
 test_that("Checking show_sedimentalratio plotly class", {
-  result <- show_sedimentalratio(sedimentdata, param = 'Arsenic', yrrng = 2021, plotly = T)
+  result <- show_sedimentalratio(sedimentdata, param = 'Arsenic', yrrng = 2022, plotly = T)
   expect_is(result, 'plotly')
 })
diff --git a/tests/testthat/test-show_sedimentave.R b/tests/testthat/test-show_sedimentave.R
@@ -1,9 +1,9 @@
 test_that("Checking show_sedimentave class", {
-  result <- show_sedimentave(sedimentdata, param = 'Arsenic', yrrng = 2021)
+  result <- show_sedimentave(sedimentdata, param = 'Arsenic', yrrng = 2022)
   expect_is(result, 'ggplot')
 })
 
 test_that("Checking show_sedimentave plotly class", {
-  result <- show_sedimentave(sedimentdata, param = 'Arsenic', yrrng = 2021, plotly = T)
+  result <- show_sedimentave(sedimentdata, param = 'Arsenic', yrrng = 2022, plotly = T)
   expect_is(result, 'plotly')
 })
diff --git a/tests/testthat/test-show_sedimentmap.R b/tests/testthat/test-show_sedimentmap.R
@@ -1,9 +1,9 @@
 test_that("Checking show_sedimentmap class", {
-  result <- show_sedimentmap(sedimentdata, param = 'Arsenic', yrrng = 2021)
+  result <- show_sedimentmap(sedimentdata, param = 'Arsenic', yrrng = 2022)
   expect_is(result, 'leaflet')
 })
 
 test_that("Checking show_sedimentmap class, no TEL/PEL", {
-  result <- expect_warning(show_sedimentmap(sedimentdata, param = 'Selenium', yrrng = 2021))
+  result <- expect_warning(show_sedimentmap(sedimentdata, param = 'Selenium', yrrng = 2022))
   expect_is(result, 'leaflet')
 })
diff --git a/tests/testthat/test-show_sedimentpelave.R b/tests/testthat/test-show_sedimentpelave.R
@@ -1,9 +1,9 @@
 test_that("Checking show_sedimentpelave class", {
-  result <- show_sedimentpelave(sedimentdata, yrrng = 2021)
+  result <- show_sedimentpelave(sedimentdata, yrrng = 2022)
   expect_is(result, 'ggplot')
 })
 
 test_that("Checking show_sedimentpelave plotly class", {
-  result <- show_sedimentpelave(sedimentdata, yrrng = 2021, plotly = T)
+  result <- show_sedimentpelave(sedimentdata, yrrng = 2022, plotly = T)
   expect_is(result, 'plotly')
 })
diff --git a/tests/testthat/test-show_sedimentpelmap.R b/tests/testthat/test-show_sedimentpelmap.R
@@ -1,4 +1,4 @@
 test_that("Checking show_sedimentpelmap class", {
-  result <- show_sedimentpelmap(sedimentdata, yrrng = 2021)
+  result <- show_sedimentpelmap(sedimentdata, yrrng = 2022)
   expect_is(result, 'leaflet')
 })