diff --git a/NAMESPACE b/NAMESPACE index 687233f7..2bdb74bb 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -27,6 +27,7 @@ export(process_data) export(process_table) export(reference_line) export(save_all_plots) +export(table_biomass_abundance_catch) export(table_index) export(table_landings) export(table_projections) 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 f873b82d..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)] @@ -397,6 +400,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/save_all_plots.R b/R/save_all_plots.R index 1045a7d9..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", @@ -163,12 +160,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_bnc - biomass_unit_label = "mt", + # imported from table_biomass_abundance_catch + 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_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 @@ -469,29 +465,26 @@ 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_biomass_abundance_catch") + table_biomass_abundance_catch( + dat, + unit_label = bac_unit_label, + interactive = interactive, + make_rda = TRUE, + tables_dir = figures_tables_dir + ) # |> + # suppressWarnings() |> + # invisible() + }, + 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("unit_label = {bac_unit_label}") + print(e) + } + ) tryCatch( { diff --git a/R/table_biomass_abundance_catch.R b/R/table_biomass_abundance_catch.R new file mode 100644 index 00000000..ffe98fc9 --- /dev/null +++ b/R/table_biomass_abundance_catch.R @@ -0,0 +1,175 @@ +#' Biomass, abundance, and catch time series table +#' +#' @inheritParams plot_recruitment +#' +#' @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. +#' +#' 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) +#' +#' table_biomass_abundance_catch(stockplotr::example_data, +#' unit_label = c("biomass" = "kg", "abundance" = "eggs", "catch" = "kg"), +#' module = c("TIME_SERIES", "CATCH", "TIME_SERIES"), +#' interactive = FALSE +#' ) +table_biomass_abundance_catch <- function( + dat, + unit_label = c("biomass" = "mt", "abundance" = "fish", "catch" = "mt"), + era = NULL, + interactive = TRUE, + group = NULL, + method = "sum", + module = NULL, + label = NULL, + make_rda = FALSE, + tables_dir = getwd()) { + + named_vec <- c("^biomass$" = unit_label[[1]], + "^abundance" = unit_label[[2]], + "catch$|landings_observed" = unit_label[[3]]) + + # 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) { + # Obtain relevant key quantities for captions/alt text + 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.abundance.units, + biomass_abundance_catch.catch.units) + + # Add key quantities to captions/alt text + insert_kqs(biomass_abundance_catch.b.units, + biomass_abundance_catch.abundance.units, + biomass_abundance_catch.catch.units) + + create_rda( + 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, + table_df = final_table + ) + } + + final_table +} + diff --git a/R/table_bnc.R b/R/table_bnc.R deleted file mode 100644 index 4de637a3..00000000 --- a/R/table_bnc.R +++ /dev/null @@ -1,197 +0,0 @@ -# #' 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_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( -# # 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 |> -# 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 -# # ) -# # } -# } - -# 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? -# 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/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 ecec6a45..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. #' @@ -568,10 +564,8 @@ 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", table_df = NULL ) { # extract this plot's caption and alt text @@ -864,7 +858,7 @@ create_rda <- function( #' ) #' #' extract_caps_alttext( -#' topic_label = "bnc", +#' topic_label = "biomass_abundance_catch", #' fig_or_table = "table", #' dir = getwd() #' ) @@ -958,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/inst/resources/captions_alt_text_template.csv b/inst/resources/captions_alt_text_template.csv index 0c61bb35..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, spawning biomass, abundance, and catch 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,,,, diff --git a/man/create_rda.Rd b/man/create_rda.Rd index c1b70dec..d94521c6 100644 --- a/man/create_rda.Rd +++ b/man/create_rda.Rd @@ -10,10 +10,8 @@ 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", table_df = NULL ) } @@ -31,10 +29,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" @@ -47,12 +41,12 @@ 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.} + +\item{year}{Number. Assessment year + +Default: the current year} } \value{ An rda package for a plot or table object. Requires an 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/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 new file mode 100644 index 00000000..b986886a --- /dev/null +++ b/man/table_biomass_abundance_catch.Rd @@ -0,0 +1,102 @@ +% Generated by roxygen2: do not edit by hand +% 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_biomass_abundance_catch( + dat, + unit_label = c(biomass = "mt", abundance = "fish", catch = "mt"), + era = NULL, + interactive = TRUE, + group = NULL, + method = "sum", + module = NULL, + label = NULL, + make_rda = FALSE, + tables_dir = getwd() +) +} +\arguments{ +\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 +in `ref_line` is used to plot a reference line or calculate relative spawning biomass.} + +\item{unit_label}{Character vector. Abbreviated unit label for each quantity + +Default: c("biomass" = "mt", "abundance" = "fish", "catch" = "mt")} + +\item{era}{String. Era of data. + +Default: "time" + +Options: "early", "time", "fore" (forecast), or NULL (all data)} + +\item{interactive}{Logical. TRUE/FALSE; indicate whether 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}{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 + +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}{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". + +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_biomass_abundance_catch(stockplotr::example_data) + +table_biomass_abundance_catch(stockplotr::example_data, + unit_label = c("biomass" = "kg", "abundance" = "eggs", "catch" = "kg"), + module = c("TIME_SERIES", "CATCH", "TIME_SERIES"), + interactive = FALSE +) +} +\seealso{ +[convert_output()], [filter_data()], [process_table()], [export_kqs()], [insert_kqs()], [create_rda()] +} 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..02f554ee 100644 --- a/tests/testthat/test-extract_caps_alttext.R +++ b/tests/testthat/test-extract_caps_alttext.R @@ -27,18 +27,20 @@ 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", { - 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 +53,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 ea508bcb..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_biomass_abundance_catch.R b/tests/testthat/test-table_biomass_abundance_catch.R new file mode 100644 index 00000000..ad9e96ae --- /dev/null +++ b/tests/testthat/test-table_biomass_abundance_catch.R @@ -0,0 +1,66 @@ +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, + 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, + era = NULL, + interactive = FALSE, + module = c("TIME_SERIES", "CATCH", "TIME_SERIES"), + 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, + module = c("TIME_SERIES", "CATCH", "TIME_SERIES"), + make_rda = TRUE, + tables_dir = getwd() + ) + + # 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", "biomass_abundance_catch_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_biomass_abundance_catch generates error with incorrect module", { + # expect error + expect_error( + table_biomass_abundance_catch( + dat = stockplotr::example_data, + interactive = FALSE, + module = "SPR_SERIES", + make_rda = FALSE, + tables_dir = getwd() + ) + ) +}) diff --git a/tests/testthat/test-table_bnc.R b/tests/testthat/test-table_bnc.R deleted file mode 100644 index b0831892..00000000 --- a/tests/testthat/test-table_bnc.R +++ /dev/null @@ -1,74 +0,0 @@ -# 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 -# ) -# ) - -# # 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() -# ) -# ) - - -# # 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() -# ) -# ) -# })