[feat] Update indices table

.Rbuildignore

@@ -6,3 +6,5 @@
 ^_pkgdown\.yml$
 ^docs$
 ^pkgdown$
+^\.positai$
+^\.claude$

.gitignore

@@ -13,3 +13,4 @@ docs
 stockplotr.Rproj
 *.Rproj
 !vignettes/figures/
+.positai

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: stockplotr
 Title: Tables and Figures for Stock Assessments
-Version: 0.12.0
+Version: 0.12.0.9000
 Authors@R: c(
     person("Samantha", "Schiano", , "samantha.schiano@noaa.gov", role = c("aut", "cre"),
            comment = c(ORCID = "0009-0003-3744-6428")),

NAMESPACE

@@ -14,7 +14,7 @@ export(plot_biomass)
 export(plot_biomass_at_age)
 export(plot_catch_comp)
 export(plot_fishing_mortality)
-export(plot_indices)
+export(plot_index)
 export(plot_landings)
 export(plot_natural_mortality)
 export(plot_obsvpred)
@@ -27,5 +27,6 @@ export(process_data)
 export(process_table)
 export(reference_line)
 export(save_all_plots)
+export(table_index)
 export(table_landings)
 export(theme_noaa)

R/convert_output.R

@@ -1933,7 +1933,7 @@ convert_output <- function(
             uncertainty = log_sd
           ) |>
           dplyr::mutate(
-            # label = "indices_observed",
+            # label = "index_observed",
             uncertainty_label = "log_sd",
             indices_predicted = dat$quantities$index_hat
           ) |>
@@ -2013,7 +2013,7 @@ convert_output <- function(
         df_comp_obs <- dat$data_list$comp_data |>
           dplyr::rename_with(tolower) |>
           dplyr::mutate(
-            label = "indices_observed"
+            label = "index_observed"
           )
 
         indexing_vars_cols <- colnames(df_comp_obs)[!grepl("comp", colnames(df_comp_obs))]

R/plot_indices.R → R/plot_index.R

@@ -13,7 +13,7 @@
 #' filtered. (i.e. select names of fleets to zoom into the plot)
 #'
 #' Default: NULL
-#' @returns A plot showing the expected and predicted indices.
+#' @returns A plot showing the expected and predicted index.
 #'
 #' @details The input is from an assessment model output file
 #' translated to a standardized output (\link[stockplotr]{convert_output}).
@@ -25,13 +25,13 @@
 #' @export
 #'
 #' @examples
-#' plot_indices(
+#' plot_index(
 #'   dat = stockplotr:::example_data,
 #'   unit_label = "fish/hr",
 #'   interactive = FALSE
 #' )
 #'
-plot_indices <- function(
+plot_index <- function(
   dat,
   unit_label = "",
   group = NULL,
@@ -57,7 +57,7 @@ plot_indices <- function(
   # Filter data
   prepared_data <- filter_data(
     dat,
-    label_name = "indices",
+    label_name = "index",
     era = NULL,
     geom = "line",
     # ifelse guarantees the code doesn't miss grouping when label has > 1 value
@@ -98,8 +98,8 @@ plot_indices <- function(
     dat = prepared_data,
     x = "year",
     y = "estimate",
-    observed_label = "indices_observed",
-    predicted_label = "indices_predicted",
+    observed_label = "index_observed",
+    predicted_label = "index_predicted",
     geom = "line",
     xlab = "Year",
     ylab = "Estimated Index",

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)),

R/save_all_plots.R

@@ -80,7 +80,7 @@
 #'
 #' Default: "mt"
 #'
-#' @param indices_unit_label Units for index of abundance/CPUE
+#' @param index_unit_label Units for index of abundance/CPUE
 #'
 #' Default: ""
 #'
@@ -119,7 +119,7 @@
 #' save_all_plots(dat,
 #'   ref_line = "unfished",
 #'   ref_line_sb = "target",
-#'   indices_unit_label = "CPUE",
+#'   index_unit_label = "CPUE",
 #'   biomass_at_age_scale_amount = 1,
 #'   biomass_at_age_unit_label = "metric tons"
 #' )
@@ -150,15 +150,15 @@ save_all_plots <- function(
   # imported from plot_biomass_at_age
   biomass_at_age_scale_amount = 1,
   biomass_at_age_unit_label = "mt",
-  # imported from plot_indices
-  indices_unit_label = "",
+  # 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",
   catch_unit_label = "mt",
   catch_scale_amount = 1
   # imported from table_harvest_projection- add potential unique arguments after dev
-  # imported from table_indices- zero unique arguments
+  # imported from table_index- zero unique arguments
   # imported from table_landings- zero unique arguments
 ) {
   make_rda <- TRUE
@@ -419,18 +419,18 @@ save_all_plots <- function(
 
   tryCatch(
     {
-      cli::cli_h2("plot_indices")
-      plot_indices(dat,
-        unit_label = indices_unit_label,
+      cli::cli_h2("plot_index")
+      plot_index(dat,
+        unit_label = index_unit_label,
         make_rda = TRUE,
         interactive = FALSE,
         figures_dir = figures_tables_dir
       ) # |> suppressWarnings() |> invisible()
     },
     error = function(e) {
-      cli::cli_alert_danger("plot_indices failed to run.")
+      cli::cli_alert_danger("plot_index failed to run.")
       cli::cli_alert("Tip: check that your arguments are correct.")
-      cli::cli_li("indices_unit_label = {indices_unit_label}")
+      cli::cli_li("index_unit_label = {index_unit_label}")
       print(e)
     }
   )
@@ -462,8 +462,8 @@ save_all_plots <- function(
 
   # tryCatch(
   #   {
-  #     cli::cli_h2("table_indices")
-  #     table_indices(
+  #     cli::cli_h2("table_index")
+  #     table_index(
   #       dat,
   #       make_rda = TRUE,
   #       tables_dir = figures_tables_dir
@@ -472,7 +472,7 @@ save_all_plots <- function(
   #     # invisible()
   #   },
   #   error = function(e) {
-  #     cli::cli_alert_danger("table_indices failed to run.")
+  #     cli::cli_alert_danger("table_index failed to run.")
   #     cli::cli_alert("Tip: check that your arguments are correct.")
   #     print(e)
   #   }

R/table_afsc_tier.R

@@ -4,7 +4,7 @@ table_afsc_tier <- function() {
   # -adds make_rda and tables_dir as arguments
   # -defines topic_label, fig_or_table; and
   # -makes an rda if make_rda = TRUE
-  # (see table_indices.R for reference)
+  # (see table_index.R for reference)
   # for the rda-related fxns to work, the final table has to be called tab
 
   # identify output

R/table_harvest_projection.R

@@ -4,7 +4,7 @@ table_harvest_projection <- function() {
   # -adds make_rda and tables_dir as arguments
   # -defines topic_label, fig_or_table; and
   # -makes an rda if make_rda = TRUE
-  # (see table_indices.R for reference)
+  # (see table_index.R for reference)
   # for the rda-related fxns to work, the final table has to be called tab
 
   level <- c(

R/table_index.R

@@ -0,0 +1,182 @@
+#' Index 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: "index_weight",  "index_numbers", "index_expected",
+#' "index_predicted", "index".
+#'
+#' Default: NULL
+#'
+#' @returns A table of observed annual index 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_index(dat)
+#'
+#' table_index(
+#'   dat,
+#'   make_rda = TRUE,
+#'   tables_dir = getwd()
+#' )
+#' }
+table_index <- 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 = "index",
+    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 index 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 index column for every error column -- if not remove the error (can keep index)
+
+  # merge error and index columns and rename
+  df_list <- merge_error(
+    table_data,
+    uncert_lab,
+    fleets,
+    label = "index",
+    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 index 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)
+  }
+}