[feat]: plot_spr

R/plot_spr.R

@@ -0,0 +1,164 @@
+#' Plot spawning potential ratio (SPR)
+#'
+#' @inheritParams plot_spawning_biomass
+#' 
+#' @param ylab String. Y-axis label to show.
+#'
+#' @returns A plot showing spawning potential ratio (SPR).
+#'
+#' @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 `ggplot2` object or export an .rda object
+#' containing associated caption and alternative text for the figure.
+#'
+#' @seealso [convert_output()], [filter_data()], [process_data()], [plot_timeseries()], [export_kqs()], [insert_kqs()], [create_rda()]
+#'
+#' @export
+#'
+#' @examples
+#' plot_spawning_potential_ratio(
+#'   dat = stockplotr:::example_data,
+#'   unit_label = "metric tons",
+#'   group = "fleet",
+#'   interactive = FALSE,
+#'   make_rda = FALSE,
+#'   ylab = "SPR"
+#' )
+#' plot_spawning_potential_ratio(
+#'   dat = stockplotr:::example_data,
+#'   unit_label = "metric tons",
+#'   facet = "fleet",
+#'   module = "DERIVED_QUANTITIES",
+#'   interactive = FALSE,
+#'   make_rda = FALSE,
+#'   ylab = "(1-SPR)/(1-SPR_ref)"
+#' )
+plot_spawning_potential_ratio <- function(
+  dat,
+  geom = "line",
+  group = NULL,
+  facet = NULL,
+  ref_line = "target",
+  era = "time",
+  module = NULL,
+  interactive = TRUE,
+  make_rda = FALSE,
+  figures_dir = getwd(),
+  ylab = NULL,
+  ...
+) {
+
+  # Filter data for spr
+  prepared_data <- filter_data(
+    dat = dat,
+    label_name = "spr",
+    geom = geom,
+    #TODO: change this to era once stockplotr::example_data updated
+    era = NULL,
+    group = group,
+    facet = facet,
+    module = module,
+    scale_amount = 1,
+    interactive = interactive
+  ) |>
+    # filter NA from year
+    dplyr::filter(!is.na(year))
+
+  if(nrow(prepared_data)==0){
+    # We could potentially make this more informative if we know the model type
+    # by reporting the common MODULE used by other packages (e.g., DERIVED_QUANTITIES
+    # for SS3 models, or t.series for BAM models).
+    cli::cli_alert(glue::glue("There is no data available to be plotted. Try selecting a different module."))
+  }
+
+  # Process data
+  processed_data <- process_data(
+    dat = prepared_data,
+    group = group,
+    facet = facet#
+    # method = "sum"
+  )
+  prepared_data <- processed_data[[1]]
+  group <- processed_data[2]
+  facet <- processed_data[[3]]
+
+  # Check if there is >1 label
+  if (length(prepared_data$label) > 1) {
+    prepared_data <- prepared_data |>
+      # always select the first label if TRUE
+      dplyr::filter(label == unique(label)[1])
+  }
+
+  # Override grouping variable when there is only NA's
+  if (!is.null(group)) {
+    if (group %notin% colnames(prepared_data)) group <- NULL
+  }
+
+  # inital base plot
+  plt <- plot_timeseries(
+    dat = prepared_data,
+    y = "estimate",
+    geom = geom,
+    ylab = ylab,
+    group = group,
+    facet = facet,
+    ...
+  ) +
+    ggplot2::geom_hline(yintercept = 1,
+                        color = "grey") +
+    ggplot2::geom_hline(yintercept = 0,
+                        color = "grey") +
+    add_reference_line(
+      dat = dat,
+      ref_line = ref_line,
+      label = "spr",
+      scale_amount = 1
+    ) +
+    theme_noaa()
+
+
+  if (length(unique(prepared_data$group_var)) == 1) {
+    plt <- plt + ggplot2::theme(legend.position = "none")
+  }
+
+  ### Make RDA ----
+  if (make_rda) {
+    # TODO: Update caption, alt text, and quantities once plot is finalized
+    # Obtain relevant key quantities for captions/alt text
+
+    spr.start.year <- min(prepared_data$year)
+    spr.end.year <- max(prepared_data$year)
+    spr.min <- min(prepared_data$estimate) |> round(digits = 3)
+    spr.max <- max(prepared_data$estimate) |> round(digits = 3)
+    spr.ref.pt <- as.character(ref_line)
+
+    # calculate & export key quantities
+    export_kqs(
+      spr.start.year,
+      spr.end.year,
+      spr.min,
+      spr.ref.pt
+    )
+
+    # Add key quantities to captions/alt text
+    insert_kqs(
+      spr.start.year,
+      spr.end.year,
+      spr.min,
+      spr.max,
+      spr.ref.pt
+    )
+
+    create_rda(
+      object = plt,
+      # get name of function and remove "plot_" from it
+      topic_label = gsub("plot_", "", utils::tail(as.character(sys.call()[[1]]), n = 1)),
+      fig_or_table = "figure",
+      dat = dat,
+      dir = figures_dir,
+      scale_amount = 1
+    )
+  }
+  # Output final plot
+  plt
+}

inst/resources/bam_var_names.csv

@@ -45,7 +45,7 @@ parms,rstyr.r0,recruitment_start_year_R0,
 parms,Mean.biascorr,bias_correction,
 parms,mean.r0,mean_R0,
 parms,Mean.R,recruitment,
-parms,Phi,phi,,
+parms,Phi,phi,
 parms,rec.mu.end,rec_mu_end,
 parms,R.sigma.logdevs,R_sigma_logdevs,
 parms,R.sigma.par,R_sigma_par,
@@ -260,13 +260,13 @@ a.series,Nage.eq.init,Nage_eq_init,
 a.series,log.Nage2plus.init.dev,log_Nage2plus_plus.init_dev,
 eq.series,F.eq,fishing_mortality,
 eq.series,spr.eq,spr,
-eq.series,R.eq,recruitment,
+eq.series,R.eq,spr,
 eq.series,SSB.eq,spawning_biomass,kg
 eq.series,B.eq,biomass,kg
 eq.series,L.eq.klb,landings_weight,lbs
 eq.series,D.eq.knum,discard_numbers,numbers
 eq.series,D.eq.klb,discard_weight,lbs
-pr.series,F.spr,f_spr,
+pr.series,F.spr,fishing_mortality_spr,
 pr.series,spr,spr,
 pr.series,SPR,spr,
 pr.series,ypr.lb,ypr,lbs

inst/resources/captions_alt_text_template.csv

@@ -26,7 +26,7 @@ recruitment_deviations,figure,Annual deviations (on natural log scale) in the nu
 tot.b,figure,Estimated biomass (B) time series. The horizontal dashed line represents the biomass limit reference point at B.ref.pt B.units.,"Line graph showing estimated biomass time series. The x axis shows the year, which spans from B.start.year to B.end.year. The y axis shows estimated biomass in B.units, which spans from B.min to B.max."
 spawning_biomass,figure,Estimated spawning biomass (SB) time series. The horizontal dashed line represents the spawning biomass associated with the biomass limit reference point (ssb.ref.pt ssb.units).,"Line graph showing estimated spawning biomass. The x axis shows the year, which spans from ssb.start.year to ssb.end.year. The y axis shows estimated spawning biomass in ssb.units, which spans from ssb.min to ssb.max."
 relative.spawning.biomass,figure,Estimated relative spawning biomass time series. The horizontal dashed line represents the limit reference point calculated as SB/SB(reference point) (ssb.ref.pt ssb.units).,"Line graph showing estimated relative spawning biomass. The x axis shows the year, which spans from ssb.start.year to ssb.end.year. The y axis shows estimated relative spawning biomass (SB/SB~target~), which spans from rel.ssb.min to rel.ssb.max ssb.units."
-spr,figure,Estimated spawning potential ratio (SPR) (SB~current~/SB~target~) time series. The horizontal dashed line represents the spawning potential ratio of the limit reference point at spr.ref.pt.,"Line graph showing estimated spawning potential ratio over time. The x axis shows the year, which spans from ssb.start.year to ssb.end.year. The y axis shows estimated spawning potential ratio in SB~current~/SB~target~, which spans from spr.min to spr.max."
+spr,figure,Estimated spawning potential ratio (SPR) (SB~current~/SB~target~) time series. The horizontal dashed line represents the spawning potential ratio of the target reference point at spr.ref.pt.,"Line graph showing estimated SPR over time. The x axis shows the year, which spans from spr.start.year to spr.end.year. The y axis shows estimated SPR, which spans from spr.min to spr.max."
 biomass_at_age,figure,Estimated population numbers at age and population biomass at age over time. The relative size of each bubble for a given year and age indicates the relative abundance or biomass in that category compared with others. ,"Bubble plot showing estimated population numbers at age and population biomass at age. The x axis shows the year, which spans from pop.baa.start.year to pop.baa.end.year. The y axis shows age, which spans from pop.baa.age.min to pop.baa.age.max. The size of the bubbles range from pop.baa.fish.min to pop.baa.fish.max."
 proj.catch,figure,Forecasted catch in proj.catch.units over future years for different fishing mortality scenarios as indicated in the legend.,"Time series line graph showing forecasted catch over future years for different fishing mortality scenarios. The x axis shows the year, which spans from proj.catch.start.year to proj.catch.end.year. The y axis shows catch in proj.catch.units, which spans from proj.catch.min to proj.catch.max."
 proj.biomass,table,Forecasted biomass over future years for different fishing mortality scenarios.,

inst/resources/key_quantity_template.csv

@@ -114,6 +114,8 @@ rel.ssb.max,,maximum relative spawning biomass,,,,
 rel.ssb.min,,minimum relative spawning biomass,,,,
 selectivity.end.year,,final year for selectivity estimates,,,,
 selectivity.start.year,,start year for selectivity estimates,,,,
+spr.start.year,,start year of SPR timeseries,,,,
+spr.end.year,,end year of SPR timeseries,,,,
 selectivity.type.cap,,type of selectivity,,,,
 selectivity.type.low,,type of selectivity (lowercase),,,,
 selectivity.x,,units for age or length,,,,

inst/resources/rceattle_var_names.csv

@@ -170,7 +170,7 @@ quantities,sb0,spawning_biomass_0,mt
 quantities,sbf,spawning_biomass_target,mt
 quantities,sel,selectivity,
 quantities,sel_at_age,selectivity_age,
-quantities,spr0,,
+quantities,spr0,spr_0,
 quantities,sprfinit,spr_initial,
 quantities,sprlimit,spr_limit,
 quantities,sprtarget,spr_target,

inst/resources/ss3_var_names.csv

@@ -19,7 +19,7 @@ DERIVED_QUANTITIES,SPR_Btgt,spr_biomass_target,
 DERIVED_QUANTITIES,annF_Btgt,annual_fishing_mortality_biomass_target,
 DERIVED_QUANTITIES,Dead_Catch_Btgt,dead_catch_biomass_target,kg
 DERIVED_QUANTITIES,SSB_SPR,spawning_biomass_spr,
-DERIVED_QUANTITIES,annF_SPR,annual_fishing_mortality_spr,
+DERIVED_QUANTITIES,annF_SPR,fishing_mortality_spr,
 DERIVED_QUANTITIES,Dead_Catch_SPR,dead_catch_spr,
 DERIVED_QUANTITIES,SSB_MSY,spawning_biomass_msy,kg
 DERIVED_QUANTITIES,SPR_MSY,spr_msy,

tests/testthat/test-plot_spawning_potential_ratio.R

@@ -0,0 +1,47 @@
+test_that("plot_spawning_potential_ratio generates plots without errors", {
+  # expect error-free plot with minimal arguments
+  expect_no_error(
+    plot_spawning_potential_ratio(stockplotr::example_data, interactive = FALSE)
+  )
+
+  # expect error-free plot with many arguments
+  expect_no_error(
+    plot_spawning_potential_ratio(
+      stockplotr::example_data,
+      # quantity = "spr_ratio",
+      interactive = FALSE,
+      ref_line = "biomass_target"
+    )
+  )
+
+
+  # expect ggplot object is returned
+  expect_s3_class(
+    plot_spawning_potential_ratio(
+      stockplotr::example_data,
+      interactive = FALSE,
+      ref_line = c("target" = 0.80)
+    ),
+    "gg"
+  )
+})
+
+test_that("rda file made when indicated", {
+  # export rda
+  plot_spawning_potential_ratio(
+    stockplotr::example_data,
+    ref_line = "msy",
+    module = "DERIVED_QUANTITIES",
+    make_rda = TRUE,
+    figures_dir = getwd()
+  )
+
+  # expect that both figures dir and the spawning_biomass_figure.rda file exist
+  expect_true(dir.exists(fs::path(getwd(), "figures")))
+  expect_true(file.exists(fs::path(getwd(), "figures", "spawning_potential_ratio_figure.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(), "figures"), recursive = T)
+})