From 10285186f7e37a951d2e7c802c25497e537a4df3 Mon Sep 17 00:00:00 2001 From: e-perl-NOAA Date: Mon, 10 Aug 2026 14:09:56 -0400 Subject: [PATCH] Some elements of good practices implemented --- DESCRIPTION | 2 +- R/convert_output.R | 13 ------------- R/plot_biomass.R | 3 --- R/table_landings.R | 11 ----------- R/utils_plot.R | 10 ++++++++++ R/utils_rda.R | 4 ++++ R/utils_table.R | 3 +++ 7 files changed, 18 insertions(+), 28 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index a1cc863a..bb02013d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -28,7 +28,7 @@ Description: Creates exploratory and finished tables and figures for stock materials. The advantage of using this package over others is that it applies to a range of stock assessment model outputs and standardizes them. -License: MIT + file LICENSE +License: MIT URL: https://github.com/nmfs-ost/stockplotr, https://noaa-fisheries-integrated-toolbox.r-universe.dev/stockplotr BugReports: https://github.com/nmfs-ost/stockplotr/issues diff --git a/R/convert_output.R b/R/convert_output.R index 0a4b8e43..0c1c246a 100644 --- a/R/convert_output.R +++ b/R/convert_output.R @@ -623,19 +623,6 @@ convert_output <- function( df4 <- df4 |> dplyr::filter(!(label %in% err_names[2:length(err_names)])) } - # Find overlapping error values if still present - find_error_value <- function(column_names, to_match_vector) { - vals <- vapply(column_names, function(col_name) { - match <- vapply(to_match_vector, function(err) { - pattern <- paste0("(^|[_.])", err, "($|[_.])") - if (grepl(pattern, col_name)) err else NA_character_ - }, FUN.VALUE = character(1)) - stats::na.omit(match)[1] - }, FUN.VALUE = character(1)) - # } - # only unique values and those that intersect with values vector - intersect(unique(vals), to_match_vector) - } # SS: I am not entirely sure what this step is doing, but is a good check if (any(grepl(paste(err_names, collapse = "|"), colnames(df4)))) { err_name <- find_error_value(names(df4), errors) diff --git a/R/plot_biomass.R b/R/plot_biomass.R index 45be6d46..74d0d787 100644 --- a/R/plot_biomass.R +++ b/R/plot_biomass.R @@ -1,9 +1,6 @@ #' Plot Total Biomass #' #' @inheritParams plot_spawning_biomass -#' @param unit_label String. Biomass units -#' -#' Default: "mt" #' @param ref_line String. Type of reference point to #' compare biomass to. The default `"msy"` looks for #' `"biomass_msy"` in the `"label"` column of `dat`. The actual diff --git a/R/table_landings.R b/R/table_landings.R index 837656ad..87f8680d 100644 --- a/R/table_landings.R +++ b/R/table_landings.R @@ -1,15 +1,6 @@ #' Landed catch by fleet and year table #' #' @inheritParams plot_recruitment -#' @param unit_label String. Abbreviated landings units -#' -#' Default: "mt" -#' @param group String. 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 String. Method for summarizing data when group #' is set to "none". #' @@ -29,8 +20,6 @@ #' in this ordered list: "landings_weight", "landings_numbers", "landings_expected", #' "landings_predicted", "landings". #' -#' Default: NULL -#' #' @returns A table ready of landed catch by fleet and year. #' #' @details The input is from an assessment model output file diff --git a/R/utils_plot.R b/R/utils_plot.R index 64d22a36..51e3383f 100644 --- a/R/utils_plot.R +++ b/R/utils_plot.R @@ -257,6 +257,7 @@ plot_timeseries <- function( #' @details The user can create a line, point, or area plot, where the x-axis is #' year and y can vary for any time series quantity. Currently, grouping is #' restricted to one group where faceting can be any number of facets. +#' @noRd #' plot_error <- function( dat, @@ -545,6 +546,7 @@ cohort_line <- function( #' @param label_name String. Name of the quantity that users want to #' extract the reference point from #' @param ref_line String. Reference point(s) +#' @param scale_amount The amount to scale the reference line value by. #' @param model_name String. Name of the model that will be present in the legend. #' #' Options: Including, but not limited to: "msy", "unfished", "target" @@ -644,6 +646,14 @@ cap_first_letter <- function(s) { #' @inheritParams plot_spawning_biomass #' @param label_name String. Name of the label used to filter #' the data. +#' @param module A character string specifying the module to filter by. +#' @param era A character string specifying the era to filter by. +#' @param geom The geometric object to use for the plot. +#' @param group The grouping variable for the plot. +#' @param facet The faceting variable for the plot. +#' @param scale_amount The amount to scale the data by. +#' @param interactive A logical value indicating whether to use interactive mode. +#' #' #' @returns a data frame that is preformatted for plotting with ggplot2. #' @export diff --git a/R/utils_rda.R b/R/utils_rda.R index c0fda232..9c6082c3 100644 --- a/R/utils_rda.R +++ b/R/utils_rda.R @@ -20,6 +20,7 @@ #' dat = dat #' ) #' } +#' @noRd calc_kqs <- function(returned_kq, prepared_data = NULL, dat = NULL, @@ -351,6 +352,7 @@ calc_kqs <- function(returned_kq, #' F.max #' ) #' } +#' @noRd fill_in_kqs <- function(df, ...) { arg_names <- sapply(substitute(list(...))[-1], deparse) arg_values <- list(...) @@ -388,6 +390,7 @@ fill_in_kqs <- function(df, ...) { #' F.max #' ) #' } +#' @noRd export_kqs <- function(...) { # Open new or existing key quantities csv if (file.exists(fs::path(getwd(), "key_quantities.csv"))) { @@ -428,6 +431,7 @@ export_kqs <- function(...) { #' F.max #' ) #' } +#' @noRd insert_kqs <- function(...) { if (file.exists(fs::path(getwd(), "captions_alt_text.csv"))) { cli::cli_alert_info("Captions/alternative text file (captions_alt_text.csv) exists. Newly calculated key quantities will be added to it.", wrap = TRUE) diff --git a/R/utils_table.R b/R/utils_table.R index 0935073a..c63b3a6c 100644 --- a/R/utils_table.R +++ b/R/utils_table.R @@ -108,6 +108,8 @@ create_latex_table <- function(data, #' @param id_group String. The identifying index variable as a string #' #' Default: NULL +#' @noRd +#' check_label_differences <- function(dat, index_variables, id_group = NULL) { # Loop over model to perform checks if the model columns are identical @@ -192,6 +194,7 @@ check_label_differences <- function(dat, index_variables, id_group = NULL) { #' @returns List of formatted dataframes that contain column names formatted #' for a table along with a merge of values in the estimate and error columns #' to reduce redundancy in the table. +#' @noRd #' merge_error <- function( table_data,