From a92e893d9c3382002b9bc59d7f7badd856b213e8 Mon Sep 17 00:00:00 2001 From: Schiano-NOAA Date: Mon, 16 Dec 2024 17:11:11 -0500 Subject: [PATCH] fix(b and sb plots): reformat plots so they still fxn even missing the reference line --- R/plot_biomass.R | 56 ++++++++++++++++++++++++++--------- R/plot_spawning_biomass.R | 62 +++++++++++++++++++++++++++++---------- 2 files changed, 88 insertions(+), 30 deletions(-) diff --git a/R/plot_biomass.R b/R/plot_biomass.R index de1b14b..be30594 100644 --- a/R/plot_biomass.R +++ b/R/plot_biomass.R @@ -8,6 +8,10 @@ #' lower-case letters but you must use one of the options specified in the #' default list to ensure that the label on the figure looks correct #' regardless of how it is specified in `dat`. +#' @param ref_point A known value of the reference point along with the label +#' for the reference point as specified in the output file. Please use this +#' option if the ref_line cannot find your desired point. Indicate the +#' reference point in the form c("label" = value). #' @return Plot total biomass from a stock assessment model as found in a NOAA #' stock assessment report. Units of total biomass can either be manually added #' or will be extracted from the provided file if possible. In later releases, model will not @@ -18,14 +22,17 @@ plot_biomass <- function( unit_label = "metric tons", scale_amount = 1, ref_line = c("target", "MSY", "msy", "unfished"), + ref_point = NULL, end_year = NULL, relative = FALSE, make_rda = FALSE, rda_dir = getwd() ){ - if(length(ref_line)>1){ - ref_line = "target" + if (!is.null(ref_point)) { + ref_line <- names(ref_point) + } else if(length(ref_line)>1){ + ref_line <- "target" } else { ref_line <- match.arg(ref_line, several.ok = FALSE) } @@ -39,22 +46,45 @@ plot_biomass <- function( # Select value for reference line and label # update the target option later # TODO: add option to indicate the reference pt - ref_line_val <- as.numeric(dat[ - grep( - pattern = glue::glue("^biomass.*{tolower(ref_line)}$"), - x = dat[["label"]] - ), - "estimate" - ]) + if (!is.null(ref_point)) { + ref_line_val <- as.numeric(ref_point) + } else { + if ( inherits( try( solve(as.numeric(dat[ + grep( + pattern = glue::glue("^biomass.*{tolower(ref_line)}$"), + x = dat[["label"]] + ), + "estimate" + ])), silent = TRUE), "try-error")) { + ref_line_val <- NULL + } else { + ref_line_val <- as.numeric(dat[ + grep( + pattern = glue::glue("^biomass.*{tolower(ref_line)}$"), + x = dat[["label"]] + ), + "estimate" + ]) + } + # ref_line_val <- as.numeric(dat[ + # grep( + # pattern = glue::glue("^biomass.*{tolower(ref_line)}$"), + # x = dat[["label"]] + # ), + # "estimate" + # ]) + } + if (length(ref_line_val) == 0) { - stop(glue::glue( + warning(glue::glue( "The resulting reference value of `biomass_{ref_line}` was not found in `dat[[\"label\"]]`." )) + warning("Reference line will not be plotted on the figure.") } else if (length(ref_line_val) > 1) { warning(glue::glue( "More than one of the resulting reference value of 'biomass_{ref_line}` was - not in `dat[[\"label\"]]`." + not in `dat[[\"label\"]]`. \n Both reference points will be plotted on the figure." )) } @@ -99,9 +129,7 @@ plot_biomass <- function( ymax = estimate_upper), colour = "grey", alpha = 0.3) + - ggplot2::geom_hline( - yintercept = ref_line_val / ifelse(relative, ref_line_val, scale_amount), - linetype = 2) + + {if(!is.null(ref_line_val)) ggplot2::geom_hline(yintercept = ref_line_val / ifelse(relative, ref_line_val, scale_amount),linetype = 2)} + ggplot2::labs( x = "Year", y = biomass_label) + diff --git a/R/plot_spawning_biomass.R b/R/plot_spawning_biomass.R index 1794ba0..d703f76 100644 --- a/R/plot_spawning_biomass.R +++ b/R/plot_spawning_biomass.R @@ -11,6 +11,10 @@ #' lower-case letters but you must use one of the options specified in the #' default list to ensure that the label on the figure looks correct #' regardless of how it is specified in `dat`. +#' @param ref_point A known value of the reference point along with the label +#' for the reference point as specified in the output file. Please use this +#' option if the ref_line cannot find your desired point. Indicate the +#' reference point in the form c("label" = value). #' @return #' Plot spawning biomass from the results of an assessment model translated to #' the standard output. The {ggplot2} object is returned for further @@ -22,13 +26,20 @@ plot_spawning_biomass <- function( unit_label = "metric ton", scale_amount = 1, ref_line = c("target", "unfished", "msy"), + ref_point = NULL, end_year = NULL, relative = FALSE, n_projected_years = 10, make_rda = FALSE, rda_dir = getwd() ) { - ref_line <- match.arg(ref_line) + if (!is.null(ref_point)) { + ref_line <- names(ref_point) + } else if(length(ref_line)>1){ + ref_line <- "target" + } else { + ref_line <- match.arg(ref_line, several.ok = FALSE) + } # TODO: Fix the unit label if scaling. Maybe this is up to the user to do if # they want something scaled then they have to supply a better unit name # or we create a helper function to do this. @@ -49,22 +60,44 @@ plot_spawning_biomass <- function( # Select value for reference line and label # TODO: add case if ref_line not indicated or hard to find - find one of the # options and set as ref_line - ref_line_val <- as.numeric(dat[ - grep( - pattern = glue::glue("^spawning_biomass.*{tolower(ref_line)}"), - x = dat[["label"]] - ), - "estimate" - ]) + if (!is.null(ref_point)) { + ref_line_val <- as.numeric(ref_point) + } else { + if ( inherits( try( solve(as.numeric(dat[ + grep( + pattern = glue::glue("^spawning_biomass.*{tolower(ref_line)}$"), + x = dat[["label"]] + ), + "estimate" + ])), silent = TRUE), "try-error")) { + ref_line_val <- NULL + } else { + ref_line_val <- as.numeric(dat[ + grep( + pattern = glue::glue("^spawning_biomass.*{tolower(ref_line)}$"), + x = dat[["label"]] + ), + "estimate" + ]) + } + # ref_line_val <- as.numeric(dat[ + # grep( + # pattern = glue::glue("^biomass.*{tolower(ref_line)}$"), + # x = dat[["label"]] + # ), + # "estimate" + # ]) + } if (length(ref_line_val) == 0) { - stop(glue::glue( + warning(glue::glue( "The resulting reference value of `spawning_biomass_{ref_line}` was not found in `dat[[\"label\"]]`." )) - } else if (length(ref_line_val > 1)) { + warning("Reference line will not be plotted on the figure.") + } else if (length(ref_line_val) > 1) { warning(glue::glue( - "More than one of the resulting reference value of `spawning_biomass_{ref_line}` was - not in `dat[[\"label\"]]`." + "More than one of the resulting reference value of 'spawing_biomass_{ref_line}` was + not in `dat[[\"label\"]]`. \n Both reference points will be plotted on the figure." )) } sb <- dat |> @@ -99,10 +132,7 @@ plot_spawning_biomass <- function( ), linewidth = 1 ) + - ggplot2::geom_hline( - yintercept = ref_line_val / ifelse(relative, ref_line_val, scale_amount), - linetype = 2 - ) + + {if(!is.null(ref_line_val)) ggplot2::geom_hline(yintercept = ref_line_val / ifelse(relative, ref_line_val, scale_amount),linetype = 2)} + # Only add confidence intervals for the non NA estimates # which allows for no warnings if uncertainty = NA ggplot2::geom_ribbon(