diff --git a/NAMESPACE b/NAMESPACE index 19b69c0f..a2cbce9b 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -27,5 +27,6 @@ export(process_data) export(process_table) export(reference_line) export(save_all_plots) +export(table_indices) export(table_landings) export(theme_noaa) diff --git a/R/process_data.R b/R/process_data.R index 11ce6e7d..09c4bd59 100644 --- a/R/process_data.R +++ b/R/process_data.R @@ -532,8 +532,8 @@ process_table <- function( dplyr::rename( !!mod_uncert_lab := uncertainty ) |> - # set values to strings to include training zeros from rounding - dplyr::mutate(estimate = sprintf(glue::glue("%.{digits}f"), estimate)) |> + # set values to strings to include trailing zeros from rounding and # format large estimate values with commas + dplyr::mutate(estimate = formatC(estimate, format = "f", digits = digits, big.mark = ",")) |> tidyr::pivot_wider( id_cols = dplyr::all_of(c(stringr::str_to_title(mod_cols))), values_from = dplyr::all_of(c("estimate", mod_uncert_lab)), diff --git a/R/table_indices.R b/R/table_indices.R index 90b20992..bcf19f70 100644 --- a/R/table_indices.R +++ b/R/table_indices.R @@ -1,173 +1,182 @@ -# #' Create Indices of Abundance Table -# #' -# #' @inheritParams plot_recruitment -# #' @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: the working directory (`getwd()`) -# #' @returns A table of observed annual indices of abundance plus error -# #' stratified by fleet. -# #' @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 -# #' \dontrun{ -# #' table_indices(dat) -# #' -# #' table_indices( -# #' dat, -# #' end_year = 2024, -# #' make_rda = TRUE, -# #' tables_dir = getwd() -# #' ) -# #' } -# table_indices <- function( -# dat, -# end_year = format(Sys.Date(), "%Y"), -# make_rda = FALSE, -# tables_dir = getwd()) { -# # create plot-specific variables to use throughout fxn for naming and IDing -# topic_label <- "indices.abundance" - -# # 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 -# ) - -# # Load data -# output <- dat |> -# dplyr::filter(module_name == "INDEX_2" | module_name == "t.series") |> -# dplyr::filter(year <= end_year) -# # Check for U -# if (any(unique(output$module_name == "INDEX_2"))) { -# output <- output |> -# dplyr::filter( -# grepl("expected_indices", label) | grepl("indices_predicted", label) -# ) # grepl("input_indices", label) | -# } else if (any(unique(output$module_name == "t.series"))) { -# output <- output |> -# dplyr::filter(grepl("cpue", label)) -# } - -# # Extract fleet names -# fleet_names <- unique(as.character(output$fleet)) -# factors <- c("year", "fleet", "fleet_name", "age", "sex", "area", "seas", "season", "time", "era", "subseas", "subseason", "platoon", "platoo", "growth_pattern", "gp") -# # re-structure df for table -# indices <- output |> -# tidyr::pivot_wider( -# # id_cols = c(year, uncertainty, uncertainty_label), -# names_from = label, -# values_from = estimate -# ) |> -# dplyr::select(year, fleet, unique(output$label), uncertainty, uncertainty_label) # |> - -# # na.omit() -# # check if uncertainty is a measure in the df -# if (all(is.na(indices$uncertainty))) { -# indices <- indices |> -# dplyr::select(-c(uncertainty_label, uncertainty)) -# } else { -# uncertainty_col <- paste("uncertainty_", unique(indices$uncertainty_label), sep = "") -# colnames(indices) <- stringr::str_replace(colnames(indices), "^uncertainty$", uncertainty_col) -# indices <- dplyr::select(indices, -uncertainty_label) -# } - -# # Check if observed/inital values are in the df -# if (any(grepl("observed", colnames(indices)))) { -# indices <- indices |> -# dplyr::select(-colnames(indices)[grep(c("observed"), colnames(indices))]) -# } - -# # rename columns to remove cpue/effort -# if (any(grep("_indices", colnames(indices)))) { -# colnames(indices) <- stringr::str_replace_all(colnames(indices), "_indices", "") -# } else if (any(grep("indices_", colnames(indices)))) { -# colnames(indices) <- stringr::str_replace_all(colnames(indices), "indices_", "") -# } else { -# colnames(indices) <- stringr::str_replace_all(colnames(indices), "cpue_", "") -# } - -# # Check for which column is U and filter out na values -# if (any(grep("predicted", colnames(indices)))) { -# indices <- indices |> -# dplyr::filter(!is.na(predicted)) -# } -# if (any(grep("expected", colnames(indices)))) { -# indices <- indices |> -# dplyr::filter(!is.na(expected)) -# } - -# # move fleet data into own columns -# indices2 <- indices |> -# tidyr::pivot_wider( -# names_from = fleet, -# values_from = colnames(indices)[!colnames(indices) %in% c("year", "fleet")] -# ) |> -# dplyr::select(year, dplyr::ends_with(fleet_names)) - -# fleet_col_names <- stringr::str_extract(colnames(indices2)[colnames(indices2) != "year"], "[^_]+$") -# if (any(grepl("[0-9]+", fleet_col_names))) { -# fleet_header_lab <- "" -# fleet_col_names <- paste("Fleet ", fleet_col_names) -# } else { -# fleet_header_lab <- "Fleet" -# } - -# tab <- indices2 |> -# dplyr::mutate(dplyr::across(where(is.numeric), ~ round(.x, 2)), -# year = as.character(year) -# ) |> -# flextable::flextable() |> -# flextable::set_header_labels( -# # TODO: set uncertainty to the actual value instead of word uncertainty -# values = c("Year", rep(c("Estimated CPUE", "Uncertainty"), (ncol(indices2) - 1) / 2)) -# ) |> -# flextable::add_header_row( -# values = c(fleet_header_lab, fleet_col_names) -# ) |> -# flextable::merge_h(part = "header") |> -# flextable::align(part = "header") - -# final <- suppressWarnings(add_theme(tab)) - -# # export table to rda if argument = T -# if (make_rda) { -# # 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 = end_year -# ) -# } - -# # 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_", "", as.character(sys.call()[[1]])), -# fig_or_table = fig_or_table -# ) -# } -# final -# } +#' Indices of abundance table +#' +#' @inheritParams plot_recruitment +#' @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 digits Numeric value indicating the number of digits values in the +#' table will be rounded to. +#' +#' Default: 2 +#' @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: the working directory (`getwd()`) +#' @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: "indices_weight", "indices_numbers", "indices_expected", +#' "indices_predicted", "indices". +#' +#' Default: NULL +#' +#' @returns A table of observed annual indices of abundance plus error, +#' stratified by fleet. +#' @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 +#' \dontrun{ +#' table_indices(dat) +#' +#' table_indices( +#' dat, +#' make_rda = TRUE, +#' tables_dir = getwd() +#' ) +#' } +table_indices <- function( + dat, + era = NULL, + interactive = TRUE, + group = NULL, + method = "sum", + module = NULL, + label = NULL, + digits = 2, + 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 = "indices", + geom = "line", + era = era, + module = module, + scale_amount = 1, + interactive = interactive + ) |> + dplyr::mutate(estimate = round(as.numeric(estimate), digits = digits), + uncertainty = round(as.numeric(uncertainty), digits = digits)) + + # Add check if there is any data + if (nrow(prepared_data) == 0) { + cli::cli_abort("No indices 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, + digits = digits + ) + 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 indices column for every error column -- if not remove the error (can keep indices) + + # merge error and indices columns and rename + df_list <- merge_error( + table_data, + uncert_lab, + fleets, + label = "indices", + unit_label = "" # should this be CPUE? + ) + + # 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) { + + # Caption contains no key quantities for indices table + # So, export captions/alt text csv if absent + if (!file.exists(fs::path(getwd(), "captions_alt_text.csv"))) { + caps_alttext <- utils::read.csv( + system.file("resources", "captions_alt_text_template.csv", package = "stockplotr") + ) + # export df with captions and alt text to csv + utils::write.csv( + x = caps_alttext, + file = fs::path(getwd(), "captions_alt_text.csv"), + row.names = FALSE + ) + } + + if (length(df_list) == 1) { + 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 = 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) + } +} diff --git a/inst/resources/bam_var_names.csv b/inst/resources/bam_var_names.csv index 2f788ed7..a9678ffd 100644 --- a/inst/resources/bam_var_names.csv +++ b/inst/resources/bam_var_names.csv @@ -212,6 +212,9 @@ t.series,total.D.knum,discards_numbers t.series,U.ob,indices_expected t.series,U.pr,indices_predicted t.series,cv.U,indices_cv +t.series,u.ob,indices_expected +t.series,u.pr,indices_predicted +t.series,cv.u,indices_cv t.series,q.rate.mult,catchability_rate t.series,q.DD.mult,q_DD_mult t.series,q.DD.B.4plus,q_DD_B_4plus diff --git a/inst/resources/captions_alt_text_template.csv b/inst/resources/captions_alt_text_template.csv index 07e829c0..517017da 100644 --- a/inst/resources/captions_alt_text_template.csv +++ b/inst/resources/captions_alt_text_template.csv @@ -37,7 +37,7 @@ life.history.params,table,Life history parameters used in the stock assessment m landings,table,Landed catch by fleet and year in landings.units., discards,table,Discarded catch by fleet and year in discards.tbl.units., age.length.key,table,Age-length key: the proportion of fish for each age that belong to a particular length group. , -indices,table,Calculated indices of abundance and their corresponding CVs for the fleets and surveys identified in the column headers. , +indices,table,Calculated indices of abundance and corresponding CVs for the fleets and surveys identified in the column headers. , model.runs,table,"The base configuration and alternative sensitivity analysis configurations of the stock assessment model, in which parameters and/or data input streams are changed from one configuration to another.", 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., diff --git a/man/table_indices.Rd b/man/table_indices.Rd new file mode 100644 index 00000000..9eaedaec --- /dev/null +++ b/man/table_indices.Rd @@ -0,0 +1,108 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/table_indices.R +\name{table_indices} +\alias{table_indices} +\title{Indices of abundance table} +\usage{ +table_indices( + dat, + era = NULL, + interactive = TRUE, + group = NULL, + method = "sum", + module = NULL, + label = NULL, + digits = 2, + 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{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: "indices_weight", "indices_numbers", "indices_expected", +"indices_predicted", "indices". + +Default: NULL} + +\item{digits}{Numeric value indicating the number of digits values in the +table will be rounded to. + +Default: 2} + +\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 generated table +rda files ("tables") that will be created if the argument `make_rda` = TRUE. + +Default: the working directory (`getwd()`)} +} +\value{ +A table of observed annual indices of abundance plus error, +stratified by fleet. +} +\description{ +Indices of abundance table +} +\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{ +\dontrun{ +table_indices(dat) + +table_indices( + dat, + make_rda = TRUE, + tables_dir = getwd() +) +} +} +\seealso{ +[convert_output()], [filter_data()], [process_table()], [export_kqs()], [insert_kqs()], [create_rda()] +} diff --git a/tests/testthat/test-table_indices.R b/tests/testthat/test-table_indices.R index 50081a07..17a2fe4a 100644 --- a/tests/testthat/test-table_indices.R +++ b/tests/testthat/test-table_indices.R @@ -1,65 +1,57 @@ -# # load sample dataset -# load(file.path( -# "fixtures", "ss3_models_converted", "Hake_2018", -# "std_output.rda" -# )) - -# test_that("table_indices generates plots without errors", { -# # expect error-free plot with minimal arguments -# expect_no_error( -# stockplotr::table_indices(out_new) -# ) - -# # expect error-free plot with many arguments -# expect_no_error( -# stockplotr::table_indices( -# out_new, -# end_year = 2024, -# make_rda = FALSE, -# tables_dir = getwd() -# ) -# ) - - -# # expect flextable object is returned -# expect_s3_class( -# stockplotr::table_indices( -# out_new, -# make_rda = FALSE, -# tables_dir = getwd() -# ), -# "flextable" -# ) -# }) - -# test_that("rda file made when indicated", { -# # export rda -# table_indices( -# out_new, -# end_year = 2024, -# make_rda = TRUE, -# tables_dir = getwd() -# ) - -# # expect that both tables dir and the indices.abundance_table.rda file exist -# expect_true(dir.exists(fs::path(getwd(), "tables"))) -# expect_true(file.exists(fs::path(getwd(), "tables", "indices.abundance_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_indices generates error with future end_year", { -# # expect error -# expect_error( -# stockplotr::table_indices( -# out_new, -# end_year = 2035, -# make_rda = TRUE, -# tables_dir = getwd() -# ) -# ) -# }) +# load sample dataset +load(file.path( + "fixtures", "ss3_models_converted", "Hake_2018", + "std_output.rda" +)) + +test_that("table_indices generates plots without errors", { + # expect error-free plot with minimal arguments + expect_no_error( + table_indices( + out_new, + interactive = FALSE + ) + ) + + # expect error-free plot with many arguments + expect_no_error( + table_indices( + dat = out_new, + make_rda = FALSE, + tables_dir = getwd() + ) + ) + + + # expect gt object is returned + # adjust this test to work for multiple output tables + # expect_s3_class( + # table_indices( + # dat = out_new, + # 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_indices( + dat = out_new, + make_rda = TRUE, + tables_dir = getwd() + ) + + # expect that both tables dir and the indices_table.rda file exist + expect_true(dir.exists(fs::path(getwd(), "tables"))) + expect_true(file.exists(fs::path(getwd(), "tables", "indices_table.rda"))) + + # erase temporary testing files + file.remove(fs::path(getwd(), "captions_alt_text.csv")) + unlink(fs::path(getwd(), "tables"), recursive = T) +})