[Feature]: add option to convert plot units to lbs

DESCRIPTION

@@ -20,7 +20,7 @@ Description: Creates exploratory and finished tables and figures for stock
     interprets outputs of stock assessment models as well as allows the
     analyst to create report ready tables and figures, reducing the need
     to create their own and format then when adding into a report. This
-    package is intended to be used in conjuction with {asar}, a partially
+    package is intended to be used in conjuction with 'asar', a partially
     automated template for writing various stock assessment reports.
     Throughout development, we will be creating a set of standardized
     figures and tables for a stock assessment report, developing functions

R/data.R

@@ -0,0 +1,43 @@
+#' SS3 Example data
+#'
+#' Included data set that represents a Report.sso file converted using 
+#' convert_output(). This example is from the 2022 Petrale sole stock assessment.
+#'
+#' @format A tibble with 591109 rows and 33 variables:
+#' \describe{
+#'   \item{label}{standard name for estimate or value name}
+#'   \item{estimate}{actual value of the label}
+#'   \item{year}{annual indexing value}
+#'   \item{fleet}{names of fleets or surveys indexed by the data}
+#'   \item{sex}{native reference to male, female, unknown, or none}
+#'   \item{area}{specified areas by the model}
+#'   \item{growth_pattern}{indexing column of data}
+#'   \item{uncertainty}{value of uncertainty associated with the label column}
+#'   \item{uncertainty_label}{uncertainty label or name associated with the label columns}
+#'   \item{module_name}{name of keyword (SS3) or list indexing in the original model output for tracking purposes}
+#'   \item{time}{time sometimes referenced in decimals to the year and month}
+#'   \item{era}{"time" for current time series in model; "fore" representing the projected or forecasted years of the model}
+#'   \item{month}{month factor}
+#'   \item{season}{season usually associated with year}
+#'   \item{subseason}{subseason when used}
+#'   \item{birthseas}{birthseason found in SS3}
+#'   \item{initial}{initial input value in the model when available associated with the label column}
+#'   \item{likelihood}{likelihood value for the data point}
+#'   \item{platoon}{platoon also an SS3 indexing value}
+#'   \item{age}{age of fish}
+#'   \item{bio_pattern}{indexing column of data}
+#'   \item{settlement}{indexing column of data}
+#'   \item{morph}{indexing column of data}
+#'   \item{type}{indexing column of data}
+#'   \item{factor}{indexing column of data}
+#'   \item{part}{indexing column of data}
+#'   \item{kind}{indexing column of data}
+#'   \item{nsim}{indexing column of data}
+#'   \item{bin}{indexing column of data}
+#'   \item{age_a}{alterative age column}
+#'   \item{length_bins}{length bins for composition or other length based data}
+#'   \item{count}{indexing column of data}
+#'   \item{block}{indexing column of data}
+#' }
+#' 
+"example_data"

R/plot_fishing_mortality.R

@@ -78,7 +78,6 @@ plot_fishing_mortality <- function(
   final <- reference_line(
     plot = plt,
     dat = dat,
-    # era = "time",
     label_name = "fishing_mortality",
     reference = ref_line,
     scale_amount = 1

R/plot_landings.R

@@ -34,6 +34,7 @@ plot_landings <- function(
   geom = "line",
   group = NULL,
   facet = NULL,
+  lbs = FALSE,
   era = NULL,
   scale_amount = 1,
   module = NULL,
@@ -42,11 +43,17 @@ plot_landings <- function(
   figures_dir = getwd(),
   ...
 ) {
+  # this assumes that the previous units were metric tons
+  if (lbs && unit_label %notin% c("lbs", "pounds", "lb")) {
+    cli::cli_alert_info("Unit label was not changed. Setting unit_label to 'lbs'.")
+    unit_label <- "lbs"
+  }
+
   # Units
   landings_label <- label_magnitude(
     label = "Landings",
     unit_label = unit_label,
-    scale_amount = scale_amount,
+    scale_amount = dplyr::if_else(lbs, 1000 * scale_amount, scale_amount),
     legend = FALSE
   )
 
@@ -69,7 +76,8 @@ plot_landings <- function(
     dat = prepared_data,
     group = group,
     facet = facet,
-    method = "sum"
+    method = "sum",
+    lbs = lbs
   )
   prepared_data <- processed_data[[1]]
   group <- processed_data[2]

R/plot_spawning_biomass.R

@@ -32,10 +32,15 @@
 #' Default: "target"
 #'
 #' Options: (including, but not limited to) "target", "msy", and "unfished"
-#' If the reference point is not found in the data, set ref_line = c("{name}" = value).
+#' If the reference point is not found in the data, set ref_line = c("name" = value).
 #' @param unit_label A string specifying spawning biomass unit.
 #'
 #' Default: "metric tons"
+#' @param lbs A logical value indicating whether to convert the y-axis values from
+#' kilograms to pounds. The default units match the default in the
+#' unit_label argument - 'metric tons'. 
+#'
+#' Default: `FALSE`
 #' @param module (Optional) A string indicating the module_name found in `dat`.
 #'
 #' Default: NULL
@@ -104,6 +109,7 @@ plot_spawning_biomass <- function(
   ref_line = "msy",
   unit_label = "metric tons",
   era = NULL,
+  lbs = FALSE,
   module = NULL,
   scale_amount = 1,
   relative = FALSE,
@@ -112,6 +118,12 @@ plot_spawning_biomass <- function(
   interactive = TRUE,
   ...
 ) {
+  # this assumes that the previous units were metric tons
+  if (lbs && unit_label %notin% c("lbs", "pounds", "lb")) {
+    cli::cli_alert_info("Unit label was not changed. Setting unit_label to 'lbs'.")
+    unit_label <- "lbs"
+  }
+
   # 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.
@@ -122,7 +134,11 @@ plot_spawning_biomass <- function(
       label_magnitude(
         label = "Spawning Biomass",
         unit_label = unit_label,
-        scale_amount = scale_amount,
+        scale_amount = dplyr::if_else(
+          lbs, 
+          ifelse(unit_label %in% c("mt", "mts", "metric tons", "metric ton"), 1000, 1) * scale_amount, 
+          scale_amount
+          ),
         legend = TRUE
       )
     }
@@ -164,7 +180,8 @@ plot_spawning_biomass <- function(
     dat = prepared_data,
     group = group,
     facet = facet,
-    method = "sum"
+    method = "sum",
+    lbs = lbs
   )
   # variable <- processing[[1]]
   plot_data <- processing[[1]]
@@ -212,35 +229,13 @@ plot_spawning_biomass <- function(
       final <- reference_line(
         plot = plt,
         dat = rp_dat,
+        lbs = lbs,
         label_name = "spawning_biomass",
         reference = ref_line,
         scale_amount = scale_amount
       ) + theme_noaa()
     }
   }
-
-
-  # Plot vertical lines if era is not filtering
-  # Turning this out because I don't think it's relevant
-  # if (is.null(era)) {
-  #   # Find unique era
-  #   eras <- unique(plot_data$era)
-  #   if (length(eras) > 1) {
-  #     year_vlines <- c()
-  #     for (i in 2:length(eras)) {
-  #       erax <- plot_data |>
-  #         dplyr::filter(era == eras[i]) |>
-  #         dplyr::pull(year) |>
-  #         min(na.rm = TRUE)
-  #       year_vlines <- c(year_vlines, erax)
-  #     }
-  #   }
-  #   final <- final +
-  #     ggplot2::geom_vline(
-  #       xintercept = year_vlines,
-  #       color = "#999999"
-  #     )
-  # }
 
   ### Make RDA ----
   if (make_rda) {

R/process_data.R

@@ -10,6 +10,9 @@
 #' want to just summarize the data across all factors, set group = "none".
 #' @param facet A string or vector of strings identifying the faceting
 #' variable(s) of the data.
+#' @param lbs A logical value indicating whether to convert the y-axis values to pounds.
+#'
+#' Default: `FALSE`
 #' @param method A string describing the method of summarizing data when group
 #' is set to "none". Options are "sum" or "mean". Default is "sum".
 #'
@@ -42,6 +45,7 @@ process_data <- function(
   dat,
   group = NULL,
   facet = NULL,
+  lbs = FALSE,
   method = "sum"
 ) {
   # check if >1 model
@@ -105,18 +109,6 @@ process_data <- function(
     }
   }
   # Set group_var to identified grouping
-  # if (!is.null(group) && group == "none") {
-  #   # if group is none and there exists an index group, filter to nas of index group
-  #   # commented out bc this issue is solved in the above 1st step
-  #   if (length(id_group) > 0) {
-  #     data <- dplyr::filter(
-  #       dat,
-  #       is.na(.data[[id_group[1]]])
-  #     )
-  #   } else {
-  #     data <- dat
-  #   }
-  # } else
   if (!is.null(group) && group != "none") {
     data <- dplyr::mutate(
       dat,
@@ -147,7 +139,6 @@ process_data <- function(
   if ("age" %in% colnames(data) && any(!is.na(data$age))) {
     # subset out nas if ages exist for this
     # not sure if  this works for all cases -- are there situations where we want the NA and not age?
-
     data <- dplyr::filter(data, !is.na(age))
     if (!is.null(group) && group == "age") {
       if ("age" %in% index_variables) index_variables <- index_variables[-grep("age", index_variables)]
@@ -159,18 +150,12 @@ process_data <- function(
   # move year to another check -- age always used?
   if ("year" %in% colnames(data) && any(!is.na(data$year))) {
     data <- dplyr::filter(data, !is.na(year))
-    # if (!is.null(group) && group == "year") {
     if ("year" %in% index_variables) index_variables <- index_variables[-grep("year", index_variables)]
-    # }
-    # if (!is.null(facet) && facet == "year") {
-    #   if ("year" %in% index_variables) index_variables <- index_variables[-grep("year", index_variables)]
-    # }
   }
 
   # Set any remaining index variables to group (first) and facet
   # Check if this is still the case if a group not NULL
   if (!is.null(group) && group != "year") {
-    # if () {
     # Remove NAs from grouping or keep NA if none
     if (group != "none") {
       data <- dplyr::filter(data, !is.na(.data[[group]]))
@@ -182,17 +167,6 @@ process_data <- function(
           values_from = estimate,
           values_fn = list
         )
-      # overwrite variable if grouping is what makes it variable in above conditions
-      # variable <- ifelse(
-      #   any(length(unique(
-      #     dplyr::select(
-      #       check_group_data,
-      #       dplyr::any_of(unique(data[[group]]))
-      #     )
-      #   )) > 1),
-      #   TRUE,
-      #   FALSE
-      # )
     }
 
     # add any remaining index_variables into facet
@@ -242,13 +216,10 @@ process_data <- function(
         index_variables <- index_variables[-grepl(valid_vars[1], index_variables)]
         # Don't want to filter by group if model is present because the index_var could be NA for one of the models
         # TODO: perform check or adjust function in case when index_var is present for one model and not other
-        # This would cause the plot to be weird
-        # data <- dplyr::filter(data, !is.na(.data[[group]]))
       } else { # ALL FALSE
         # remove index variables and set group to model
         # at this point in the function, year and age should be removed anyway from index_variables
         index_variables <- NULL
-        # group <- "model"
       }
 
       # Remaining id'd index variables moved to facet
@@ -281,11 +252,6 @@ process_data <- function(
     # check if value varies in ANY year
     # pivot data for 1st indexed data and check if all the same
     if (length(index_variables) > 0) {
-      # if (index_variables == "age" | index_variables == "year") {
-      #   # if age or year is the only other index variable, then get data so there is a single column as expected in column_data
-      #   pivot_data <- data
-      #   column_data <- pivot_data[["estimate"]]
-      # } else {
       pivot_data <- data |>
         dplyr::select(tidyselect::any_of(c("year", "age", "estimate", index_variables))) |>
         tidyr::pivot_wider(
@@ -307,10 +273,6 @@ process_data <- function(
         ) |>
         suppressWarnings()
       column_data <- pivot_data[-1]
-      # column_data <- pivot_data[[
-      #   unique(
-      #     data[["group_var"]]
-      #   )[1]]]
     }
     # compare grouping columns to see if all the same
     first_year_data <- column_data[[1]]
@@ -324,13 +286,6 @@ process_data <- function(
       # if TRUE filter out to only one year bc everything else redundant
       # check if same through all years
       if (length(unique(first_year_data)) > 1) {
-        # this step might be redundant
-        # data <- data |>
-        #   dplyr::mutate(group_var = dplyr::case_when(
-        #     # !is.null(group) & group == index_variables[1] ~ .data[[index_variables[1]]],
-        #     is.null(group) & length(index_variables) > 0 ~ .data[[index_variables[1]]],
-        #     TRUE ~ group_var
-        #   ))
         if (is.na(unique(data[["group_var"]])[1])) {
           data <- data |> dplyr::filter(is.na(group_var))
         } else {
@@ -366,6 +321,16 @@ process_data <- function(
         as.character
       )
     )
+
+  if (lbs) {
+    data <- data |>
+      dplyr::mutate(
+        # multiple by conversion from kg to lbs -- default then becomes thousands of lbs
+        estimate = (estimate * 2.20462),
+        estimate_lower = NA_real_, #(estimate_lower * 2.20462),
+        estimate_upper = NA_real_, #(estimate_upper * 2.20462)
+      )
+  }
 
   # Export list of objects
   list(