From 36a9a2283c45aab2bae8a8d75a26abf5340df389 Mon Sep 17 00:00:00 2001 From: sbreitbart-NOAA Date: Tue, 26 May 2026 17:00:34 -0400 Subject: [PATCH 01/11] Add key quantities to bnc caption; remove unnecessary 'year' arg from create_rda(); start "revamping" bnc table to match structure and formatting of landings tbl --- R/table_bnc.R | 251 ++++++++++++++---- R/utils_rda.R | 1 - inst/resources/captions_alt_text_template.csv | 2 +- 3 files changed, 199 insertions(+), 55 deletions(-) diff --git a/R/table_bnc.R b/R/table_bnc.R index 4de637a3..70c14c83 100644 --- a/R/table_bnc.R +++ b/R/table_bnc.R @@ -1,61 +1,206 @@ -# #' Biomass, abundance, and catch time series table -# #' -# #' @inheritParams plot_recruitment -# #' @param biomass_unit_label abbreviated units for biomass -# #' @param catch_unit_label abbreviated units for catch -# #' @param catch_unit_label abbreviated units for catch -# #' @param sb_unit_label abbreviated units for spawning biomass -# #' @param tables_dir The location of the folder containing the generated table -# #' rda files ("tables") that will be created if the argument `make_rda` = TRUE. -# #' Default is the working directory. -# #' -# #' @returns A table of biomass, abundance, catch, and spawning biomass through all years of -# #' the assessment model output translated to a standard structure. -# #' @details There are -# #' options to return a [gt::gt()] object or export an rda object containing -# #' a gt-based table, caption, and LaTeX-based table. -# #' @seealso [convert_output()], [filter_data()], [process_table()], [export_kqs()], [insert_kqs()], [create_rda()] -# #' @export -# #' -# #' @examples -# #' \dontrun{ -# #' table_bnc(dat) -# #' -# #' table_bnc(dat, -# #' end_year = 2024, -# #' biomass_unit_label = "b label", -# #' catch_unit_label = "catch label", -# #' make_rda = TRUE, -# #' tables_dir = getwd() -# #' ) -# #' } -# table_bnc <- function( -# dat, -# end_year = format(Sys.Date(), "%Y"), -# biomass_unit_label = "mt", -# catch_unit_label = "mt", -# sb_unit_label = "mt", -# make_rda = FALSE, -# tables_dir = getwd()) { +#' Biomass, abundance, and catch time series table +#' +#' @inheritParams plot_recruitment +#' @param biomass_unit_label Abbreviated units for biomass +#' Default: "mt" +#' +#' @param catch_unit_label Abbreviated units for catch +#' Default: "mt" +#' +#' @param sb_unit_label Abbreviated units for spawning biomass +#' Default: "mt" +#' +#' @param group A string of a single column that groups the data. +#' +#' Set group = "none" to summarize data over all indexing values. +#' +#' Default: NULL +#' Options: Including, but not limited to: "year", "area", "fleet", "sex", "none", NULL +#' @param method A string describing the method of summarizing data when group +#' is set to "none". +#' +#' Default: "sum" +#' +#' Options: "sum" or "mean" +#' +#' @param label The label that will be chosen from the input file. If unspecified, +#' the function will search the "label" column and use the first matching label +#' in this ordered list: "landings_weight", "landings_numbers", "landings_expected", +#' "landings_predicted", "landings". +#' +#' Default: NULL +#' +#' @param tables_dir The location of the folder containing the table +#' rda files ("tables") that will be created if the argument `make_rda` = TRUE. +#' Default: the working directory (`getwd()`) +#' +#' @returns A table of biomass, abundance, catch, and spawning biomass. +#' @details There are +#' options to return a [gt::gt()] object or export an rda object containing +#' a gt-based table, caption, and LaTeX-based table. +#' @seealso [convert_output()], [filter_data()], [process_table()], [export_kqs()], [insert_kqs()], [create_rda()] +#' @export +#' +#' @examples +#' table_bnc(stockplotr::example_data) +#' +#' table_bnc(stockplotr::example_data, +#' biomass_unit_label = "b label", +#' catch_unit_label = "catch label" +#' ) +table_bnc <- function( + dat, + biomass_unit_label = "mt", + catch_unit_label = "mt", + sb_unit_label = "mt", + era = NULL, + interactive = TRUE, + group = NULL, + method = "sum", + module = NULL, + label = NULL, + make_rda = FALSE, + tables_dir = getwd()) { + + # TODO: do group and facet need to be uncommented and updated? + # Filter data for landings + prepared_data <- filter_data( + dat = dat, + label_name = "bnc", + geom = "line", + era = era, + module = module, + scale_amount = 1, + interactive = interactive + ) |> + dplyr::mutate(estimate = round(as.numeric(estimate), digits = 0)) |> + dplyr::mutate(uncertainty = round(as.numeric(uncertainty), digits = 2)) + + # Add check if there is any data + if (nrow(prepared_data) == 0) { + cli::cli_abort("No bnc data found.") + } + + # get uncertainty label by model + uncert_lab <- prepared_data |> + dplyr::filter(!is.na(uncertainty_label)) |> + dplyr::group_by(model) |> + dplyr::reframe(unique_uncert = unique(uncertainty_label)) # changed to reframe -- may cause errors + uncert_lab <- stats::setNames(uncert_lab$unique_uncert, uncert_lab$model) + # if (length(unique(uncert_lab)) == 1) uncert_lab <- unique(uncert_lab) # might need this line + + # This needs to be adjusted when comparing different models and diff error + if (length(uncert_lab) > 1 & length(unique(uncert_lab)) == 1 | length(names(uncert_lab)) == 1) { # prepared_data$model + # cli::cli_alert_warning("More than one value for uncertainty exists: {uncert_lab}") + uncert_lab <- uncert_lab[[1]] + # cli::cli_alert_warning("The first value ({uncert_lab}) will be chosen.") + } + + if (is.na(uncert_lab)) uncert_lab <- "uncertainty" + + # get fleet names + # TODO: change from fleets to id_group AFTER the process data step and adjust throughout the table based on indexing + fleets <- unique(prepared_data$fleet) |> + # sort numerically even if fleets are 100% characters + stringr::str_sort(numeric = TRUE) + + # TODO: fix this so that fleet names aren't removed if, e.g., group = "fleet" + table_data_info <- process_table( + dat = prepared_data, + # group = group, + method = method, + label = label + ) + table_data <- table_data_info[[1]] + indexed_vars <- table_data_info[[2]] + id_col_vals <- table_data_info[[3]] + + # id_group_vals <- sapply(id_cols, function(x) unique(prepared_data[[x]]), simplify = FALSE) + # TODO: add check if there is a landings column for every error column -- if not remove the error (can keep landings) + + # merge error and landings columns and rename + df_list <- merge_error( + table_data, + uncert_lab, + fleets, + label = "landings", + unit_label + ) + + # transform dfs into tables + final <- lapply(df_list, function(df) { + df |> + gt::gt() |> + add_theme() + }) + + # export figure to rda if argument = T + if (make_rda == TRUE) { + if (length(df_list) == 1) { + # Obtain relevant key quantities for captions/alt text + bnc.b.units <- biomass_unit_label + bnc.catch.units <- catch_unit_label + bnc.sb.units <- sb_unit_label + + # calculate & export key quantities + export_kqs(bnc.b.units, + bnc.catch.units, + bnc.sb.units) + + # Add key quantities to captions/alt text + insert_kqs(bnc.b.units, + bnc.catch.units, + bnc.sb.units) + + create_rda( + object = final$label, + # get name of function and remove "table_" from it + topic_label = gsub("table_", "", as.character(sys.call()[[1]])), + fig_or_table = "table", + dat = dat, + dir = tables_dir, + scale_amount = 1, + unit_label = biomass_unit_label, + table_df = final + ) + } + } else { + cli::cli_alert_warning("Multiple tables cannot be exported at this time.") + cli::cli_alert_info("We are currently developing this feature.") + } + + # Send table(s) to viewer + if (!is.data.frame(table_data)) { + for (t in final) { + print(t) + } + # Return table list invisibly + return(invisible(final)) + } else { + # Return finished table (when only one table) + return(final) + } + + + + + + + + + + + + + + + + # biomass_label <- glue::glue("Biomass ({biomass_unit_label})") # catch_label <- glue::glue("Catch ({catch_unit_label})") # sb_label <- glue::glue("Spawning biomass ({sb_unit_label})") # TODO: Update documentation to match formatting of other functions, with # lines for Default and Options -# # create plot-specific variables to use throughout fxn for naming and IDing -# topic_label <- "bnc" - -# # identify output -# fig_or_table <- "table" - -# # check year isn't past end_year if not projections plot -# check_year( -# end_year = end_year, -# fig_or_table = fig_or_table, -# topic = topic_label -# ) - -# dat <- dplyr::filter(dat, year <= end_year) # biomass <- dat |> # dplyr::filter( diff --git a/R/utils_rda.R b/R/utils_rda.R index ecec6a45..01482c06 100644 --- a/R/utils_rda.R +++ b/R/utils_rda.R @@ -568,7 +568,6 @@ create_rda <- function( fig_or_table, # REQUIRED dat, # REQUIRED: only one dat file to base captions and alt text from dir = getwd(), - year = format(as.POSIXct(Sys.Date(), format = "%YYYY-%mm-%dd"), "%Y"), ref_line = "msy", scale_amount = 1, unit_label = "mt", diff --git a/inst/resources/captions_alt_text_template.csv b/inst/resources/captions_alt_text_template.csv index 0c61bb35..bc36c636 100644 --- a/inst/resources/captions_alt_text_template.csv +++ b/inst/resources/captions_alt_text_template.csv @@ -42,7 +42,7 @@ model.runs,table,"The base configuration and alternative sensitivity analysis co derived.quantities,table,Derived quantities calculated by the base configuration of the stock assessment model., est.params,table,Parameters used in the base stock assessment model and whether the parameter was estimated by the model or fixed (i.e. not allowed to be estimated or changed by the model). CVs for estimated models are provided., F.per.fleet.per.year,table,Partial fishing mortality estimates for each fleet in the assessment model., -bnc,table,"Historical biomass, spawning biomass, abundance, and catch time series estimated by the base configuration of the stock assessment model.", +bnc,table,"Historical biomass (bnc.b.units), spawning biomass (bnc.sb.units), abundance (numbers), and catch (bnc.catch.units) time series estimated by the base configuration of the stock assessment model.", naa,table,Historical population abundance (numbers) estimated by the base model for each age group., catchability,table,Catchability over time for fleet catchability.fleet., sensitivity.runs,table,"Forecasted catch, biomass, spawning biomass, recruitment, fishing mortality, and stock status as projected from the base model configuration.", From 920f66a076c3388001eacbb8084e1f096dbfbb7b Mon Sep 17 00:00:00 2001 From: sbreitbart-NOAA Date: Wed, 27 May 2026 12:13:19 -0400 Subject: [PATCH 02/11] Continue "revamping" bnc table to match structure and formatting of landings tbl; update documentation --- NAMESPACE | 1 + R/table_bnc.R | 182 ++++++++++++++++++++++++++-------------------- man/create_rda.Rd | 5 +- man/table_bnc.Rd | 108 +++++++++++++++++++++++++++ 4 files changed, 218 insertions(+), 78 deletions(-) create mode 100644 man/table_bnc.Rd diff --git a/NAMESPACE b/NAMESPACE index 687233f7..c16efa5f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -28,6 +28,7 @@ export(process_table) export(reference_line) export(save_all_plots) export(table_index) +export(table_bnc) export(table_landings) export(table_projections) export(table_total_catch) diff --git a/R/table_bnc.R b/R/table_bnc.R index 70c14c83..175ff425 100644 --- a/R/table_bnc.R +++ b/R/table_bnc.R @@ -62,49 +62,107 @@ table_bnc <- function( make_rda = FALSE, tables_dir = getwd()) { - # TODO: do group and facet need to be uncommented and updated? - # Filter data for landings - prepared_data <- filter_data( + biomass_label <- glue::glue("Biomass ({biomass_unit_label})") + catch_label <- glue::glue("Catch ({catch_unit_label})") + sb_label <- glue::glue("Spawning biomass ({sb_unit_label})") + + # Filter data for biomass + prepared_data_b <- filter_data( dat = dat, - label_name = "bnc", + label_name = "^biomass$", geom = "line", era = era, - module = module, + module = ifelse("TIME_SERIES" %in% dat$module_name, "TIME_SERIES", + ifelse("t.series" %in% dat$module_name, "t.series", NULL)), scale_amount = 1, interactive = interactive ) |> - dplyr::mutate(estimate = round(as.numeric(estimate), digits = 0)) |> - dplyr::mutate(uncertainty = round(as.numeric(uncertainty), digits = 2)) + dplyr::mutate(estimate = round(as.numeric(estimate), digits = 0), + uncertainty = round(as.numeric(uncertainty), digits = 2)) + + # Add check if there is any b data + if (nrow(prepared_data_b) == 0) { + cli::cli_abort("No biomass data found.") + } + + # Filter data for catch + labels <- c("catch$", "landings_observed") + prepared_data_catch <- purrr::map_df(labels, ~ { + filter_data( + dat = dat, + label_name = .x, + geom = "line", + era = era, + module = if ("TIME_SERIES" %in% dat$module_name) "TIME_SERIES" else + if ("t.series" %in% dat$module_name) "t.series" else NULL, + scale_amount = 1, + interactive = interactive + ) + }) |> + dplyr::mutate( + estimate = round(as.numeric(estimate), digits = 0), + uncertainty = round(as.numeric(uncertainty), digits = 2) + ) + + # Add check if there is any catch data + if (nrow(prepared_data_catch) == 0) { + cli::cli_abort("No catch data found.") + } + + # Filter data for abundance + labels <- c("mature_abundance", "^abundance") + prepared_data_abun <- purrr::map_df(labels, ~ { + filter_data( + dat = dat, + label_name = .x, + geom = "line", + era = era, + module = if ("TIME_SERIES" %in% dat$module_name) "TIME_SERIES" else + if ("t.series" %in% dat$module_name) "t.series" else NULL, + scale_amount = 1, + interactive = interactive + ) + }) |> + dplyr::mutate( + estimate = round(as.numeric(estimate), digits = 0), + uncertainty = round(as.numeric(uncertainty), digits = 2) + ) - # Add check if there is any data - if (nrow(prepared_data) == 0) { - cli::cli_abort("No bnc data found.") + # Add check if there is any abundance data + if (nrow(prepared_data_abun) == 0) { + cli::cli_abort("No abundance data found.") } - # get uncertainty label by model - uncert_lab <- prepared_data |> - dplyr::filter(!is.na(uncertainty_label)) |> - dplyr::group_by(model) |> - dplyr::reframe(unique_uncert = unique(uncertainty_label)) # changed to reframe -- may cause errors - uncert_lab <- stats::setNames(uncert_lab$unique_uncert, uncert_lab$model) - # if (length(unique(uncert_lab)) == 1) uncert_lab <- unique(uncert_lab) # might need this line + # Filter data for spawning biomass + # TODO: check if the label name shouldn't have carrot and dollar sign; for example data, this includes spawning_biomass and spawning_biomass_unfished + prepared_data_sb <- filter_data( + dat = dat, + label_name = "^spawning_biomass$", + geom = "line", + era = era, + module = ifelse("TIME_SERIES" %in% dat$module_name, "TIME_SERIES", + ifelse("t.series" %in% dat$module_name, "t.series", NULL)), + scale_amount = 1, + interactive = interactive + ) |> + dplyr::mutate(estimate = round(as.numeric(estimate), digits = 0)) |> + dplyr::mutate(uncertainty = round(as.numeric(uncertainty), digits = 2)) - # This needs to be adjusted when comparing different models and diff error - if (length(uncert_lab) > 1 & length(unique(uncert_lab)) == 1 | length(names(uncert_lab)) == 1) { # prepared_data$model - # cli::cli_alert_warning("More than one value for uncertainty exists: {uncert_lab}") - uncert_lab <- uncert_lab[[1]] - # cli::cli_alert_warning("The first value ({uncert_lab}) will be chosen.") + # Add check if there is any sb data + if (nrow(prepared_data_sb) == 0) { + cli::cli_abort("No spawning biomass data found.") } - if (is.na(uncert_lab)) uncert_lab <- "uncertainty" + prepared_data <- rbind(prepared_data_b, + prepared_data_catch, + prepared_data_abun, + prepared_data_sb) + + # TODO: Decide if uncertainty is necessary for this table + # it's not present for B or SB but is present for catch in example data - # get fleet names - # TODO: change from fleets to id_group AFTER the process data step and adjust throughout the table based on indexing - fleets <- unique(prepared_data$fleet) |> - # sort numerically even if fleets are 100% characters - stringr::str_sort(numeric = TRUE) + # TODO: check correct to not collect fleet names - # TODO: fix this so that fleet names aren't removed if, e.g., group = "fleet" table_data_info <- process_table( dat = prepared_data, # group = group, @@ -116,8 +174,7 @@ table_bnc <- function( id_col_vals <- table_data_info[[3]] # id_group_vals <- sapply(id_cols, function(x) unique(prepared_data[[x]]), simplify = FALSE) - # TODO: add check if there is a landings column for every error column -- if not remove the error (can keep landings) - + # merge error and landings columns and rename df_list <- merge_error( table_data, @@ -127,6 +184,22 @@ table_bnc <- function( unit_label ) + # # Bring together quantities for table + # bnc <- biomass |> + # dplyr::left_join(sb, by = "year") |> + # dplyr::left_join(abundance, by = "year") |> + # dplyr::left_join(catch, by = "year") |> + # dplyr::mutate(year = as.factor(year)) |> + # # apply table + # flextable::flextable() |> + # flextable::set_header_labels( + # year = "Year", + # biomass = biomass_label, + # abundance = "Abundance", + # total_catch = catch_label, + # spawning_biomass = sb_label + # ) + # transform dfs into tables final <- lapply(df_list, function(df) { df |> @@ -180,6 +253,7 @@ table_bnc <- function( # Return finished table (when only one table) return(final) } +} @@ -190,45 +264,8 @@ table_bnc <- function( - - - - - - -# biomass_label <- glue::glue("Biomass ({biomass_unit_label})") -# catch_label <- glue::glue("Catch ({catch_unit_label})") -# sb_label <- glue::glue("Spawning biomass ({sb_unit_label})") -# TODO: Update documentation to match formatting of other functions, with -# lines for Default and Options -# biomass <- dat |> -# dplyr::filter( -# # SS3 params -# label == "biomass", -# !is.na(year), -# module_name %in% c("TIME_SERIES", "t.series"), -# is.na(fleet), is.na(sex), is.na(area), is.na(growth_pattern), -# module_name != "DERIVED_QUANTITIES" -# ) |> -# dplyr::mutate(estimate = round(as.numeric(estimate), digits = 2)) |> -# dplyr::rename(biomass = estimate) |> -# dplyr::select(year, biomass) - -# if (length(unique(biomass$year)) != nrow(biomass)) { -# cli::cli_abort("Duplicate years found in biomass df.") -# } -# catch <- dat |> -# dplyr::filter( -# # SS3 params -# grepl("catch$", label) | grepl("landings_observed", label), -# !is.na(year), is.na(age), -# # module_name %in% c("TIME_SERIES","t.series"), -# # is.na(fleet), is.na(sex), is.na(area), is.na(growth_pattern), -# module_name != "DERIVED_QUANTITIES" -# ) |> -# dplyr::mutate(estimate = round(as.numeric(estimate), digits = 2)) # # Check if df is by age and summarize to time series # if (length(unique(catch$year)) == nrow(catch)) { # catch <- catch |> @@ -249,15 +286,6 @@ table_bnc <- function( # # } # } -# abundance <- dat |> -# dplyr::filter( -# # SS3 params -# grepl("mature_abundance", label) | grepl("^abundance", label), -# !is.na(year), -# module_name %in% c("TIME_SERIES", "t.series"), -# # is.na(fleet), is.na(sex), is.na(area), is.na(growth_pattern), -# module_name != "DERIVED_QUANTITIES" -# ) # # Check if there is more than one year aka the values are factored # # TODO: Review that sum is OK to use in these cases - otherwise what are # # the alternatives? diff --git a/man/create_rda.Rd b/man/create_rda.Rd index c1b70dec..4b95ee7c 100644 --- a/man/create_rda.Rd +++ b/man/create_rda.Rd @@ -10,7 +10,6 @@ create_rda( fig_or_table, dat, dir = getwd(), - year = format(as.POSIXct(Sys.Date(), format = "\%YYYY-\%mm-\%dd"), "\%Y"), ref_line = "msy", scale_amount = 1, unit_label = "mt", @@ -53,6 +52,10 @@ Default: "mt"} \item{table_df}{Data frame. The data frame that the table will be made into for purposes of exporting a latex formatted table.} + +\item{year}{Assessment year + +Default: the current year} } \value{ An rda package for a plot or table object. Requires an diff --git a/man/table_bnc.Rd b/man/table_bnc.Rd new file mode 100644 index 00000000..4d6c436b --- /dev/null +++ b/man/table_bnc.Rd @@ -0,0 +1,108 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/table_bnc.R +\name{table_bnc} +\alias{table_bnc} +\title{Biomass, abundance, and catch time series table} +\usage{ +table_bnc( + dat, + biomass_unit_label = "mt", + catch_unit_label = "mt", + sb_unit_label = "mt", + era = NULL, + interactive = TRUE, + group = NULL, + method = "sum", + module = NULL, + label = NULL, + make_rda = FALSE, + tables_dir = getwd() +) +} +\arguments{ +\item{dat}{A tibble or named list of tibbles (input as `list()`) +returned from \link[stockplotr]{convert_output}. + +If inputting a list of tibbles, the first tibble's reference point defined +in `ref_line` is used to plot a reference line or calculate relative spawning biomass.} + +\item{biomass_unit_label}{Abbreviated units for biomass +Default: "mt"} + +\item{catch_unit_label}{Abbreviated units for catch +Default: "mt"} + +\item{sb_unit_label}{Abbreviated units for spawning biomass +Default: "mt"} + +\item{era}{A string naming the era of data. + +Default: "time" + +Options: "early", "time", "fore" (forecast), or NULL (all data)} + +\item{interactive}{A logical value indicating if the environment is interactive. + +Default: `FALSE`} + +\item{group}{A string of a single column that groups the data. + +Set group = "none" to summarize data over all indexing values. + +Default: NULL +Options: Including, but not limited to: "year", "area", "fleet", "sex", "none", NULL} + +\item{method}{A string describing the method of summarizing data when group +is set to "none". + +Default: "sum" + +Options: "sum" or "mean"} + +\item{module}{(Optional) A string indicating the module_name found in `dat`. +If selecting >1 module, place them in a vector like c("module1", "module2"). + +Default: NULL + +If the interactive and >1 module_name is found, user will select the +module_name in the console. @seealso [filter_data()]} + +\item{label}{The label that will be chosen from the input file. If unspecified, +the function will search the "label" column and use the first matching label +in this ordered list: "landings_weight", "landings_numbers", "landings_expected", +"landings_predicted", "landings". + +Default: NULL} + +\item{make_rda}{A logical value indicating whether to save the object and +make an automated caption and alternative text in the form of an `rda` object. If TRUE, +the rda will be exported to the folder indicated in the argument "figures_dir". + +Default: `FALSE`.} + +\item{tables_dir}{The location of the folder containing the table +rda files ("tables") that will be created if the argument `make_rda` = TRUE. +Default: the working directory (`getwd()`)} +} +\value{ +A table of biomass, abundance, catch, and spawning biomass. +} +\description{ +Biomass, abundance, and catch time series table +} +\details{ +There are +options to return a [gt::gt()] object or export an rda object containing +a gt-based table, caption, and LaTeX-based table. +} +\examples{ +table_bnc(stockplotr::example_data) + +table_bnc(stockplotr::example_data, + biomass_unit_label = "b label", + catch_unit_label = "catch label" +) +} +\seealso{ +[convert_output()], [filter_data()], [process_table()], [export_kqs()], [insert_kqs()], [create_rda()] +} From fb429182b0d337cc734b458582e0befeebaa35f3 Mon Sep 17 00:00:00 2001 From: sbreitbart-NOAA Date: Thu, 11 Jun 2026 09:59:12 -0400 Subject: [PATCH 03/11] Add bnc table to save_all_plots() and its test; update bnc tests --- R/save_all_plots.R | 46 ++++----- tests/testthat/test-save_all_plots.R | 2 +- tests/testthat/test-table_bnc.R | 149 ++++++++++++++------------- 3 files changed, 101 insertions(+), 96 deletions(-) diff --git a/R/save_all_plots.R b/R/save_all_plots.R index 1045a7d9..6ac1d35c 100644 --- a/R/save_all_plots.R +++ b/R/save_all_plots.R @@ -469,29 +469,29 @@ save_all_plots <- function( ) # tables - # tryCatch( - # { - # cli::cli_h2("table_bnc") - # table_bnc( - # dat, - # biomass_unit_label, - # catch_unit_label, - # spawning_biomass_label, - # make_rda = TRUE, - # tables_dir = figures_tables_dir - # ) # |> - # # suppressWarnings() |> - # # invisible() - # }, - # error = function(e) { - # cli::cli_alert_danger("table_bnc failed to run.") - # cli::cli_alert("Tip: check that your arguments are correct.") - # cli::cli_li("biomass_unit_label = {biomass_unit_label}") - # cli::cli_li("catch_unit_label = {catch_unit_label}") - # cli::cli_li("spawning_biomass_label = {spawning_biomass_label}") - # print(e) - # } - # ) + tryCatch( + { + cli::cli_h2("table_bnc") + table_bnc( + dat, + biomass_unit_label, + catch_unit_label, + spawning_biomass_label, + make_rda = TRUE, + tables_dir = figures_tables_dir + ) # |> + # suppressWarnings() |> + # invisible() + }, + error = function(e) { + cli::cli_alert_danger("table_bnc failed to run.") + cli::cli_alert("Tip: check that your arguments are correct.") + cli::cli_li("biomass_unit_label = {biomass_unit_label}") + cli::cli_li("catch_unit_label = {catch_unit_label}") + cli::cli_li("spawning_biomass_label = {spawning_biomass_label}") + print(e) + } + ) tryCatch( { diff --git a/tests/testthat/test-save_all_plots.R b/tests/testthat/test-save_all_plots.R index ea508bcb..4ada9243 100644 --- a/tests/testthat/test-save_all_plots.R +++ b/tests/testthat/test-save_all_plots.R @@ -37,7 +37,7 @@ test_that("save_all_plots works when all figures/tables are plotted", { # expect that the tables are all created with expected names tab_base_temp_files <- c( - # "bnc_table.rda", + "bnc_table.rda", # "total_catch_table.rda", # comment out bc as is this needs to be interactive to select correct module "index_table.rda", "landings_table.rda", diff --git a/tests/testthat/test-table_bnc.R b/tests/testthat/test-table_bnc.R index b0831892..ac89e1d6 100644 --- a/tests/testthat/test-table_bnc.R +++ b/tests/testthat/test-table_bnc.R @@ -1,74 +1,79 @@ -# test_that("table_bnc generates plots without errors", { -# # expect error-free plot with minimal arguments -# expect_no_error( -# stockplotr::table_bnc(stockplotr::example_data, -# end_year = 2022 -# ) -# ) +test_that("table_bnc generates plots without errors", { + # expect error-free plot with minimal arguments + expect_no_error( + table_bnc( + stockplotr::example_data, + interactive = FALSE + ) + ) + + # expect error-free plot with many arguments + expect_no_error( + table_bnc( + dat = stockplotr::example_data, + biomass_unit_label = "mt", + catch_unit_label = "mt", + sb_unit_label = "mt", + era = "fore", + interactive = FALSE, + # group = NULL, + # method = "sum", + # module = NULL, + # label = NULL, + make_rda = FALSE, + tables_dir = getwd() + ) + ) + + + # expect gt object is returned + # adjust this test to work for multiple output tables + # expect_s3_class( + # table_bnc( + # dat = stockplotr::example_data, + # unit_label = "mt", + # era = NULL, + # interactive = FALSE, + # module = "CATCH", + # make_rda = FALSE, + # tables_dir = getwd() + # ), + # "gt_tbl" + # ) +}) -# # expect error-free plot with many arguments -# expect_no_error( -# stockplotr::table_bnc( -# stockplotr::example_data, -# end_year = 2025, -# biomass_unit_label = "mt", -# catch_unit_label = "mt", -# sb_unit_label = "mt", -# make_rda = FALSE, -# tables_dir = getwd() -# ) -# ) +test_that("rda file made when indicated", { + # export rda + table_bnc( + dat = stockplotr::example_data, + unit_label = "mt", + interactive = FALSE, + make_rda = TRUE, + tables_dir = getwd() + ) + + # expect that both tables dir and the bnc_table.rda file exist + expect_true(dir.exists(fs::path(getwd(), "tables"))) + expect_true(file.exists(fs::path(getwd(), "tables", "bnc_table.rda"))) + + # erase temporary testing files + file.remove(fs::path(getwd(), "captions_alt_text.csv")) + file.remove(fs::path(getwd(), "key_quantities.csv")) + unlink(fs::path(getwd(), "tables"), recursive = T) +}) - -# # expect flextable object is returned -# expect_s3_class( -# stockplotr::table_bnc( -# stockplotr::example_data, -# end_year = 2025, -# biomass_unit_label = "mt", -# catch_unit_label = "mt", -# sb_unit_label = "mt", -# make_rda = FALSE, -# tables_dir = getwd() -# ), -# "flextable" -# ) -# }) - -# test_that("rda file made when indicated", { -# # export rda -# table_bnc( -# stockplotr::example_data, -# end_year = 2025, -# biomass_unit_label = "mt", -# catch_unit_label = "mt", -# sb_unit_label = "mt", -# make_rda = TRUE, -# tables_dir = getwd() -# ) - -# # expect that both tables dir and the bnc_table.rda file exist -# expect_true(dir.exists(fs::path(getwd(), "tables"))) -# expect_true(file.exists(fs::path(getwd(), "tables", "bnc_table.rda"))) - -# # erase temporary testing files -# file.remove(fs::path(getwd(), "captions_alt_text.csv")) -# file.remove(fs::path(getwd(), "key_quantities.csv")) - -# unlink(fs::path(getwd(), "tables"), recursive = T) -# }) - -# test_that("table_bnc generates error with future end_year", { -# # expect error -# expect_error( -# stockplotr::table_bnc( -# stockplotr::example_data, -# end_year = 2035, -# biomass_unit_label = "mt", -# catch_unit_label = "mt", -# sb_unit_label = "mt", -# make_rda = TRUE, -# tables_dir = getwd() -# ) -# ) -# }) +test_that("table_bnc generates error with incorrect module", { + # expect error + # Need to test this -- not exactly the right test/result + expect_error( + table_bnc( + dat = stockplotr::example_data, + unit_label = "mt", + era = NULL, + interactive = FALSE, + module = "SPR_SERIES", + make_rda = FALSE, + tables_dir = getwd() + ) + ) +}) From 07abe981e72be0c4425bf07b828ab2ad3f31d271 Mon Sep 17 00:00:00 2001 From: sbreitbart-NOAA Date: Fri, 11 Sep 2026 14:46:36 -0400 Subject: [PATCH 04/11] Troubleshoot failing bnc table pipeline --- R/process_data.R | 1 + R/table_bnc.R | 11 ++++++++--- 2 files changed, 9 insertions(+), 3 deletions(-) diff --git a/R/process_data.R b/R/process_data.R index f873b82d..21ac3bb7 100644 --- a/R/process_data.R +++ b/R/process_data.R @@ -397,6 +397,7 @@ process_table <- function( } else if (!is.null(id_group)) { if (length(id_group) > 1) { cli::cli_alert_warning("Data contains >1 indexing variable. Selecting {id_group[1]}.") + id_group <- id_group[1] } if (length(id_group) > 0 && any(is.na(dat[[id_group]]))) { dat <- dat |> diff --git a/R/table_bnc.R b/R/table_bnc.R index 175ff425..0776a17c 100644 --- a/R/table_bnc.R +++ b/R/table_bnc.R @@ -165,7 +165,7 @@ table_bnc <- function( table_data_info <- process_table( dat = prepared_data, - # group = group, + group = group, method = method, label = label ) @@ -173,6 +173,11 @@ table_bnc <- function( indexed_vars <- table_data_info[[2]] id_col_vals <- table_data_info[[3]] + # test if id_col_vals is a list of lists; then unnest it + if (is.list(id_col_vals) && length(id_col_vals) > 0 && purrr::every(id_col_vals, is.list)) { + id_col_vals <- unlist(id_col_vals$`1`) + } + # id_group_vals <- sapply(id_cols, function(x) unique(prepared_data[[x]]), simplify = FALSE) # merge error and landings columns and rename @@ -180,8 +185,8 @@ table_bnc <- function( table_data, uncert_lab, fleets, - label = "landings", - unit_label + # label = "landings", + unit_label = c("biomass", "catch", "abundance") ) # # Bring together quantities for table From 59e52819e2f80726b345be57166235e8640030c5 Mon Sep 17 00:00:00 2001 From: sbreitbart-NOAA Date: Wed, 23 Sep 2026 16:07:58 -0400 Subject: [PATCH 05/11] Update function as per coworking; change name from bnc to spelled-out version --- NAMESPACE | 2 +- R/save_all_plots.R | 8 +- R/table_biomass_abundance_catch.R | 189 +++++++++ R/table_bnc.R | 375 ------------------ man/create_rda.Rd | 6 +- ...nc.Rd => table_biomass_abundance_catch.Rd} | 35 +- tests/testthat/test-table_bnc.R | 14 +- 7 files changed, 221 insertions(+), 408 deletions(-) create mode 100644 R/table_biomass_abundance_catch.R delete mode 100644 R/table_bnc.R rename man/{table_bnc.Rd => table_biomass_abundance_catch.Rd} (74%) diff --git a/NAMESPACE b/NAMESPACE index c16efa5f..2bdb74bb 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -27,8 +27,8 @@ export(process_data) export(process_table) export(reference_line) export(save_all_plots) +export(table_biomass_abundance_catch) export(table_index) -export(table_bnc) export(table_landings) export(table_projections) export(table_total_catch) diff --git a/R/save_all_plots.R b/R/save_all_plots.R index 6ac1d35c..4e7ee2ef 100644 --- a/R/save_all_plots.R +++ b/R/save_all_plots.R @@ -164,7 +164,7 @@ save_all_plots <- function( # imported from plot_index index_unit_label = "", # imported from table_afsc_tier- add potential unique arguments after dev - # imported from table_bnc + # imported from table_biomass_abundance_catch biomass_unit_label = "mt", catch_unit_label = "mt", catch_scale_amount = 1, @@ -471,8 +471,8 @@ save_all_plots <- function( # tables tryCatch( { - cli::cli_h2("table_bnc") - table_bnc( + cli::cli_h2("table_biomass_abundance_catch") + table_biomass_abundance_catch( dat, biomass_unit_label, catch_unit_label, @@ -484,7 +484,7 @@ save_all_plots <- function( # invisible() }, error = function(e) { - cli::cli_alert_danger("table_bnc failed to run.") + cli::cli_alert_danger("table_biomass_abundance_catch failed to run.") cli::cli_alert("Tip: check that your arguments are correct.") cli::cli_li("biomass_unit_label = {biomass_unit_label}") cli::cli_li("catch_unit_label = {catch_unit_label}") diff --git a/R/table_biomass_abundance_catch.R b/R/table_biomass_abundance_catch.R new file mode 100644 index 00000000..79426549 --- /dev/null +++ b/R/table_biomass_abundance_catch.R @@ -0,0 +1,189 @@ +#' Biomass, abundance, and catch time series table +#' +#' @inheritParams plot_recruitment +#' @param biomass_unit_label Abbreviated units for biomass +#' Default: "mt" +#' +#' @param abundance_unit_label Abbreviated units for abundance +#' Default: "fish" +#' +#' +#' @param catch_unit_label Abbreviated units for catch +#' Default: "mt" +#' +#' @param group A string of a single column that groups the data. +#' +#' Set group = "none" to summarize data over all indexing values. +#' +#' Default: NULL +#' Options: Including, but not limited to: "year", "area", "fleet", "sex", "none", NULL +#' @param method A string describing the method of summarizing data when group +#' is set to "none". +#' +#' Default: "sum" +#' +#' Options: "sum" or "mean" +#' +#' @param label The label that will be chosen from the input file. If unspecified, +#' the function will search the "label" column and use the first matching label +#' in this ordered list: "landings_weight", "landings_numbers", "landings_expected", +#' "landings_predicted", "landings". +#' +#' Default: NULL +#' +#' @param tables_dir The location of the folder containing the table +#' rda files ("tables") that will be created if the argument `make_rda` = TRUE. +#' Default: the working directory (`getwd()`) +#' +#' @returns A table of biomass, abundance, catch, and spawning biomass. +#' @details There are +#' options to return a [gt::gt()] object or export an rda object containing +#' a gt-based table, caption, and LaTeX-based table. +#' @seealso [convert_output()], [filter_data()], [process_table()], [export_kqs()], [insert_kqs()], [create_rda()] +#' @export +#' +#' @examples +#' table_biomass_abundance_catch(stockplotr::example_data) +#' +#' TODO: UPDATE EXAMPLE WITH MODULE NAMES +#' table_biomass_abundance_catch(stockplotr::example_data, +#' biomass_unit_label = "b label", +#' catch_unit_label = "catch label", +#' module = c(), +#' interactive = FALSE +#' ) +table_biomass_abundance_catch <- function( + dat, + biomass_unit_label = "mt", + abundance_unit_label = "fish", + catch_unit_label = "mt", + era = NULL, + interactive = TRUE, + group = NULL, + method = "sum", + module = NULL, + label = NULL, + make_rda = FALSE, + tables_dir = getwd()) { + + named_vec <- c("^biomass$" = biomass_unit_label, + "catch$|landings_observed" = catch_unit_label, + "mature_abundance|^abundance" = abundance_unit_label) + + # Aiming for totals + # iterate through label_names + lab_list <- purrr::map( + names(named_vec), + function(x) { + cli::cli_alert_info(paste0("Processing ", x)) + filtered_data <- filter_data( + dat = dat |> + dplyr::filter(is.na(age), is.na(length_bins)), + label_name = x, + geom = "line", + era = "time", + module = module, + scale_amount = 1, + interactive = interactive + ) #|> + # dplyr::mutate(estimate = round(as.numeric(estimate), digits = 0)) |> + # dplyr::mutate(uncertainty = round(as.numeric(uncertainty), digits = 2)) + + uncertainty_label <- ifelse( + is.na(unique(filtered_data$uncertainty_label)), + "Uncertainty", + unique(filtered_data$uncertainty_label) + ) + + if (x == "catch$|landings_observed") { + extra_grouping <- check_grouping(filtered_data)[-grep("year|fleet", check_grouping(filtered_data))] + + filtered_data <- filtered_data |> + dplyr::summarise( + estimate = sum(as.numeric(estimate), na.rm = TRUE), + estimate_upper = mean(as.numeric(estimate_upper), na.rm = TRUE), + estimate_lower = mean(as.numeric(estimate_lower), na.rm = TRUE), + uncertainty_label = unique(uncertainty_label), + uncertainty = mean(uncertainty, na.rm = TRUE), + .by = c(year, model, label))# |> + # dplyr::ungroup() + } else { + extra_grouping <- check_grouping(filtered_data)[-grep("year", check_grouping(filtered_data))] + } + + if (length(extra_grouping) > 0) { + cli::cli_abort( + "Table not created due to {extra_grouping} variables in {x}." + ) + } + + # Add check if there is any data + if (nrow(filtered_data) == 0) { + cli::cli_abort("No {x} data found.") + } + + # process to reduce columns + processed_data <- process_table( + filtered_data, + digits = 2) + + data <- processed_data[[1]] + group <- processed_data[[2]] + + # merge data with uncertainty and unit labels + merge_error( + table_data = data, + id_col_vals = group, + unit_label = named_vec[grep(x, names(named_vec), fixed = TRUE)][[1]], + uncert_lab = uncertainty_label + )[[1]] + } + ) + + combine_data <- purrr::reduce( + purrr::compact(lab_list), + dplyr::full_join, + by = c("Year") + ) |> + gt::gt() + + final_table <- theme_table(combine_data) + + # export figure to rda if argument = T + if (make_rda == TRUE) { + if (length(df_list) == 1) { + # Obtain relevant key quantities for captions/alt text + bnc.b.units <- biomass_unit_label + bnc.catch.units <- catch_unit_label + bnc.sb.units <- sb_unit_label + + # calculate & export key quantities + export_kqs(bnc.b.units, + bnc.catch.units, + bnc.sb.units) + + # Add key quantities to captions/alt text + insert_kqs(bnc.b.units, + bnc.catch.units, + bnc.sb.units) + + create_rda( + object = final$label, + # get name of function and remove "table_" from it + topic_label = gsub("table_", "", as.character(sys.call()[[1]])), + fig_or_table = "table", + dat = dat, + dir = tables_dir, + scale_amount = 1, + unit_label = biomass_unit_label, + table_df = final + ) + } + } else { + cli::cli_alert_warning("Multiple tables cannot be exported at this time.") + cli::cli_alert_info("We are currently developing this feature.") + } + + final_table +} + \ No newline at end of file diff --git a/R/table_bnc.R b/R/table_bnc.R deleted file mode 100644 index 0776a17c..00000000 --- a/R/table_bnc.R +++ /dev/null @@ -1,375 +0,0 @@ -#' Biomass, abundance, and catch time series table -#' -#' @inheritParams plot_recruitment -#' @param biomass_unit_label Abbreviated units for biomass -#' Default: "mt" -#' -#' @param catch_unit_label Abbreviated units for catch -#' Default: "mt" -#' -#' @param sb_unit_label Abbreviated units for spawning biomass -#' Default: "mt" -#' -#' @param group A string of a single column that groups the data. -#' -#' Set group = "none" to summarize data over all indexing values. -#' -#' Default: NULL -#' Options: Including, but not limited to: "year", "area", "fleet", "sex", "none", NULL -#' @param method A string describing the method of summarizing data when group -#' is set to "none". -#' -#' Default: "sum" -#' -#' Options: "sum" or "mean" -#' -#' @param label The label that will be chosen from the input file. If unspecified, -#' the function will search the "label" column and use the first matching label -#' in this ordered list: "landings_weight", "landings_numbers", "landings_expected", -#' "landings_predicted", "landings". -#' -#' Default: NULL -#' -#' @param tables_dir The location of the folder containing the table -#' rda files ("tables") that will be created if the argument `make_rda` = TRUE. -#' Default: the working directory (`getwd()`) -#' -#' @returns A table of biomass, abundance, catch, and spawning biomass. -#' @details There are -#' options to return a [gt::gt()] object or export an rda object containing -#' a gt-based table, caption, and LaTeX-based table. -#' @seealso [convert_output()], [filter_data()], [process_table()], [export_kqs()], [insert_kqs()], [create_rda()] -#' @export -#' -#' @examples -#' table_bnc(stockplotr::example_data) -#' -#' table_bnc(stockplotr::example_data, -#' biomass_unit_label = "b label", -#' catch_unit_label = "catch label" -#' ) -table_bnc <- function( - dat, - biomass_unit_label = "mt", - catch_unit_label = "mt", - sb_unit_label = "mt", - era = NULL, - interactive = TRUE, - group = NULL, - method = "sum", - module = NULL, - label = NULL, - make_rda = FALSE, - tables_dir = getwd()) { - - biomass_label <- glue::glue("Biomass ({biomass_unit_label})") - catch_label <- glue::glue("Catch ({catch_unit_label})") - sb_label <- glue::glue("Spawning biomass ({sb_unit_label})") - - # Filter data for biomass - prepared_data_b <- filter_data( - dat = dat, - label_name = "^biomass$", - geom = "line", - era = era, - module = ifelse("TIME_SERIES" %in% dat$module_name, "TIME_SERIES", - ifelse("t.series" %in% dat$module_name, "t.series", NULL)), - scale_amount = 1, - interactive = interactive - ) |> - dplyr::mutate(estimate = round(as.numeric(estimate), digits = 0), - uncertainty = round(as.numeric(uncertainty), digits = 2)) - - # Add check if there is any b data - if (nrow(prepared_data_b) == 0) { - cli::cli_abort("No biomass data found.") - } - - # Filter data for catch - labels <- c("catch$", "landings_observed") - prepared_data_catch <- purrr::map_df(labels, ~ { - filter_data( - dat = dat, - label_name = .x, - geom = "line", - era = era, - module = if ("TIME_SERIES" %in% dat$module_name) "TIME_SERIES" else - if ("t.series" %in% dat$module_name) "t.series" else NULL, - scale_amount = 1, - interactive = interactive - ) - }) |> - dplyr::mutate( - estimate = round(as.numeric(estimate), digits = 0), - uncertainty = round(as.numeric(uncertainty), digits = 2) - ) - - # Add check if there is any catch data - if (nrow(prepared_data_catch) == 0) { - cli::cli_abort("No catch data found.") - } - - # Filter data for abundance - labels <- c("mature_abundance", "^abundance") - prepared_data_abun <- purrr::map_df(labels, ~ { - filter_data( - dat = dat, - label_name = .x, - geom = "line", - era = era, - module = if ("TIME_SERIES" %in% dat$module_name) "TIME_SERIES" else - if ("t.series" %in% dat$module_name) "t.series" else NULL, - scale_amount = 1, - interactive = interactive - ) - }) |> - dplyr::mutate( - estimate = round(as.numeric(estimate), digits = 0), - uncertainty = round(as.numeric(uncertainty), digits = 2) - ) - - # Add check if there is any abundance data - if (nrow(prepared_data_abun) == 0) { - cli::cli_abort("No abundance data found.") - } - - # Filter data for spawning biomass - # TODO: check if the label name shouldn't have carrot and dollar sign; for example data, this includes spawning_biomass and spawning_biomass_unfished - prepared_data_sb <- filter_data( - dat = dat, - label_name = "^spawning_biomass$", - geom = "line", - era = era, - module = ifelse("TIME_SERIES" %in% dat$module_name, "TIME_SERIES", - ifelse("t.series" %in% dat$module_name, "t.series", NULL)), - scale_amount = 1, - interactive = interactive - ) |> - dplyr::mutate(estimate = round(as.numeric(estimate), digits = 0)) |> - dplyr::mutate(uncertainty = round(as.numeric(uncertainty), digits = 2)) - - # Add check if there is any sb data - if (nrow(prepared_data_sb) == 0) { - cli::cli_abort("No spawning biomass data found.") - } - - prepared_data <- rbind(prepared_data_b, - prepared_data_catch, - prepared_data_abun, - prepared_data_sb) - - # TODO: Decide if uncertainty is necessary for this table - # it's not present for B or SB but is present for catch in example data - - # TODO: check correct to not collect fleet names - - table_data_info <- process_table( - dat = prepared_data, - group = group, - method = method, - label = label - ) - table_data <- table_data_info[[1]] - indexed_vars <- table_data_info[[2]] - id_col_vals <- table_data_info[[3]] - - # test if id_col_vals is a list of lists; then unnest it - if (is.list(id_col_vals) && length(id_col_vals) > 0 && purrr::every(id_col_vals, is.list)) { - id_col_vals <- unlist(id_col_vals$`1`) - } - - # id_group_vals <- sapply(id_cols, function(x) unique(prepared_data[[x]]), simplify = FALSE) - - # merge error and landings columns and rename - df_list <- merge_error( - table_data, - uncert_lab, - fleets, - # label = "landings", - unit_label = c("biomass", "catch", "abundance") - ) - - # # Bring together quantities for table - # bnc <- biomass |> - # dplyr::left_join(sb, by = "year") |> - # dplyr::left_join(abundance, by = "year") |> - # dplyr::left_join(catch, by = "year") |> - # dplyr::mutate(year = as.factor(year)) |> - # # apply table - # flextable::flextable() |> - # flextable::set_header_labels( - # year = "Year", - # biomass = biomass_label, - # abundance = "Abundance", - # total_catch = catch_label, - # spawning_biomass = sb_label - # ) - - # transform dfs into tables - final <- lapply(df_list, function(df) { - df |> - gt::gt() |> - add_theme() - }) - - # export figure to rda if argument = T - if (make_rda == TRUE) { - if (length(df_list) == 1) { - # Obtain relevant key quantities for captions/alt text - bnc.b.units <- biomass_unit_label - bnc.catch.units <- catch_unit_label - bnc.sb.units <- sb_unit_label - - # calculate & export key quantities - export_kqs(bnc.b.units, - bnc.catch.units, - bnc.sb.units) - - # Add key quantities to captions/alt text - insert_kqs(bnc.b.units, - bnc.catch.units, - bnc.sb.units) - - create_rda( - object = final$label, - # get name of function and remove "table_" from it - topic_label = gsub("table_", "", as.character(sys.call()[[1]])), - fig_or_table = "table", - dat = dat, - dir = tables_dir, - scale_amount = 1, - unit_label = biomass_unit_label, - table_df = final - ) - } - } else { - cli::cli_alert_warning("Multiple tables cannot be exported at this time.") - cli::cli_alert_info("We are currently developing this feature.") - } - - # Send table(s) to viewer - if (!is.data.frame(table_data)) { - for (t in final) { - print(t) - } - # Return table list invisibly - return(invisible(final)) - } else { - # Return finished table (when only one table) - return(final) - } -} - - - - - - - - - - - - -# # Check if df is by age and summarize to time series -# if (length(unique(catch$year)) == nrow(catch)) { -# catch <- catch |> -# dplyr::rename(total_catch = estimate) |> -# dplyr::select(year, total_catch) -# } else { -# catch <- catch |> -# # dplyr::filter(!is.na(estimate)) |> -# dplyr::group_by(year) |> # , fleet -# dplyr::summarise(total_catch = sum(estimate, na.rm = TRUE)) -# # if ("fleet" %in% colnames(catch)) { -# # catch <- catch |> -# # tidyr::pivot_wider( -# # id_cols = year, -# # names_from = fleet, -# # values_from = total_catch -# # ) -# # } -# } - -# # Check if there is more than one year aka the values are factored -# # TODO: Review that sum is OK to use in these cases - otherwise what are -# # the alternatives? -# if (length(unique(abundance$year) != nrow(abundance))) { -# abundance <- abundance |> -# dplyr::group_by(year) |> -# dplyr::summarise(estimate = sum(as.numeric(estimate))) -# } - -# abundance <- abundance |> -# dplyr::mutate(estimate = round(as.numeric(estimate), digits = 0)) |> -# dplyr::rename(abundance = estimate) |> -# dplyr::select(year, abundance) - -# # Checks -# if (length(unique(catch$year)) != nrow(catch)) cli::cli_alert_warning("[catch] dataframe needs review.") -# if (length(unique(biomass$year)) != nrow(biomass)) cli::cli_alert_warning("[biomass] dataframe needs review.") -# if (length(unique(abundance$year)) != nrow(abundance)) cli::cli_alert_warning("[abundance] dataframe needs review.") - -# sb <- dat |> -# dplyr::filter( -# label == "spawning_biomass", -# module_name %in% c("DERIVED_QUANTITIES", "t.series") -# ) |> -# dplyr::mutate( -# estimate = round(as.numeric(estimate), digits = 2) -# ) |> -# dplyr::rename(spawning_biomass = estimate) |> -# dplyr::select(year, spawning_biomass) - -# # Bring together quantities for table -# bnc <- biomass |> -# dplyr::left_join(sb, by = "year") |> -# dplyr::left_join(abundance, by = "year") |> -# dplyr::left_join(catch, by = "year") |> -# dplyr::mutate(year = as.factor(year)) |> -# # apply table -# flextable::flextable() |> -# flextable::set_header_labels( -# year = "Year", -# biomass = biomass_label, -# abundance = "Abundance", -# total_catch = catch_label, -# spawning_biomass = sb_label -# ) - -# # add theming to final table -# final <- suppressWarnings(theme_table(bnc)) - -# # export figure to rda if argument = T -# if (make_rda == TRUE) { -# # run write_captions.R if its output doesn't exist -# if (!file.exists( -# fs::path(getwd(), "captions_alt_text.csv") -# ) -# ) { -# stockplotr::write_captions( -# dat = dat, -# dir = tables_dir, -# year = NULL -# ) -# } - -# # extract this plot's caption and alt text -# caps_alttext <- extract_caps_alttext( -# topic_label = topic_label, -# fig_or_table = fig_or_table, -# dir = tables_dir -# ) -# -# export_rda( -# object = final, -# caps_alttext = caps_alttext, -# figures_tables_dir = tables_dir, -# # get name of function and remove "table_" from it -# topic_label = gsub("table_", "", tail(as.character(sys.call()[[1]]), n = 1)), -# fig_or_table = fig_or_table -# ) -# } -# # Return finished table -# final -# } diff --git a/man/create_rda.Rd b/man/create_rda.Rd index 4b95ee7c..62293a72 100644 --- a/man/create_rda.Rd +++ b/man/create_rda.Rd @@ -30,10 +30,6 @@ alternative text for the object} Default: the working directory (`getwd()`)} -\item{year}{Number. Assessment year - -Default: the current year} - \item{ref_line}{String. Reference line value Default: "msy" @@ -53,7 +49,7 @@ Default: "mt"} \item{table_df}{Data frame. The data frame that the table will be made into for purposes of exporting a latex formatted table.} -\item{year}{Assessment year +\item{year}{Number. Assessment year Default: the current year} } diff --git a/man/table_bnc.Rd b/man/table_biomass_abundance_catch.Rd similarity index 74% rename from man/table_bnc.Rd rename to man/table_biomass_abundance_catch.Rd index 4d6c436b..e8ca422d 100644 --- a/man/table_bnc.Rd +++ b/man/table_biomass_abundance_catch.Rd @@ -1,14 +1,14 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/table_bnc.R -\name{table_bnc} -\alias{table_bnc} +% Please edit documentation in R/table_biomass_abundance_catch.R +\name{table_biomass_abundance_catch} +\alias{table_biomass_abundance_catch} \title{Biomass, abundance, and catch time series table} \usage{ -table_bnc( +table_biomass_abundance_catch( dat, biomass_unit_label = "mt", + abundance_unit_label = "fish", catch_unit_label = "mt", - sb_unit_label = "mt", era = NULL, interactive = TRUE, group = NULL, @@ -20,7 +20,7 @@ table_bnc( ) } \arguments{ -\item{dat}{A tibble or named list of tibbles (input as `list()`) +\item{dat}{Data frame or list. A tibble or named list of tibbles (input as `list()`) returned from \link[stockplotr]{convert_output}. If inputting a list of tibbles, the first tibble's reference point defined @@ -29,19 +29,19 @@ in `ref_line` is used to plot a reference line or calculate relative spawning bi \item{biomass_unit_label}{Abbreviated units for biomass Default: "mt"} -\item{catch_unit_label}{Abbreviated units for catch -Default: "mt"} +\item{abundance_unit_label}{Abbreviated units for abundance +Default: "fish"} -\item{sb_unit_label}{Abbreviated units for spawning biomass +\item{catch_unit_label}{Abbreviated units for catch Default: "mt"} -\item{era}{A string naming the era of data. +\item{era}{String. Era of data. Default: "time" Options: "early", "time", "fore" (forecast), or NULL (all data)} -\item{interactive}{A logical value indicating if the environment is interactive. +\item{interactive}{Logical. TRUE/FALSE; indicate whether the environment is interactive. Default: `FALSE`} @@ -59,7 +59,7 @@ Default: "sum" Options: "sum" or "mean"} -\item{module}{(Optional) A string indicating the module_name found in `dat`. +\item{module}{Character vector. (Optional) Module name found in `dat$module_name`. If selecting >1 module, place them in a vector like c("module1", "module2"). Default: NULL @@ -74,7 +74,7 @@ in this ordered list: "landings_weight", "landings_numbers", "landings_expected Default: NULL} -\item{make_rda}{A logical value indicating whether to save the object and +\item{make_rda}{Logical. TRUE/FALSE; indicate whether to save the object and make an automated caption and alternative text in the form of an `rda` object. If TRUE, the rda will be exported to the folder indicated in the argument "figures_dir". @@ -96,11 +96,14 @@ options to return a [gt::gt()] object or export an rda object containing a gt-based table, caption, and LaTeX-based table. } \examples{ -table_bnc(stockplotr::example_data) +table_biomass_abundance_catch(stockplotr::example_data) -table_bnc(stockplotr::example_data, +TODO: UPDATE EXAMPLE WITH MODULE NAMES +table_biomass_abundance_catch(stockplotr::example_data, biomass_unit_label = "b label", - catch_unit_label = "catch label" + catch_unit_label = "catch label", + module = c(), + interactive = FALSE ) } \seealso{ diff --git a/tests/testthat/test-table_bnc.R b/tests/testthat/test-table_bnc.R index ac89e1d6..6eb5d71b 100644 --- a/tests/testthat/test-table_bnc.R +++ b/tests/testthat/test-table_bnc.R @@ -1,7 +1,7 @@ -test_that("table_bnc generates plots without errors", { +test_that("table_biomass_abundance_catch generates plots without errors", { # expect error-free plot with minimal arguments expect_no_error( - table_bnc( + table_biomass_abundance_catch( stockplotr::example_data, interactive = FALSE ) @@ -9,7 +9,7 @@ test_that("table_bnc generates plots without errors", { # expect error-free plot with many arguments expect_no_error( - table_bnc( + table_biomass_abundance_catch( dat = stockplotr::example_data, biomass_unit_label = "mt", catch_unit_label = "mt", @@ -29,7 +29,7 @@ test_that("table_bnc generates plots without errors", { # expect gt object is returned # adjust this test to work for multiple output tables # expect_s3_class( - # table_bnc( + # table_biomass_abundance_catch( # dat = stockplotr::example_data, # unit_label = "mt", # era = NULL, @@ -44,7 +44,7 @@ test_that("table_bnc generates plots without errors", { test_that("rda file made when indicated", { # export rda - table_bnc( + table_biomass_abundance_catch( dat = stockplotr::example_data, unit_label = "mt", interactive = FALSE, @@ -62,11 +62,11 @@ test_that("rda file made when indicated", { unlink(fs::path(getwd(), "tables"), recursive = T) }) -test_that("table_bnc generates error with incorrect module", { +test_that("table_biomass_abundance_catch generates error with incorrect module", { # expect error # Need to test this -- not exactly the right test/result expect_error( - table_bnc( + table_biomass_abundance_catch( dat = stockplotr::example_data, unit_label = "mt", era = NULL, From 46152cddfcc924bac8652d15c7369736415f142a Mon Sep 17 00:00:00 2001 From: sbreitbart-NOAA Date: Thu, 24 Sep 2026 12:07:37 -0400 Subject: [PATCH 06/11] Update rda-exporting portion of bnc table function --- R/table_biomass_abundance_catch.R | 38 +++++++++++++------------------ 1 file changed, 16 insertions(+), 22 deletions(-) diff --git a/R/table_biomass_abundance_catch.R b/R/table_biomass_abundance_catch.R index 79426549..6b5f06bc 100644 --- a/R/table_biomass_abundance_catch.R +++ b/R/table_biomass_abundance_catch.R @@ -45,11 +45,10 @@ #' @examples #' table_biomass_abundance_catch(stockplotr::example_data) #' -#' TODO: UPDATE EXAMPLE WITH MODULE NAMES #' table_biomass_abundance_catch(stockplotr::example_data, #' biomass_unit_label = "b label", #' catch_unit_label = "catch label", -#' module = c(), +#' module = c("TIME_SERIES", "CATCH", "TIME_SERIES"), #' interactive = FALSE #' ) table_biomass_abundance_catch <- function( @@ -68,8 +67,9 @@ table_biomass_abundance_catch <- function( named_vec <- c("^biomass$" = biomass_unit_label, "catch$|landings_observed" = catch_unit_label, - "mature_abundance|^abundance" = abundance_unit_label) - + # "mature_abundance|^abundance" = abundance_unit_label) + "^abundance" = abundance_unit_label) + # Aiming for totals # iterate through label_names lab_list <- purrr::map( @@ -151,39 +151,33 @@ table_biomass_abundance_catch <- function( # export figure to rda if argument = T if (make_rda == TRUE) { - if (length(df_list) == 1) { # Obtain relevant key quantities for captions/alt text - bnc.b.units <- biomass_unit_label - bnc.catch.units <- catch_unit_label - bnc.sb.units <- sb_unit_label + biomass_abundance_catch.b.units <- biomass_unit_label + biomass_abundance_catch.catch.units <- catch_unit_label + biomass_abundance_catch.abundance.units <- abundance_unit_label # calculate & export key quantities - export_kqs(bnc.b.units, - bnc.catch.units, - bnc.sb.units) + export_kqs(biomass_abundance_catch.b.units, + biomass_abundance_catch.catch.units, + biomass_abundance_catch.abundance.units) # Add key quantities to captions/alt text - insert_kqs(bnc.b.units, - bnc.catch.units, - bnc.sb.units) + insert_kqs(biomass_abundance_catch.b.units, + biomass_abundance_catch.catch.units, + biomass_abundance_catch.abundance.units) create_rda( - object = final$label, + object = final_table, # get name of function and remove "table_" from it topic_label = gsub("table_", "", as.character(sys.call()[[1]])), fig_or_table = "table", dat = dat, dir = tables_dir, scale_amount = 1, - unit_label = biomass_unit_label, - table_df = final + table_df = final_table ) } - } else { - cli::cli_alert_warning("Multiple tables cannot be exported at this time.") - cli::cli_alert_info("We are currently developing this feature.") - } final_table } - \ No newline at end of file + From d77a8cc87389da100125fda7256082842a3d1360 Mon Sep 17 00:00:00 2001 From: sbreitbart-NOAA Date: Thu, 24 Sep 2026 12:20:09 -0400 Subject: [PATCH 07/11] Update alt text/captions/kqs templates with bnc table values --- inst/resources/captions_alt_text_template.csv | 2 +- inst/resources/key_quantity_template.csv | 3 +++ 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/inst/resources/captions_alt_text_template.csv b/inst/resources/captions_alt_text_template.csv index bc36c636..60b4d5e3 100644 --- a/inst/resources/captions_alt_text_template.csv +++ b/inst/resources/captions_alt_text_template.csv @@ -42,7 +42,7 @@ model.runs,table,"The base configuration and alternative sensitivity analysis co derived.quantities,table,Derived quantities calculated by the base configuration of the stock assessment model., est.params,table,Parameters used in the base stock assessment model and whether the parameter was estimated by the model or fixed (i.e. not allowed to be estimated or changed by the model). CVs for estimated models are provided., F.per.fleet.per.year,table,Partial fishing mortality estimates for each fleet in the assessment model., -bnc,table,"Historical biomass (bnc.b.units), spawning biomass (bnc.sb.units), abundance (numbers), and catch (bnc.catch.units) time series estimated by the base configuration of the stock assessment model.", +biomass_abundance_catch,table,"Historical biomass (biomass_abundance_catch.b.units), abundance (biomass_abundance_catch.abundance.units), and catch (biomass_abundance_catch.catch.units) time series estimated by the base configuration of the stock assessment model.", naa,table,Historical population abundance (numbers) estimated by the base model for each age group., catchability,table,Catchability over time for fleet catchability.fleet., sensitivity.runs,table,"Forecasted catch, biomass, spawning biomass, recruitment, fishing mortality, and stock status as projected from the base model configuration.", diff --git a/inst/resources/key_quantity_template.csv b/inst/resources/key_quantity_template.csv index 540c4f91..f4b234f8 100644 --- a/inst/resources/key_quantity_template.csv +++ b/inst/resources/key_quantity_template.csv @@ -14,6 +14,9 @@ Bend,,biomass at the end of the time series,,,, B.msy,,biomass at maximum sustainable yield,,,, B.msy.max,,upper estimate of the biomass at maximum sustainable yield of the 95th percentile confidence interval,,,, B.msy.min,,lower estimate of the biomass at maximum sustainable yield of the 95th percentile confidence interval,,,, +biomass_abundance_catch.abundance.units,, units of abundance measurement for biomass/abundance/catch table,,,, +biomass_abundance_catch.b.units,, units of biomass measurement for biomass/abundance/catch table,,,, +biomass_abundance_catch.catch.units,, units of catch measurement for biomass/abundance/catch table,,,, Btarg,,target biomass reference point,,,, caa.age.max,,maximum age in catch-at-age data,,,, caa.age.min,,minimum age in catch-at-age data,,,, From d2acc8c2457d2ac95b81a7e998735cbfefcc8fb2 Mon Sep 17 00:00:00 2001 From: sbreitbart-NOAA Date: Thu, 24 Sep 2026 12:21:00 -0400 Subject: [PATCH 08/11] Remove unused unit_label as arg from create_rda(); update documentation --- R/plot_abundance_at_age.R | 3 +-- R/plot_biomass.R | 3 +-- R/plot_biomass_at_age.R | 3 +-- R/plot_catch_comp.R | 3 +-- R/plot_discard.R | 3 +-- R/plot_fishing_mortality.R | 3 +-- R/plot_index.R | 3 +-- R/plot_landings.R | 3 +-- R/plot_recruitment.R | 3 +-- R/plot_recruitment_deviations.R | 3 +-- R/plot_selectivity.R | 3 +-- R/plot_spawning_biomass.R | 3 +-- R/plot_stock_recruitment.R | 3 +-- R/process_data.R | 3 +++ R/save_all_plots.R | 3 +-- R/table_index.R | 1 - R/table_landings.R | 1 - R/table_projections.R | 1 - R/table_total_catch.R | 1 - R/utils_rda.R | 9 ++------- man/create_rda.Rd | 5 ----- man/export_rda.Rd | 2 +- man/extract_caps_alttext.Rd | 2 +- man/table_biomass_abundance_catch.Rd | 3 +-- 24 files changed, 22 insertions(+), 48 deletions(-) diff --git a/R/plot_abundance_at_age.R b/R/plot_abundance_at_age.R index e4a71e8a..ce389084 100644 --- a/R/plot_abundance_at_age.R +++ b/R/plot_abundance_at_age.R @@ -182,8 +182,7 @@ plot_abundance_at_age <- function( # get name of function and remove "plot_" from it topic_label = gsub("plot_", "", utils::tail(as.character(sys.call()[[1]]), n = 1)), fig_or_table = "figure", - dat, - unit_label = "mt" + dat ) } plot diff --git a/R/plot_biomass.R b/R/plot_biomass.R index a985a51c..724649ed 100644 --- a/R/plot_biomass.R +++ b/R/plot_biomass.R @@ -322,8 +322,7 @@ plot_biomass <- function( dat = rp_dat, dir = figures_dir, ref_line = ifelse(!is.null(names(ref_line)), names(ref_line), ref_line), - scale_amount = scale_amount, - unit_label = unit_label + scale_amount = scale_amount ) } # Output final plot diff --git a/R/plot_biomass_at_age.R b/R/plot_biomass_at_age.R index 5bf85d4a..b216fef5 100644 --- a/R/plot_biomass_at_age.R +++ b/R/plot_biomass_at_age.R @@ -146,8 +146,7 @@ plot_biomass_at_age <- function( # get name of function and remove "plot_" from it topic_label = gsub("plot_", "", utils::tail(as.character(sys.call()[[1]]), n = 1)), fig_or_table = "figure", - dat, - unit_label = "mt" + dat ) } plot diff --git a/R/plot_catch_comp.R b/R/plot_catch_comp.R index 4902c0f6..a2f617a4 100644 --- a/R/plot_catch_comp.R +++ b/R/plot_catch_comp.R @@ -170,8 +170,7 @@ plot_catch_comp <- function( # get name of function and remove "plot_" from it topic_label = gsub("plot_", "", utils::tail(as.character(sys.call()[[1]]), n = 1)), fig_or_table = "figure", - dat, - unit_label = "mt" + dat ) } plot diff --git a/R/plot_discard.R b/R/plot_discard.R index 96332b46..efde6518 100644 --- a/R/plot_discard.R +++ b/R/plot_discard.R @@ -147,8 +147,7 @@ plot_discard <- function( fig_or_table = "figure", dat = discards, dir = figures_dir, - scale_amount = scale_amount, - unit_label = unit_label + scale_amount = scale_amount ) } # Output final plot diff --git a/R/plot_fishing_mortality.R b/R/plot_fishing_mortality.R index 0ed6e39c..bf67a4e2 100644 --- a/R/plot_fishing_mortality.R +++ b/R/plot_fishing_mortality.R @@ -195,8 +195,7 @@ plot_fishing_mortality <- function( dat = dat, dir = figures_dir, ref_line = ifelse(!is.null(names(ref_line)), names(ref_line), ref_line), - scale_amount = 1, - unit_label = "" # no unit for F + scale_amount = 1 ) } # Output final plot diff --git a/R/plot_index.R b/R/plot_index.R index 5fe91cf9..99fd2624 100644 --- a/R/plot_index.R +++ b/R/plot_index.R @@ -162,8 +162,7 @@ plot_index <- function( topic_label = gsub("plot_", "", utils::tail(as.character(sys.call()[[1]]), n = 1)), fig_or_table = "figure", dat = dat, - dir = figures_dir, - unit_label = unit_label + dir = figures_dir ) } # Output final plot diff --git a/R/plot_landings.R b/R/plot_landings.R index 88b7e33c..6c50cbac 100644 --- a/R/plot_landings.R +++ b/R/plot_landings.R @@ -143,8 +143,7 @@ plot_landings <- function( fig_or_table = "figure", dat = dat, dir = figures_dir, - scale_amount = scale_amount, - unit_label = unit_label + scale_amount = scale_amount ) } # Output final plot diff --git a/R/plot_recruitment.R b/R/plot_recruitment.R index f0597c6f..0f52b045 100644 --- a/R/plot_recruitment.R +++ b/R/plot_recruitment.R @@ -182,8 +182,7 @@ plot_recruitment <- function( topic_label = gsub("plot_", "", utils::tail(as.character(sys.call()[[1]]), n = 1)), fig_or_table = "figure", dat = dat, - dir = figures_dir # , - # unit_label = unit_label + dir = figures_dir ) } final diff --git a/R/plot_recruitment_deviations.R b/R/plot_recruitment_deviations.R index e297f4fa..9630cf92 100644 --- a/R/plot_recruitment_deviations.R +++ b/R/plot_recruitment_deviations.R @@ -112,8 +112,7 @@ plot_recruitment_deviations <- function( topic_label = gsub("plot_", "", utils::tail(as.character(sys.call()[[1]]), n = 1)), fig_or_table = "figure", dat = selected_dat, - dir = figures_dir, - unit_label = "" + dir = figures_dir ) } final diff --git a/R/plot_selectivity.R b/R/plot_selectivity.R index 3ed3b4ed..8c2d3a0c 100644 --- a/R/plot_selectivity.R +++ b/R/plot_selectivity.R @@ -179,8 +179,7 @@ plot_selectivity <- function( topic_label = gsub("plot_", "", utils::tail(as.character(sys.call()[[1]]), n = 1)), fig_or_table = "figure", dat = dat, - dir = figures_dir # , - # unit_label = unit_label + dir = figures_dir ) } final diff --git a/R/plot_spawning_biomass.R b/R/plot_spawning_biomass.R index 944279db..e079ca74 100644 --- a/R/plot_spawning_biomass.R +++ b/R/plot_spawning_biomass.R @@ -296,8 +296,7 @@ plot_spawning_biomass <- function( dat = rp_dat, dir = figures_dir, ref_line = ifelse(!is.null(names(ref_line)), names(ref_line), ref_line), - scale_amount = scale_amount, - unit_label = unit_label + scale_amount = scale_amount ) } # Output final plot diff --git a/R/plot_stock_recruitment.R b/R/plot_stock_recruitment.R index e22a0f4d..ffaaf3f8 100644 --- a/R/plot_stock_recruitment.R +++ b/R/plot_stock_recruitment.R @@ -217,8 +217,7 @@ plot_stock_recruitment <- function( topic_label = gsub("plot_", "", utils::tail(as.character(sys.call()[[1]]), n = 1)), fig_or_table = "figure", dat = dat, - dir = figures_dir # , - # unit_label = unit_label + dir = figures_dir ) } final + diff --git a/R/process_data.R b/R/process_data.R index 21ac3bb7..ad0c1b98 100644 --- a/R/process_data.R +++ b/R/process_data.R @@ -386,6 +386,9 @@ process_table <- function( id_group <- group } else { id_group <- index_variables[-grep("year|age|length_bin", index_variables)] + if (length(id_group) == 0) { + id_group <- NULL + } } cols <- index_variables[grep("year|age|length_bin", index_variables)] diff --git a/R/save_all_plots.R b/R/save_all_plots.R index 4e7ee2ef..595b1214 100644 --- a/R/save_all_plots.R +++ b/R/save_all_plots.R @@ -163,12 +163,11 @@ save_all_plots <- function( biomass_at_age_unit_label = "mt", # imported from plot_index index_unit_label = "", - # imported from table_afsc_tier- add potential unique arguments after dev # imported from table_biomass_abundance_catch biomass_unit_label = "mt", catch_unit_label = "mt", + # imported from plot_catch_comp catch_scale_amount = 1, - # imported from table_harvest_projection- add potential unique arguments after dev # imported from table_index- zero unique arguments # imported from table_landings- zero unique arguments # imported from table_projections diff --git a/R/table_index.R b/R/table_index.R index 747f41f8..12d11862 100644 --- a/R/table_index.R +++ b/R/table_index.R @@ -160,7 +160,6 @@ table_index <- function( dat = dat, dir = tables_dir, scale_amount = 1, - unit_label = unit_label, table_df = final ) } diff --git a/R/table_landings.R b/R/table_landings.R index 0b190fff..03816d03 100644 --- a/R/table_landings.R +++ b/R/table_landings.R @@ -162,7 +162,6 @@ table_landings <- function( dat = dat, dir = tables_dir, scale_amount = 1, - unit_label = unit_label, table_df = final ) } diff --git a/R/table_projections.R b/R/table_projections.R index a3816d8c..ceb407c0 100644 --- a/R/table_projections.R +++ b/R/table_projections.R @@ -116,7 +116,6 @@ table_projections <- function( dat = dat, dir = tables_dir, scale_amount = 1, - unit_label = unit_label, table_df = final_table$`_data` ) } diff --git a/R/table_total_catch.R b/R/table_total_catch.R index 25da792b..2c6fb6c6 100644 --- a/R/table_total_catch.R +++ b/R/table_total_catch.R @@ -181,7 +181,6 @@ table_total_catch <- function( dat = dat, dir = tables_dir, scale_amount = 1, - unit_label = unit_label, table_df = final ) diff --git a/R/utils_rda.R b/R/utils_rda.R index 01482c06..17e65178 100644 --- a/R/utils_rda.R +++ b/R/utils_rda.R @@ -541,10 +541,6 @@ insert_kqs <- function(...) { #' #' Default: 1 #' -#' @param unit_label String. Unit label for the y-axis -#' -#' Default: "mt" -#' #' @param table_df Data frame. The data frame that the table will be made into for purposes #' of exporting a latex formatted table. #' @@ -570,7 +566,6 @@ create_rda <- function( dir = getwd(), ref_line = "msy", scale_amount = 1, - unit_label = "mt", table_df = NULL ) { # extract this plot's caption and alt text @@ -863,7 +858,7 @@ create_rda <- function( #' ) #' #' extract_caps_alttext( -#' topic_label = "bnc", +#' topic_label = "biomass_abundance_catch", #' fig_or_table = "table", #' dir = getwd() #' ) @@ -957,7 +952,7 @@ extract_caps_alttext <- function(topic_label = NULL, #' final = final_table_object, #' caps_alttext = caps_alttext_object, #' figures_tables_dir = here::here(), -#' topic_label = "bnc", +#' topic_label = "biomass_abundance_catch", #' fig_or_table = "table", #' latex_table = "latex_table" #' ) diff --git a/man/create_rda.Rd b/man/create_rda.Rd index 62293a72..d94521c6 100644 --- a/man/create_rda.Rd +++ b/man/create_rda.Rd @@ -12,7 +12,6 @@ create_rda( dir = getwd(), ref_line = "msy", scale_amount = 1, - unit_label = "mt", table_df = NULL ) } @@ -42,10 +41,6 @@ from 500,000 --> 5,000. This scale will be reflected in the y axis label. Default: 1} -\item{unit_label}{String. Unit label for the y-axis - -Default: "mt"} - \item{table_df}{Data frame. The data frame that the table will be made into for purposes of exporting a latex formatted table.} diff --git a/man/export_rda.Rd b/man/export_rda.Rd index 3ca2d2e4..61643d69 100644 --- a/man/export_rda.Rd +++ b/man/export_rda.Rd @@ -61,7 +61,7 @@ export_rda( final = final_table_object, caps_alttext = caps_alttext_object, figures_tables_dir = here::here(), - topic_label = "bnc", + topic_label = "biomass_abundance_catch", fig_or_table = "table", latex_table = "latex_table" ) diff --git a/man/extract_caps_alttext.Rd b/man/extract_caps_alttext.Rd index 2ad7bd62..afe42269 100644 --- a/man/extract_caps_alttext.Rd +++ b/man/extract_caps_alttext.Rd @@ -37,7 +37,7 @@ extract_caps_alttext( ) extract_caps_alttext( - topic_label = "bnc", + topic_label = "biomass_abundance_catch", fig_or_table = "table", dir = getwd() ) diff --git a/man/table_biomass_abundance_catch.Rd b/man/table_biomass_abundance_catch.Rd index e8ca422d..0a5dccc1 100644 --- a/man/table_biomass_abundance_catch.Rd +++ b/man/table_biomass_abundance_catch.Rd @@ -98,11 +98,10 @@ a gt-based table, caption, and LaTeX-based table. \examples{ table_biomass_abundance_catch(stockplotr::example_data) -TODO: UPDATE EXAMPLE WITH MODULE NAMES table_biomass_abundance_catch(stockplotr::example_data, biomass_unit_label = "b label", catch_unit_label = "catch label", - module = c(), + module = c("TIME_SERIES", "CATCH", "TIME_SERIES"), interactive = FALSE ) } From 11c78e34998d228a4f34883ab4a1f52dec8a4955 Mon Sep 17 00:00:00 2001 From: sbreitbart-NOAA Date: Thu, 24 Sep 2026 13:52:07 -0400 Subject: [PATCH 09/11] Streamline bac table's unit label arguments --- R/table_biomass_abundance_catch.R | 40 +++++++++++++------------------ 1 file changed, 16 insertions(+), 24 deletions(-) diff --git a/R/table_biomass_abundance_catch.R b/R/table_biomass_abundance_catch.R index 6b5f06bc..ffe98fc9 100644 --- a/R/table_biomass_abundance_catch.R +++ b/R/table_biomass_abundance_catch.R @@ -1,15 +1,10 @@ #' Biomass, abundance, and catch time series table #' #' @inheritParams plot_recruitment -#' @param biomass_unit_label Abbreviated units for biomass -#' Default: "mt" #' -#' @param abundance_unit_label Abbreviated units for abundance -#' Default: "fish" -#' -#' -#' @param catch_unit_label Abbreviated units for catch -#' Default: "mt" +#' @param unit_label Character vector. Abbreviated unit label for each quantity +#' +#' Default: c("biomass" = "mt", "abundance" = "fish", "catch" = "mt") #' #' @param group A string of a single column that groups the data. #' @@ -17,6 +12,7 @@ #' #' Default: NULL #' Options: Including, but not limited to: "year", "area", "fleet", "sex", "none", NULL +#' #' @param method A string describing the method of summarizing data when group #' is set to "none". #' @@ -46,16 +42,13 @@ #' table_biomass_abundance_catch(stockplotr::example_data) #' #' table_biomass_abundance_catch(stockplotr::example_data, -#' biomass_unit_label = "b label", -#' catch_unit_label = "catch label", +#' unit_label = c("biomass" = "kg", "abundance" = "eggs", "catch" = "kg"), #' module = c("TIME_SERIES", "CATCH", "TIME_SERIES"), #' interactive = FALSE #' ) table_biomass_abundance_catch <- function( dat, - biomass_unit_label = "mt", - abundance_unit_label = "fish", - catch_unit_label = "mt", + unit_label = c("biomass" = "mt", "abundance" = "fish", "catch" = "mt"), era = NULL, interactive = TRUE, group = NULL, @@ -65,10 +58,9 @@ table_biomass_abundance_catch <- function( make_rda = FALSE, tables_dir = getwd()) { - named_vec <- c("^biomass$" = biomass_unit_label, - "catch$|landings_observed" = catch_unit_label, - # "mature_abundance|^abundance" = abundance_unit_label) - "^abundance" = abundance_unit_label) + named_vec <- c("^biomass$" = unit_label[[1]], + "^abundance" = unit_label[[2]], + "catch$|landings_observed" = unit_label[[3]]) # Aiming for totals # iterate through label_names @@ -152,19 +144,19 @@ table_biomass_abundance_catch <- function( # export figure to rda if argument = T if (make_rda == TRUE) { # Obtain relevant key quantities for captions/alt text - biomass_abundance_catch.b.units <- biomass_unit_label - biomass_abundance_catch.catch.units <- catch_unit_label - biomass_abundance_catch.abundance.units <- abundance_unit_label + biomass_abundance_catch.b.units <- unit_label[[1]] + biomass_abundance_catch.abundance.units <- unit_label[[2]] + biomass_abundance_catch.catch.units <- unit_label[[3]] # calculate & export key quantities export_kqs(biomass_abundance_catch.b.units, - biomass_abundance_catch.catch.units, - biomass_abundance_catch.abundance.units) + biomass_abundance_catch.abundance.units, + biomass_abundance_catch.catch.units) # Add key quantities to captions/alt text insert_kqs(biomass_abundance_catch.b.units, - biomass_abundance_catch.catch.units, - biomass_abundance_catch.abundance.units) + biomass_abundance_catch.abundance.units, + biomass_abundance_catch.catch.units) create_rda( object = final_table, From 4f7994773628ad390a63455030126e1088eeadcd Mon Sep 17 00:00:00 2001 From: sbreitbart-NOAA Date: Thu, 24 Sep 2026 13:52:17 -0400 Subject: [PATCH 10/11] Update tests and documentation --- R/save_all_plots.R | 18 ++---- man/save_all_plots.Rd | 11 ++-- man/table_biomass_abundance_catch.Rd | 16 ++---- tests/testthat/test-export_rda.R | 6 +- tests/testthat/test-extract_caps_alttext.R | 14 +++-- tests/testthat/test-extract_sis_data.R | 0 tests/testthat/test-save_all_plots.R | 2 +- ...R => test-table_biomass_abundance_catch.R} | 57 +++++++------------ 8 files changed, 50 insertions(+), 74 deletions(-) create mode 100644 tests/testthat/test-extract_sis_data.R rename tests/testthat/{test-table_bnc.R => test-table_biomass_abundance_catch.R} (54%) diff --git a/R/save_all_plots.R b/R/save_all_plots.R index 595b1214..ca56308c 100644 --- a/R/save_all_plots.R +++ b/R/save_all_plots.R @@ -84,10 +84,6 @@ #' #' Default: "" #' -#' @param biomass_unit_label String. Abbreviated biomass units -#' -#' Default: "mt" -#' #' @param catch_unit_label String. Abbreviated catch units #' #' Default: "mt" @@ -146,6 +142,7 @@ save_all_plots <- function( figures_tables_dir = getwd(), # imported from plot_biomass ref_line = "msy", + biomass_unit_label = "mt", biomass_scale_amount = 1, # imported from plot_landings landings_unit_label = "mt", @@ -164,9 +161,9 @@ save_all_plots <- function( # imported from plot_index index_unit_label = "", # imported from table_biomass_abundance_catch - biomass_unit_label = "mt", - catch_unit_label = "mt", + bac_unit_label = c("biomass" = "mt", "abundance" = "fish", "catch" = "mt"), # imported from plot_catch_comp + catch_unit_label = "mt", catch_scale_amount = 1, # imported from table_index- zero unique arguments # imported from table_landings- zero unique arguments @@ -473,9 +470,8 @@ save_all_plots <- function( cli::cli_h2("table_biomass_abundance_catch") table_biomass_abundance_catch( dat, - biomass_unit_label, - catch_unit_label, - spawning_biomass_label, + unit_label = bac_unit_label, + interactive = interactive, make_rda = TRUE, tables_dir = figures_tables_dir ) # |> @@ -485,9 +481,7 @@ save_all_plots <- function( error = function(e) { cli::cli_alert_danger("table_biomass_abundance_catch failed to run.") cli::cli_alert("Tip: check that your arguments are correct.") - cli::cli_li("biomass_unit_label = {biomass_unit_label}") - cli::cli_li("catch_unit_label = {catch_unit_label}") - cli::cli_li("spawning_biomass_label = {spawning_biomass_label}") + cli::cli_li("unit_label = {bac_unit_label}") print(e) } ) diff --git a/man/save_all_plots.Rd b/man/save_all_plots.Rd index dcc708cb..0ff214eb 100644 --- a/man/save_all_plots.Rd +++ b/man/save_all_plots.Rd @@ -13,6 +13,7 @@ save_all_plots( interactive = FALSE, figures_tables_dir = getwd(), ref_line = "msy", + biomass_unit_label = "mt", biomass_scale_amount = 1, landings_unit_label = "mt", spawning_biomass_label = "mt", @@ -23,7 +24,7 @@ save_all_plots( biomass_at_age_scale_amount = 1, biomass_at_age_unit_label = "mt", index_unit_label = "", - biomass_unit_label = "mt", + bac_unit_label = c(biomass = "mt", abundance = "fish", catch = "mt"), catch_unit_label = "mt", catch_scale_amount = 1, projections_unit_label = c(catch = "mt", spawning_biomass = "mt", fishing_mortality = @@ -80,6 +81,10 @@ Default: "msy" Options: Including, but not limited to: "target", "MSY", "unfished"} +\item{biomass_unit_label}{String. Biomass units + +Default: "mt"} + \item{biomass_scale_amount}{Number. A number describing how much to scale down the biomass quantities shown on the y axis. See `recruitment_scale_amount`. @@ -127,10 +132,6 @@ Default: "mt"} Default: ""} -\item{biomass_unit_label}{String. Abbreviated biomass units - -Default: "mt"} - \item{catch_unit_label}{String. Abbreviated catch units Default: "mt"} diff --git a/man/table_biomass_abundance_catch.Rd b/man/table_biomass_abundance_catch.Rd index 0a5dccc1..b986886a 100644 --- a/man/table_biomass_abundance_catch.Rd +++ b/man/table_biomass_abundance_catch.Rd @@ -6,9 +6,7 @@ \usage{ table_biomass_abundance_catch( dat, - biomass_unit_label = "mt", - abundance_unit_label = "fish", - catch_unit_label = "mt", + unit_label = c(biomass = "mt", abundance = "fish", catch = "mt"), era = NULL, interactive = TRUE, group = NULL, @@ -26,14 +24,9 @@ returned from \link[stockplotr]{convert_output}. If inputting a list of tibbles, the first tibble's reference point defined in `ref_line` is used to plot a reference line or calculate relative spawning biomass.} -\item{biomass_unit_label}{Abbreviated units for biomass -Default: "mt"} +\item{unit_label}{Character vector. Abbreviated unit label for each quantity -\item{abundance_unit_label}{Abbreviated units for abundance -Default: "fish"} - -\item{catch_unit_label}{Abbreviated units for catch -Default: "mt"} +Default: c("biomass" = "mt", "abundance" = "fish", "catch" = "mt")} \item{era}{String. Era of data. @@ -99,8 +92,7 @@ a gt-based table, caption, and LaTeX-based table. table_biomass_abundance_catch(stockplotr::example_data) table_biomass_abundance_catch(stockplotr::example_data, - biomass_unit_label = "b label", - catch_unit_label = "catch label", + unit_label = c("biomass" = "kg", "abundance" = "eggs", "catch" = "kg"), module = c("TIME_SERIES", "CATCH", "TIME_SERIES"), interactive = FALSE ) diff --git a/tests/testthat/test-export_rda.R b/tests/testthat/test-export_rda.R index c0ae6940..10b89cdb 100644 --- a/tests/testthat/test-export_rda.R +++ b/tests/testthat/test-export_rda.R @@ -42,7 +42,7 @@ test_that("export_rda works for figures", { }) test_that("export_rda works for tables", { - topic_label <- "bnc" + topic_label <- "biomass_abundance_catch" fig_or_table <- "table" B.min <- 100 @@ -73,9 +73,9 @@ test_that("export_rda works for tables", { fig_or_table = fig_or_table ) - # expect that both tables dir and the bnc_table.rda file exist + # expect that both tables dir and the biomass_abundance_catch_table.rda file exist expect_true(dir.exists(fs::path(getwd(), "tables"))) - expect_true(file.exists(fs::path(getwd(), "tables", "bnc_table.rda"))) + expect_true(file.exists(fs::path(getwd(), "tables", "biomass_abundance_catch_table.rda"))) # erase temporary testing files file.remove(fs::path(getwd(), "captions_alt_text.csv")) diff --git a/tests/testthat/test-extract_caps_alttext.R b/tests/testthat/test-extract_caps_alttext.R index 17d748c1..3af38f17 100644 --- a/tests/testthat/test-extract_caps_alttext.R +++ b/tests/testthat/test-extract_caps_alttext.R @@ -31,14 +31,17 @@ test_that("extract_caps_alttext works for figures", { }) test_that("extract_caps_alttext works for tables", { - topic_label <- "bnc" + topic_label <- "biomass_abundance_catch" fig_or_table <- "table" - B.min <- 100 - B.max <- 200 + biomass_abundance_catch.b.units <- "mt" + biomass_abundance_catch.abundance.units <- "hundreds of fish" + biomass_abundance_catch.catch.units <- "kg" # add KQs to caps/alt text csv - insert_kqs(B.min, B.max) + insert_kqs(biomass_abundance_catch.b.units, + biomass_abundance_catch.abundance.units, + biomass_abundance_catch.catch.units) # extract this plot's caption and alt text caps_alttext <- extract_caps_alttext( @@ -51,9 +54,8 @@ test_that("extract_caps_alttext works for tables", { expect_true(length(caps_alttext) == 1) # expect the first 4 words of the caption - expect_true("Historical biomass, spawning biomass," == stringr::word(caps_alttext, 1, 4)) + expect_true("Historical biomass (mt), abundance" == stringr::word(caps_alttext, 1, 4)) # erase temporary testing files file.remove(fs::path(getwd(), "captions_alt_text.csv")) - file.remove(fs::path(getwd(), "key_quantities.csv")) }) diff --git a/tests/testthat/test-extract_sis_data.R b/tests/testthat/test-extract_sis_data.R new file mode 100644 index 00000000..e69de29b diff --git a/tests/testthat/test-save_all_plots.R b/tests/testthat/test-save_all_plots.R index 4ada9243..ba7a5b9e 100644 --- a/tests/testthat/test-save_all_plots.R +++ b/tests/testthat/test-save_all_plots.R @@ -37,7 +37,7 @@ test_that("save_all_plots works when all figures/tables are plotted", { # expect that the tables are all created with expected names tab_base_temp_files <- c( - "bnc_table.rda", + "biomass_abundance_catch_table.rda", # "total_catch_table.rda", # comment out bc as is this needs to be interactive to select correct module "index_table.rda", "landings_table.rda", diff --git a/tests/testthat/test-table_bnc.R b/tests/testthat/test-table_biomass_abundance_catch.R similarity index 54% rename from tests/testthat/test-table_bnc.R rename to tests/testthat/test-table_biomass_abundance_catch.R index 6eb5d71b..ad9e96ae 100644 --- a/tests/testthat/test-table_bnc.R +++ b/tests/testthat/test-table_biomass_abundance_catch.R @@ -1,60 +1,50 @@ test_that("table_biomass_abundance_catch generates plots without errors", { # expect error-free plot with minimal arguments expect_no_error( - table_biomass_abundance_catch( - stockplotr::example_data, - interactive = FALSE + table_biomass_abundance_catch(stockplotr::example_data, + module = c("TIME_SERIES", "CATCH", "TIME_SERIES"), + interactive = FALSE ) ) # expect error-free plot with many arguments expect_no_error( + table_biomass_abundance_catch(stockplotr::example_data, + unit_label = c("biomass" = "kg", "abundance" = "hundreds of fish", "catch" = "kg"), + module = c("TIME_SERIES", "CATCH", "TIME_SERIES"), + era = "fore", + interactive = FALSE, + make_rda = FALSE, + tables_dir = getwd() + ) + ) + + # expect gt object is returned + expect_s3_class( table_biomass_abundance_catch( dat = stockplotr::example_data, - biomass_unit_label = "mt", - catch_unit_label = "mt", - sb_unit_label = "mt", - era = "fore", + era = NULL, interactive = FALSE, - # group = NULL, - # method = "sum", - # module = NULL, - # label = NULL, + module = c("TIME_SERIES", "CATCH", "TIME_SERIES"), make_rda = FALSE, tables_dir = getwd() - ) + ), + "gt_tbl" ) - - - # expect gt object is returned - # adjust this test to work for multiple output tables - # expect_s3_class( - # table_biomass_abundance_catch( - # dat = stockplotr::example_data, - # unit_label = "mt", - # era = NULL, - # interactive = FALSE, - # module = "CATCH", - # make_rda = FALSE, - # tables_dir = getwd() - # ), - # "gt_tbl" - # ) }) test_that("rda file made when indicated", { # export rda table_biomass_abundance_catch( dat = stockplotr::example_data, - unit_label = "mt", - interactive = FALSE, + module = c("TIME_SERIES", "CATCH", "TIME_SERIES"), make_rda = TRUE, tables_dir = getwd() ) - # expect that both tables dir and the bnc_table.rda file exist + # expect that both tables dir and the biomass_abundance_catch_table.rda file exist expect_true(dir.exists(fs::path(getwd(), "tables"))) - expect_true(file.exists(fs::path(getwd(), "tables", "bnc_table.rda"))) + expect_true(file.exists(fs::path(getwd(), "tables", "biomass_abundance_catch_table.rda"))) # erase temporary testing files file.remove(fs::path(getwd(), "captions_alt_text.csv")) @@ -64,12 +54,9 @@ test_that("rda file made when indicated", { test_that("table_biomass_abundance_catch generates error with incorrect module", { # expect error - # Need to test this -- not exactly the right test/result expect_error( table_biomass_abundance_catch( dat = stockplotr::example_data, - unit_label = "mt", - era = NULL, interactive = FALSE, module = "SPR_SERIES", make_rda = FALSE, From 1bfca09b95d06d3434debb580aa914353d614468 Mon Sep 17 00:00:00 2001 From: sbreitbart-NOAA Date: Thu, 24 Sep 2026 15:56:23 -0400 Subject: [PATCH 11/11] Remove warning from test --- tests/testthat/test-extract_caps_alttext.R | 1 - 1 file changed, 1 deletion(-) diff --git a/tests/testthat/test-extract_caps_alttext.R b/tests/testthat/test-extract_caps_alttext.R index 3af38f17..02f554ee 100644 --- a/tests/testthat/test-extract_caps_alttext.R +++ b/tests/testthat/test-extract_caps_alttext.R @@ -27,7 +27,6 @@ test_that("extract_caps_alttext works for figures", { # erase temporary testing files file.remove(fs::path(getwd(), "captions_alt_text.csv")) - file.remove(fs::path(getwd(), "key_quantities.csv")) }) test_that("extract_caps_alttext works for tables", {