Dev

NAMESPACE

@@ -6,13 +6,12 @@ export(create_coldpool_extent)
 export(create_coldpool_index)
 export(create_coldpool_persistence)
 export(create_gsi)
+export(create_mrip_trips)
 export(create_prop_sp_trips)
-export(create_rec_trips)
 export(create_spatial_indicator)
 export(create_sst)
 export(create_template)
-export(create_total_rec_catch)
-export(create_total_rec_landings)
+export(create_total_mrip)
 export(create_wcr)
 export(esp_csv_to_nc)
 export(find_files)
@@ -21,12 +20,10 @@ export(format_indicator)
 export(format_tbl_data)
 export(get_mrip_catch)
 export(get_mrip_trips)
-export(get_trip_files)
 export(nc_to_raster)
 export(plot_condition)
 export(plot_risk)
 export(plt_indicator)
-export(read_rec_catch)
 export(rpt_card_table)
 export(save_catch)
 export(save_trips)

R/create_condition_indicator.R

@@ -1,71 +1,93 @@
-
-
 #' Create species condition indicator
 #'
-#' This function calculates species condition from a survdat data pull. 
+#' This function calculates species condition from a survdat data pull.
 #' Methods derived from Laurel Smith (https://github.com/Laurels1/Condition/blob/master/R/RelConditionEPU.R)
-#' 
-#' @param data data table. NEFSC survey data generated by 'survdat::get_survdat_data(channel, getBio = T, getLengths = T)'
-#' @param LWparams L-W parameters from Wigley et al. 2003 from NEesp2::LWparams
-#' @param species.codes data table. Species codes and names from NEesp2::species.codes 
+#'
+#' @param data data table. NEFSC survey data generated by 'survdat::get_survdat_data(channel, getBio = TRUE, getLengths = TRUE)'
+#' @param LWparams data table. L-W parameters. Default is from Wigley et al. 2003 from NEesp2::LWparams. Alternative parameters could be used, as long as they were formatted the same as the Wigley parameters.
+#' @param species.codes data table. Species codes (SVSPP) and common names from NEesp2::species.codes
+#' @param by_EPU logical. If TRUE, calculates condition by EPUs specified in the input data, if FALSE, calculates condition for all data combined.
+#' @param by_sex logical. If TRUE, calculates condition by sex. If FALSE, calculates condition across sexes.
+#' @param length_break numeric vector. If not NULL, will calculate condition by length breaks specified in the vector. User must specify minimum and maximum lengths in this parameter, e.g., c(0, 20, 70). If NULL, will not calculate by length groupings.
+#' @param output character. If "soe", returns a data frame of species condition for the State of the Ecosystem report. If "esp", returns a data frame for ESPs. If "full", returns a data frame of all calculated values. *Setting by_sex = TRUE or length_break to any value will always return a full dataframe*
 #' @importFrom magrittr %>%
-#' @return Returns R object `condition`, a data frame of species condition by EPU with scale.
+#' @return Returns a data frame of species condition
 #' @export
 
-species_condition <- function(data, 
-                               LWparams = NEesp2::LWparams, 
-                               species.codes = NEesp2::species.codes,
-                              by_EPU = TRUE) {
+species_condition <- function(data,
+                              LWparams = NEesp2::LWparams,
+                              species.codes = NEesp2::species.codes,
+                              by_EPU = TRUE,
+                              by_sex = FALSE,
+                              length_break = NULL,
+                              output = "soe") {
+  if (by_sex |
+    !is.null(length_break)) {
+    if (output != "full") {
+      message("You asked to group results by sex and/or length ; data will not be formatted for SOE or ESP output.")
+    }
+    output <- "full"
+  }
+
+  # add 0 to length_break if needed
+  if (!0 %in% length_break & !is.null(length_break)) {
+    length_break <- c(0, length_break)
+  }
 
-  if(by_EPU) {
-    survey.data <- data %>% 
+  if (by_EPU) {
+    survey.data <- data %>%
       dplyr::left_join(NEesp2::strata_epu_key)
   } else {
     survey.data <- data |>
       dplyr::mutate(EPU = "UNIT")
   }
 
-
-  #Change sex = NA to sex = 0
-  fall <- survey.data %>% 
-    dplyr::filter(SEASON == 'FALL') %>% 
-    dplyr::mutate(sex = dplyr::if_else(is.na(SEX), '0', as.character(SEX)))
-
+  # Change sex = NA to sex = 0
+  fall <- survey.data %>%
+    dplyr::filter(SEASON == "FALL") %>%
+    dplyr::mutate(sex = dplyr::if_else(is.na(SEX), "0", as.character(SEX)))
+
   # filter LWparams to fall only, add in male/female if data is "combined"
-  LWfall <- LWparams %>% 
-    dplyr::filter(SEASON == 'FALL')
-  
+  LWfall <- LWparams %>%
+    dplyr::filter(SEASON == "FALL")
+
   add_sexes <- LWfall |>
     dplyr::group_by(SpeciesName) |>
     dplyr::mutate(count = dplyr::n()) |>
     dplyr::filter(count == 1) |>
     dplyr::ungroup() |>
     dplyr::select(-Gender) |>
-    dplyr::full_join(tibble::tibble(count = 1,
-                                    Gender = c("Male", "Female")),
-                     relationship = "many-to-many") |>
+    dplyr::full_join(
+      tibble::tibble(
+        count = 1,
+        Gender = c("Male", "Female")
+      ),
+      relationship = "many-to-many"
+    ) |>
     dplyr::select(-count)
-  
+
   new_dat <- dplyr::bind_rows(LWfall, add_sexes) |>
     dplyr::arrange(SpeciesName)
-  
-  #Add SEX for Combined gender back into Wigley at all data (loses 4 Gender==Unsexed):
+
+  # Add SEX for Combined gender back into Wigley at all data (loses 4 Gender==Unsexed):
   LWpar_sexed <- new_dat |>
-    dplyr::mutate(sex = dplyr::case_when(Gender == "Combined" | Gender == "Unsexed" ~ as.character(0),
-                                         Gender == "Male" ~ as.character(1),
-                                         Gender == "Female" ~ as.character(2),
-                                         TRUE ~ NA))
-
-  LWpar_spp <- LWpar_sexed %>% 
+    dplyr::mutate(sex = dplyr::case_when(
+      Gender == "Combined" | Gender == "Unsexed" ~ as.character(0),
+      Gender == "Male" ~ as.character(1),
+      Gender == "Female" ~ as.character(2),
+      TRUE ~ NA
+    ))
+
+  LWpar_spp <- LWpar_sexed %>%
     dplyr::mutate(SVSPP = as.numeric(LW_SVSPP))
-  
-  #Join survdat data with LW data
-  mergedata <- dplyr::left_join(fall, LWpar_spp, by= c('SEASON', 'SVSPP', 'sex'))
-  
-  #filters out values without losing rows with NAs:
-  mergewt <- dplyr::filter(mergedata, is.na(INDWT) | INDWT<900)
-  mergewtno0 <- dplyr::filter(mergewt, is.na(INDWT) | INDWT>0.004)
-  mergelenno0 <- dplyr::filter(mergewtno0, is.na(LENGTH) | LENGTH>0)
+
+  # Join survdat data with LW data
+  mergedata <- dplyr::left_join(fall, LWpar_spp, by = c("SEASON", "SVSPP", "sex"))
+
+  # filters out values without losing rows with NAs:
+  mergewt <- dplyr::filter(mergedata, is.na(INDWT) | INDWT < 900)
+  mergewtno0 <- dplyr::filter(mergewt, is.na(INDWT) | INDWT > 0.004)
+  mergelenno0 <- dplyr::filter(mergewtno0, is.na(LENGTH) | LENGTH > 0)
   mergelen <- dplyr::filter(mergelenno0, !is.na(LENGTH))
   mergeindwt <- dplyr::filter(mergelen, !is.na(INDWT))
   mergeLW <- dplyr::filter(mergeindwt, !is.na(lna))
@@ -76,44 +98,81 @@ species_condition <- function(data,
   #                 !is.na(lna),
   #                 INDWT < 900 | INDWT > 0.004,
   #                 LENGTH > 0)
-  
+
   ###########################################
   ### Calculate species condition ###
-  
+
   condcalc <- dplyr::mutate(mergeLW,
-                            predwt = (exp(lna))*LENGTH^b,
-                            RelCond = INDWT/predwt) |>
-    dplyr::filter(is.na(RelCond) | RelCond<300) %>%
+    predwt = (exp(lna)) * LENGTH^b,
+    RelCond = INDWT / predwt
+  ) |>
+    dplyr::filter(is.na(RelCond) | RelCond < 300) %>%
     dplyr::group_by(SVSPP, SEX) %>%
-    dplyr:: mutate(mean = mean(RelCond), sd = sd(RelCond)) |>
+    dplyr::mutate(mean = mean(RelCond), sd = sd(RelCond)) |>
     dplyr::ungroup() |>
     # might want to update this outlier removal eventually
-    dplyr::filter(RelCond < (mean+(2*sd)) & RelCond > (mean-(2*sd))) |>
-    dplyr::filter(is.na(sex) | sex != 4) %>% 
+    dplyr::filter(RelCond < (mean + (2 * sd)) & RelCond > (mean - (2 * sd))) |>
+    dplyr::filter(is.na(sex) | sex != 4) %>%
     dplyr::mutate(sexMF = sex)
-
-  cond.epu <- dplyr::left_join(condcalc, species.codes, by= c('SVSPP'))
-
-  #Summarize annually by EPU 
-  condition <- cond.epu %>% 
-    dplyr::group_by(Species, EPU, YEAR) %>% 
-    dplyr::summarize(MeanCond = mean(RelCond), 
-                     nCond = dplyr::n()
+
+  cond.epu <- dplyr::left_join(condcalc, species.codes, by = c("SVSPP"))
+
+  # Summarize annually -- parameterized groupings
+  grouping_vars <- c("Species", "YEAR", "EPU")
+
+  if (by_sex) {
+    grouping_vars <- c(grouping_vars, "sexMF")
+  }
+
+  if (!is.null(length_break)) {
+    cond.epu <- cond.epu |>
+      dplyr::mutate(
+        length_group = cut(LENGTH, breaks = length_break, include.lowest = TRUE)
+      )
+    grouping_vars <- c(grouping_vars, "length_group")
+  }
+
+  grouped_condition <- cond.epu |>
+    dplyr::group_by(!!!rlang::syms(grouping_vars))
+
+  condition <- grouped_condition %>%
+    dplyr::summarize(
+      MeanCond = mean(RelCond),
+      nCond = dplyr::n()
     ) |>
     dplyr::ungroup() |>
-    dplyr::filter(nCond >= 3) %>% 
-    dplyr::add_count(Species, EPU) %>% 
-    dplyr::filter(n >= 20) %>% 
-    dplyr::select(Species, EPU, YEAR, MeanCond, nCond) %>%
-    dplyr::group_by(Species, EPU) |>
-    dplyr::mutate(sd = sd(MeanCond, na.rm = TRUE),
-                  variance = var(MeanCond, na.rm = TRUE),
-                  INDICATOR_NAME = "mean condition") %>%
-    dplyr::rename(DATA_VALUE = MeanCond) %>%
+    dplyr::filter(nCond >= 3) |>
+    # select columns
+    dplyr::select(dplyr::all_of(c(grouping_vars, "MeanCond", "nCond"))) |>
+    # group again, without YEAR
+    dplyr::group_by(!!!rlang::syms(grouping_vars[-which(grouping_vars == "YEAR")])) |>
+    # filter to only species with 20+ years of data
+    dplyr::mutate(n = dplyr::n()) |>
+    dplyr::filter(n >= 20) |>
+    dplyr::select(-n) |>
+    # calculate sd and variance across years
+    dplyr::mutate(
+      sd = sd(MeanCond, na.rm = TRUE),
+      variance = var(MeanCond, na.rm = TRUE),
+      INDICATOR_NAME = "mean condition"
+    ) %>%
+    # dplyr::rename(DATA_VALUE = MeanCond) %>%
     dplyr::ungroup()
-
+
+  # format for different outputs
+  if (output == "soe") {
+    condition <- condition |>
+      dplyr::select(YEAR, Species, EPU, MeanCond) |>
+      dplyr::rename(
+        Var = Species,
+        Time = YEAR,
+        Value = MeanCond
+      ) |>
+      dplyr::mutate(Units = "MeanCond")
+  } else if (output == "esp") {
+    condition <- condition |>
+      dplyr::select(Species, EPU, YEAR, MeanCond, INDICATOR_NAME) |>
+      dplyr::rename(DATA_VALUE = MeanCond)
+  }
   return(condition)
 }
-
-
-

R/create_netcdf.R

@@ -8,9 +8,32 @@
 #' @export
 
 esp_csv_to_nc <- function(
-  data,
-  fname
-) {
+    data,
+    fname) {
+  data <- data |>
+    dplyr::rename(creator_name = CONTACT) |> # rename for metadata requirements
+    dplyr::mutate(
+      long_name = INDICATOR_NAME,
+      title = paste(INTENDED_ESP_NAME, "ESP"),
+      Conventions = "CF-1.11, COARDS, ACDD-1.3",
+      Metadata_Conventions = "Unidata Dataset Discovery v1.0",
+      creator_email = "nefsc.esp.leads@noaa.gov",
+      creator_type = "person",
+      acknowledgements = "The data are sponsored by NOAA and may be freely distributed",
+      institution = "DOC | NOAA | National Marine Fisheries Service | Fisheries Northeast Fisheries Science Center",
+      program = "Ecosystem Dynamics and Assessment Branch",
+      publisher_type = "institution",
+      publisher_name = "Northeast Fisheries Science Center",
+      publisher_url = "https://www.fisheries.noaa.gov/about/northeast-fisheries-science-center",
+      publisher_email = "nefsc.erddap@noaa.gov",
+      contributor_name = "Ecosystem Dynamics and Assessment Branch",
+      contributor_type = "group",
+      contributor_url = "https://www.fisheries.noaa.gov/new-england-mid-atlantic/ecosystems/northeast-ecosystem-dynamics-and-assessment-our-research",
+      contributor_institution = "DOC | NOAA Fisheries | Northeast Fisheries Science Center",
+      naming_authority = "gov.noaa.nefsc",
+      license = "The data may be used and redistributed for free but is not intended for legal use, since it may contain inaccuracies.  Neither the data, contributor, NEFSC, NOAA, nor the United States Government, nor any of their employees or contractors, makes any warranty, expressed or implied, including warranties of marketability and fitness for a particular purpose, or assumes any legal liability for the accuracy, completeness, or usefulness of this information."
+    )
+
   var.index <- data |>
     dplyr::select(INDICATOR_NAME, UNITS) |>
     dplyr::distinct()
@@ -118,10 +141,9 @@ esp_csv_to_nc <- function(
 
 ## input data = long format indicator time series of all variables
 
-# data <- AKesp::get_esp_data("Black Sea Bass") |>
-#   dplyr::filter(INDICATOR_NAME != "BSB_Winter_Bottom_Temperature_North")
+# data <- AKesp::get_esp_data("Black Sea Bass")
 #
-# esp_csv_to_nc(data = data, fname = here::here("data-raw", "bsb_example3.nc"))
+# esp_csv_to_nc(data = data, fname = here::here("data-raw", paste0(Sys.Date(), "_bsb_example.nc")))
 
 # Check the contents of the NetCDF file