diff --git a/NAMESPACE b/NAMESPACE index 9645f508..16189ec1 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -27,6 +27,7 @@ export(process_data) export(process_table) export(reference_line) export(save_all_plots) +export(table_catch) export(table_index) export(table_landings) export(table_projections) diff --git a/R/save_all_plots.R b/R/save_all_plots.R index 75c19584..228319eb 100644 --- a/R/save_all_plots.R +++ b/R/save_all_plots.R @@ -105,12 +105,6 @@ #' #' Default: c("catch" = "mt", "spawning_biomass" = "mt", #' "fishing_mortality" = "") -#' -#' @param projections_uncert_label Abbreviated uncertainty label for -#' each quantity -#' -#' Default: c("catch" = "stddev", "spawning_biomass" = "stddev", -#' "fishing_mortality" = "stddev") #' #' @param proportional Logical. TRUE/FALSE; scale size of bubble plots #' @@ -493,6 +487,26 @@ save_all_plots <- function( # } # ) + tryCatch( + { + cli::cli_h2("table_catch") + table_catch( + dat, + unit_label = catch_unit_label, + interactive = interactive, + make_rda = TRUE, + tables_dir = figures_tables_dir + ) # |> + # suppressWarnings() |> + # invisible() + }, + error = function(e) { + cli::cli_alert_danger("table_catch failed to run.") + cli::cli_alert("Tip: check that your arguments are correct.") + print(e) + } + ) + tryCatch( { cli::cli_h2("table_index") @@ -549,7 +563,7 @@ save_all_plots <- function( cli::cli_alert_danger("table_projections failed to run.") cli::cli_alert("Tip: check that your arguments are correct.") cli::cli_li("projections_unit_label = {projections_unit_label}") - cli::cli_li("projections_uncert_label = {projections_uncert_label}") + # cli::cli_li("projections_uncert_label = {projections_uncert_label}") print(e) } ) diff --git a/R/stockplotr-package.R b/R/stockplotr-package.R index f11bf767..177d517b 100644 --- a/R/stockplotr-package.R +++ b/R/stockplotr-package.R @@ -19,6 +19,7 @@ globvar <- c( "like", "match_key", "morph", "nsim", "output", "output_order", "parm_stdev", "seas", "sexes", "subseas", "unique_count", "value", "yr", "fleet_names", "across", "everything", "fleet_name", "name", "value_new", "y", ".", "x", + "Fleet", "length_bins", "month", "na.omit", "rp_dat", "selected_module", # Rceattle conout terms "n", "observation", "selectivity_block", "log_sd", "fleet_code", "q_block", "species", "indices_observed", "indices_predicted", diff --git a/R/table_catch.R b/R/table_catch.R new file mode 100644 index 00000000..fcb35bed --- /dev/null +++ b/R/table_catch.R @@ -0,0 +1,184 @@ +#' Catch (table) by fleet, gear type, sector +#' +#' @inheritParams plot_recruitment +#' @param unit_label String. Abbreviated catch units +#' +#' Default: "mt" +#' +#' @param digits Number. Numeric value indicating the number of digits catch values in the +#' table will be rounded to. +#' +#' Default: 2 +#' +#' @param tables_dir Path. The location of the folder containing the generated table +#' rda files ("tables") that will be created if the argument `make_rda` = TRUE. +#' +#' Default: the working directory (`getwd()`) +#' +#' @returns A table ready of landed catch by fleet and year. +#' +#' @details The input is from an assessment model output file +#' translated to a standardized output (\link[stockplotr]{convert_output}). +#' 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_catch(stockplotr::example_data, +#' module = "TIME_SERIES") +#' +#' table_catch( +#' stockplotr::example_data, +#' unit_label = "lbs", +#' module = "TIME_SERIES", +#' digits = 4, +#' scale_amount = 100 +#' ) +table_catch <- function( + dat, + unit_label = "mt", + era = NULL, + interactive = TRUE, + module = NULL, + scale_amount = 1, + digits = 2, + make_rda = FALSE, + tables_dir = getwd() +) { + # set unit label if scaled + unit_label <- label_magnitude( + label = "", + unit_label = unit_label, + scale_amount = scale_amount + ) + + # Filter data for catch + prepared_data <- filter_data( + dat = dat, + label_name = "catch", + geom = "line", + era = era, + module = module, + scale_amount = scale_amount, + interactive = interactive + ) |> + dplyr::filter(label %in% c("catch_retained", "catch_dead", "catch_selected", "catch")) |> + dplyr::filter(!is.na(year)) |> + dplyr::filter(!is.na(estimate)) + + # Check if there is any data and if all labels contain "catchability", not "catch" + if (nrow(prepared_data) == 0 | unique(stringr::str_detect(prepared_data$label, "catchability"))) { + cli::cli_abort("No catch 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 (length(uncert_lab) == 0 || is.na(uncert_lab)) uncert_lab <- "uncertainty" + + catch <- prepared_data |> + dplyr::group_by(year, fleet, sex, area, season, type, uncertainty) |> + dplyr::summarise(total_catch = sum(estimate)) |> + dplyr::mutate(total_catch = round(total_catch, digits = digits)) |> + dplyr::mutate(total_catch = format(total_catch, big.mark = ",")) |> + dplyr::ungroup() + + # filter out columns if there is only one unique value + cols_to_remove <- c() + for (i in 1:ncol(catch)){ + if (length(unique(catch[[i]])) == 1 & names(catch[i]) != "uncertainty") { + cols_to_remove <- c(cols_to_remove, + colnames(catch[i])) + } + if (names(catch[i]) == "uncertainty" && is.na(unique(catch[[i]]))) { + cols_to_remove <- c(cols_to_remove, + colnames(catch[i])) + } + } + + catch <- catch |> + dplyr::select(-cols_to_remove) + + if ("uncertainty" %in% colnames(catch)) { + catch <- catch |> + dplyr::mutate(total_catch = paste0(total_catch, " (", uncertainty, ")")) |> + dplyr::rename_with(~ paste0("total_catch (", uncert_lab, ")"), .cols = total_catch) |> + dplyr::select(-uncertainty) + } + + names(catch) <- stringr::str_to_title(names(catch)) + + if (uncert_lab %in% cols_to_remove){ + uncert_lab <- "" + } + + if ("Fleet" %in% colnames(catch)){ + if (uncert_lab != ""){ + catch <- catch |> + tidyr::pivot_wider(names_from = Fleet, + names_glue = stringr::str_glue("Fleet {{Fleet}}{unit_label} ({uncert_lab})"), + values_from = dplyr::starts_with("Total_catch")) + } else { + catch <- catch |> + tidyr::pivot_wider(names_from = Fleet, + names_glue = stringr::str_glue("Fleet {{Fleet}}{unit_label}"), + values_from = dplyr::starts_with("Total_catch")) + } + } else { + if (uncert_lab != ""){ + catch <- catch |> + dplyr::rename_with(~ paste0("Catch", unit_label, " (", uncert_lab, ")"), .cols = dplyr::starts_with("Total_catch")) + } else { + catch <- catch |> + dplyr::rename_with(~ paste0("Catch", unit_label), .cols = dplyr::starts_with("Total_catch"))} + } + + # transform dfs into tables + final <- catch |> + gt::gt() |> + theme_table() + + # export figure to rda if argument = T + if (make_rda == TRUE) { + # Obtain relevant key quantities for captions/alt text + tot.catch.units <- unit_label + + # calculate & export key quantities + export_kqs(tot.catch.units) + + # Add key quantities to captions/alt text + insert_kqs(tot.catch.units) + + create_rda( + object = final, + # get name of function and remove "table_" from it + topic_label = gsub("table_", "", utils::tail(as.character(sys.call()[[1]]), n = 1)), + fig_or_table = "table", + dat = dat, + dir = tables_dir, + scale_amount = 1, + unit_label = unit_label, + table_df = final + ) + + 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 + final +} diff --git a/inst/resources/captions_alt_text_template.csv b/inst/resources/captions_alt_text_template.csv index 42c0db88..17db477d 100644 --- a/inst/resources/captions_alt_text_template.csv +++ b/inst/resources/captions_alt_text_template.csv @@ -32,7 +32,7 @@ proj.catch,figure,Forecasted catch in proj.catch.units over future years for dif proj.biomass,table,Forecasted biomass over future years for different fishing mortality scenarios., report.version.model.changes,table,Document version history briefly describing when major changes or updates are made to each version of the report., projections,table,"Forecasted catch, spawning biomass, and fishing mortality over future years. ", -catch,table,Observed (points) and model estimated (line) catch over time for fleet catch.fleet., +catch,table,Total catch over time., life.history.params,table,Life history parameters used in the stock assessment model. The last column of the table indicates whether the parameters were estimated by the model or fixed., landings,table,Landed catch by fleet and year in landings.units., discards,table,Discarded catch by fleet and year in discards.tbl.units., diff --git a/inst/resources/key_quantity_template.csv b/inst/resources/key_quantity_template.csv index e074e83f..540c4f91 100644 --- a/inst/resources/key_quantity_template.csv +++ b/inst/resources/key_quantity_template.csv @@ -131,6 +131,7 @@ ssb.start.year,,start year of the SSB time series,,,, ssb.units,,units for spawning biomass,,,, tot.catch.max,,maximum total catch,,,, tot.catch.min,,minimum total catch,,,, +tot.catch.units,,units for total catch,,,, total.length.max,,maximum total length,,,, total.length.min,,minimum total length,,,, total.length.units,,units for total length,,,, diff --git a/man/save_all_plots.Rd b/man/save_all_plots.Rd index b8532563..f173a562 100644 --- a/man/save_all_plots.Rd +++ b/man/save_all_plots.Rd @@ -144,12 +144,6 @@ Default: 1} Default: c("catch" = "mt", "spawning_biomass" = "mt", "fishing_mortality" = "")} - -\item{projections_uncert_label}{Abbreviated uncertainty label for -each quantity - -Default: c("catch" = "stddev", "spawning_biomass" = "stddev", -"fishing_mortality" = "stddev")} } \value{ Rda files for each figure/table. diff --git a/man/table_catch.Rd b/man/table_catch.Rd new file mode 100644 index 00000000..08ae9dae --- /dev/null +++ b/man/table_catch.Rd @@ -0,0 +1,94 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/table_catch.R +\name{table_catch} +\alias{table_catch} +\title{Catch (table) by fleet, gear type, sector} +\usage{ +table_catch( + dat, + unit_label = "mt", + era = NULL, + interactive = TRUE, + module = NULL, + scale_amount = 1, + digits = 2, + 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}{String. Abbreviated catch units + +Default: "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{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{scale_amount}{Number. A number to scale the y-axis values. + +Default: 1} + +\item{digits}{Number. Numeric value indicating the number of digits catch values in the +table will be rounded to. + +Default: 2} + +\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}{Path. The location of the folder containing the generated table +rda files ("tables") that will be created if the argument `make_rda` = TRUE. + +Default: the working directory (`getwd()`)} +} +\value{ +A table ready of landed catch by fleet and year. +} +\description{ +Catch (table) by fleet, gear type, sector +} +\details{ +The input is from an assessment model output file +translated to a standardized output (\link[stockplotr]{convert_output}). +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_catch(stockplotr::example_data, +module = "TIME_SERIES") + +table_catch( + stockplotr::example_data, + unit_label = "lbs", + module = "TIME_SERIES", + digits = 4, + scale_amount = 100 +) +} +\seealso{ +[convert_output()], [filter_data()], [process_table()], [export_kqs()], [insert_kqs()], [create_rda()] +} diff --git a/tests/testthat/test-save_all_plots.R b/tests/testthat/test-save_all_plots.R index db97bed0..b021b587 100644 --- a/tests/testthat/test-save_all_plots.R +++ b/tests/testthat/test-save_all_plots.R @@ -16,17 +16,17 @@ test_that("save_all_plots works when all figures/tables are plotted", { # expect that the figures are all created with expected names fig_base_temp_files <- c( + "abundance_at_age_figure.rda", "biomass_figure.rda", - "index_figure.rda", "fishing_mortality_figure.rda", + "index_figure.rda", "landings_figure.rda", "natural_mortality_figure.rda", # "biomass_at_age_figure.rda", # comment out bc as is this needs to be interactive to select correct module -- TODO: release fix to filter BAA plot data for non-NAs in age # "catch_comp_figure.rda", # same TODO as above - "abundance_at_age_figure.rda", + "recruitment_deviations_figure.rda", "recruitment_figure.rda", "selectivity_figure.rda", - "recruitment_deviations_figure.rda", "spawning_biomass_figure.rda", "stock_recruitment_figure.rda" ) @@ -38,6 +38,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", + # "catch_table.rda", # comment out bc as is this needs to be interactive to select correct module "index_table.rda", "landings_table.rda", "projections_table.rda" diff --git a/tests/testthat/test-table_catch.R b/tests/testthat/test-table_catch.R new file mode 100644 index 00000000..bb718472 --- /dev/null +++ b/tests/testthat/test-table_catch.R @@ -0,0 +1,126 @@ +test_that("table_catch generates plots without errors", { + # expect error-free plot with minimal arguments + expect_no_error( + table_catch( + stockplotr::example_data, + interactive = FALSE, + module = "TIME_SERIES" + ) + ) + + # expect error-free plot with many arguments + expect_no_error( + table_catch( + dat = stockplotr::example_data, + unit_label = "mt", + interactive = FALSE, + module = "TIME_SERIES", + make_rda = FALSE, + tables_dir = getwd() + ) + ) + + + # expect gt object is returned + # adjust this test to work for multiple output tables + # expect_s3_class( + # table_catch( + # dat = stockplotr::example_data, + # unit_label = "mt", + # era = NULL, + # interactive = FALSE, + # module = "TIME_SERIES", + # make_rda = FALSE, + # tables_dir = getwd() + # ), + # "gt_tbl" + # ) +}) + +test_that("rda file made when indicated", { + # export rda + table_catch( + dat = stockplotr::example_data, + unit_label = "mt", + era = NULL, + interactive = FALSE, + module = "TIME_SERIES", + make_rda = TRUE, + tables_dir = getwd() + ) + + # expect that both tables dir and the catch_table.rda file exist + expect_true(dir.exists(fs::path(getwd(), "tables"))) + expect_true(file.exists(fs::path(getwd(), "tables", "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_catch generates error with incorrect module", { + # expect error + # Need to test this -- not exactly the right test/result + expect_error( + table_catch( + dat = stockplotr::example_data, + unit_label = "mt", + era = NULL, + interactive = FALSE, + module = "SPR_SERIES", + make_rda = FALSE, + tables_dir = getwd() + ) + ) +}) + + +test_that("rda file made when indicated", { + # export rda + table_catch( + dat = stockplotr::example_data, + module = "TIME_SERIES", + make_rda = TRUE, + tables_dir = getwd() + ) + + # expect that both tables dir and the catch_table.rda file exist + expect_true(dir.exists(fs::path(getwd(), "tables"))) + expect_true(file.exists(fs::path(getwd(), "tables", "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) + + + # export rda + table_catch( + dat = stockplotr::example_data, + module = "TIME_SERIES", + make_rda = TRUE, + tables_dir = getwd() + ) + + # load the rda file and check that it contains the expected object + load(fs::path(getwd(), "tables", "catch_table.rda")) + # expect rda contains three objects: table, caption, and latex table + expect_false( + is.null(rda$table) + ) + expect_false( + is.null(rda$caption) + ) + expect_false( + is.null(rda$latex_table) + ) + + expect_true(rda$caption == "Total catch over time.") + + # 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) +}) + diff --git a/tests/testthat/test-table_index.R b/tests/testthat/test-table_index.R index 43869f99..088eca87 100644 --- a/tests/testthat/test-table_index.R +++ b/tests/testthat/test-table_index.R @@ -48,10 +48,8 @@ test_that("rda file made when indicated", { # erase temporary testing files file.remove(fs::path(getwd(), "captions_alt_text.csv")) unlink(fs::path(getwd(), "tables"), recursive = T) -}) - -test_that("rda file made when indicated", { + # export rda table_index( dat = stockplotr::example_data, diff --git a/tests/testthat/test-table_landings.R b/tests/testthat/test-table_landings.R index a177a4d6..8a1ccb4b 100644 --- a/tests/testthat/test-table_landings.R +++ b/tests/testthat/test-table_landings.R @@ -92,10 +92,7 @@ test_that("rda file made when indicated", { 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("rda file made when indicated", { # export rda table_landings( dat = stockplotr::example_data,