Extracting numeric (key) quantities

R/exp_all_figs_tables.R

@@ -9,7 +9,7 @@
 #' @param ref_line_sb Identical definition as `ref_line`, but this argument is
 #' applied to plot_spawning_biomass.
 #'
-#' @return
+#' @return Rda files (if make_rda = TRUE) for each figure/table.
 #'
 #' @export
 #'
@@ -28,7 +28,6 @@ exp_all_figs_tables <- function(
   end_year = NULL,
   n_projected_years = 10,
   relative = FALSE,
-  make_rda = FALSE,
   rda_dir = getwd(),
 
   # imported from plot_biomass
@@ -53,6 +52,8 @@ exp_all_figs_tables <- function(
 
 ) {
 
+  make_rda = TRUE
+
   # figures
 
   satf::plot_recruitment(dat,

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,22 +129,32 @@ 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) +
     ggplot2::scale_x_continuous(
       n.breaks = x_n_breaks,
-      guide = ggplot2::guide_axis(minor.ticks = TRUE))
+      guide = ggplot2::guide_axis(minor.ticks = TRUE)) +
+    ggplot2::annotate(
+      geom = "text",
+      x = end_year + 0.05,
+      y = ref_line_val / ifelse(relative, ref_line_val, scale_amount),
+      label = list(bquote(B[.(ref_line)])),
+      parse = TRUE
+    )
 
   plt_fin <- add_theme(plt)
 
   # export figure to rda if argument = T
   if (make_rda == TRUE){
     # create plot-specific variables to use throughout fxn for naming and IDing
-    topic_label <- "biomass"
+    # Indicate if biomass is relative or not
+    if (relative) {
+      topic_label <- "relative_biomass"
+    } else {
+      topic_label <- "biomass"
+    }
 
     # identify output
     fig_or_table <- "figure"

R/plot_recruitment.R

@@ -106,7 +106,12 @@ plot_recruitment <- function(
   # export figure to rda if argument = T
   if (make_rda == TRUE){
     # create plot-specific variables to use throughout fxn for naming and IDing
-    topic_label <- "recruitment"
+      # Indicate if recruitment is relative or not
+      if (relative) {
+          topic_label <- "relative_recruitment"
+      } else {
+          topic_label <- "recruitment"
+      }
 
     # identify output
     fig_or_table <- "figure"

R/plot_recruitment_deviations.R

@@ -1,6 +1,6 @@
 #' Plot Recruitment Deviations
 #'
-#'  @inheritParams plot_recruitment
+#' @inheritParams plot_recruitment
 #'
 #' @return Plot recruitment deviations relative to one over time from an
 #' assessment model output file translated to a standardized output. There are

R/plot_spawn_recruitment.R

@@ -1,8 +1,8 @@
 #' Plot Spawn-Recruit Curve
 #'
-#'  @inheritParams plot_recruitment
-#'  @param spawning_biomass_label Units for spawning biomass
-#'  @param recruitment_label units for recruitment
+#' @inheritParams plot_recruitment
+#' @param spawning_biomass_label Units for spawning biomass
+#' @param recruitment_label units for recruitment
 #'
 #' @return Plot spawning recruitment relationship from a standardized output file originating from asar::convert_output()
 #' @export

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(
@@ -136,8 +166,12 @@ plot_spawning_biomass <- function(
   # export figure to rda if argument = T
   if (make_rda == TRUE) {
     # create plot-specific variables to use throughout fxn for naming and IDing
-    topic_label <- "spawning_biomass"
-
+    # Indicate if spawning biomass is relative or not
+    if (relative) {
+      topic_label <- "relative_spawning_biomass"
+    } else {
+      topic_label <- "spawning_biomass"
+    }
     # identify output
     fig_or_table <- "figure"
 

R/utils.R

@@ -55,12 +55,12 @@ export_rda <- function(plt_fin = plt_fin,
   }
 
   # check if an rda_files folder already exists; if not, make one
-  if (!dir.exists(file.path(rda_dir, "rda_files"))) {
-    dir.create(file.path(rda_dir, "rda_files"))
+  if (!dir.exists(fs::path(rda_dir, "rda_files"))) {
+    dir.create(fs::path(rda_dir, "rda_files"))
   }
 
   save(rda,
-       file = file.path(rda_dir,
+       file = fs::path(rda_dir,
                         "rda_files",
                         paste0(topic_label, "_", fig_or_table, ".rda")))
 }