Bug fixes id'd from workshop

.github/workflows/update-example-data.yml

@@ -0,0 +1,37 @@
+# Update example data when convert_output.R changes
+name: update-example-data
+on:
+  push:
+    branches: [main]
+    paths:
+      - 'R/convert_output.R'
+  workflow_dispatch:
+jobs:
+  update-example-data:
+    runs-on: ubuntu-latest
+    permissions:
+      contents: write
+    steps:
+      - uses: actions/checkout@v4
+
+      - uses: r-lib/actions/setup-r@v2
+        with:
+          use-public-rspm: true
+
+      - uses: r-lib/actions/setup-r-dependencies@v2
+        with:
+          extra-packages: any::usethis, local::.
+
+      - name: Update example data
+        run: |
+          example_data <- stockplotr::convert_output(file = "inst/extdata/Report.sso")
+          usethis::use_data(example_data, overwrite = TRUE)
+        shell: Rscript {0}
+
+      - name: Commit and push updated example data
+        run: |
+          git config user.name "github-actions[bot]"
+          git config user.email "41898282+github-actions[bot]@users.noreply.github.com"
+          git add data/example_data.rda
+          git diff --cached --quiet || git commit -m "chore: update example_data from convert_output.R changes (triggered by $(git log -1 --pretty=format:'%h %s' HEAD)) [skip ci]"
+          git push

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: stockplotr
 Title: Tables and Figures for Stock Assessments
-Version: 0.9.0
+Version: 0.10.0
 Authors@R: c(
     person("Samantha", "Schiano", , "samantha.schiano@noaa.gov", role = c("aut", "cre"),
            comment = c(ORCID = "0009-0003-3744-6428")),
@@ -47,6 +47,7 @@ Imports:
     kableExtra,
     naniar,
     prodlim,
+    purrr,
     quarto,
     rlang,
     scales,

NAMESPACE

@@ -17,6 +17,7 @@ export(plot_fishing_mortality)
 export(plot_indices)
 export(plot_landings)
 export(plot_natural_mortality)
+export(plot_obsvpred)
 export(plot_recruitment)
 export(plot_recruitment_deviations)
 export(plot_spawning_biomass)

R/plot_fishing_mortality.R

@@ -86,7 +86,7 @@ plot_fishing_mortality <- function(
   final <- reference_line(
     plot = plt,
     dat = dat,
-    era = "time",
+    # era = "time",
     label_name = "fishing_mortality",
     reference = ref_line,
     relative = relative,

R/plot_indices.R

@@ -23,7 +23,7 @@ plot_indices <- function(
   unit_label = "",
   group = NULL,
   # facet always assigned to fleet since that is how indices are calc'd -- unless replaced with NULL
-  facet = "fleet",
+  facet = NULL,
   interactive = TRUE,
   module = NULL,
   focus = NULL,
@@ -63,55 +63,53 @@ plot_indices <- function(
     prepared_data <- prepared_data |>
       dplyr::filter(fleet %in% focus)
   }
+
+  processed_data <- process_data(
+    dat = prepared_data,
+    group = group,
+    facet = facet
+  )
+  prepared_data <- processed_data[[1]]
+  group <- processed_data[[2]]
+  facet <- processed_data[[3]]
 
-  # identify if there is >1 label and create plot
-  if (length(unique(prepared_data$label)) > 1) {
-    # move label to grouping and set grouping into facet
-    if (!is.null(group)) {
-      facet <- c(facet, group)
-    }
-    # transform prep data so group_var = label
-    prepared_data <- prepared_data |>
-      dplyr::mutate(
-        group_var = label
-      )
-    # plot time series with multiple labels
-    plt <- plot_timeseries(
-      dat = prepared_data,
-      ylab = u_units,
-      group = "label",
-      facet = facet,
-      # linewidth = 1,
-      ...
-    ) +
-      # commenting out but might need this later -- not sure if this will always be true
-      ggplot2::labs(
-        linetype = "",
-        fill = ""
-      ) +
-      theme_noaa() +
-      ggplot2::scale_x_continuous(
-        breaks = ggplot2::waiver(),
-        # labels = scales::label_number(accuracy = 1),
-        guide = ggplot2::guide_axis(
-          minor.ticks = TRUE
-        )
+  # move label to grouping and set grouping into facet
+  if (!is.null(group)) {
+    facet <- c(facet, group)
+  }
+  # transform prep data so group_var = label
+  # prepared_data <- prepared_data |>
+  #   dplyr::mutate(
+  #     group_var = label
+  #   )
+  # plot time series with multiple labels
+  plt <- plot_obsvpred(
+    dat = prepared_data,
+    x = "year",
+    y = "estimate",
+    observed_label = "indices_observed",
+    predicted_label = "indices_predicted",
+    geom = "line",
+    xlab = "Year",
+    ylab = "Estimated Index",
+    group = group,
+    facet = facet
+  ) +
+    theme_noaa() +
+    ggplot2::scale_x_continuous(
+      breaks = ggplot2::waiver(),
+      # labels = scales::label_number(accuracy = 1),
+      guide = ggplot2::guide_axis(
+        minor.ticks = TRUE
       )
-    # Overwrite facets from base plot_timeseries bc scales need to be free
+    )
+  # Overwrite facets from base plot_timeseries bc scales need to be free
+  if ("fleet" %in% colnames(prepared_data)) {
     facet <- paste("~", paste(facet, collapse = " + "))
     facet_formula <- stats::reformulate(facet)
     plt <- plt + ggplot2::facet_wrap(facet_formula, scales = "free")
-  } else {
-    # plot time series
-    plt <- plot_error(
-      dat = prepared_data,
-      ylab = u_units,
-      group = group,
-      facet = facet,
-      ...
-    )
   }
-
+  
   ### Make RDA ----
   if (make_rda) {
 

R/plot_recruitment.R

@@ -35,7 +35,8 @@ plot_recruitment <- function(
   interactive = TRUE,
   module = NULL,
   make_rda = FALSE,
-  figures_dir = getwd()
+  figures_dir = getwd(),
+  ...
 ) {
   # TODO: Fix the unit label if scaling
   recruitment_label <- label_magnitude(
@@ -48,7 +49,7 @@ plot_recruitment <- function(
   # Extract recruitment
   recruitment <- filter_data(
     dat = dat,
-    label_name = "recruitment",
+    label_name = "recruitment$", # might need to adjust for expected vs predicted rec
     geom = "line",
     era = era,
     group = group,
@@ -99,13 +100,13 @@ plot_recruitment <- function(
     dat = recruitment,
     x = "year",
     y = "predicted_recruitment",
-    color = "black",
+    # color = "black",
     geom = geom,
     xlab = "Year",
     ylab = recruitment_label,
     group = group,
-    facet = facet # ,
-    # ...
+    facet = facet,
+    ...
   ) +
     theme_noaa()
 

R/plot_recruitment_deviations.R

@@ -1,11 +1,20 @@
-#' Plot Recruitment Deviations
+#' Plot recruitment deviations
 #'
 #' @inheritParams plot_spawning_biomass
 #'
-#' @return Plot recruitment deviations relative to one over time 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.
+#' @return A plot showing recruitment deviations relative to one, over time.
+#'
+#' @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.
+#'
+#' @note
+#' All plotting functions automatically recognize indexing variables and will
+#' use them in groupings and/or facetting. @seealso [process_data()].
+#' 
+#' @seealso [convert_output()], [plot_error()], [filter_data()],
+#' [process_data()]
 #'
 #' @export
 #'

R/plot_spawning_biomass.R

@@ -73,8 +73,9 @@
 #' All plotting functions automatically recognize indexing variables and will
 #' use them in groupings and/or facetting. @seealso [process_data()].
 #'
-#' @seealso [plot_timeseries()], [calculate_reference_point()],
-#' [reference_line()], [filter_data()], [process_data()]
+#' @seealso [convert_output()], [plot_timeseries()],
+#' [calculate_reference_point()], [reference_line()], [filter_data()],
+#' [process_data()]
 #'
 #' @export
 #'
@@ -205,33 +206,34 @@ plot_spawning_biomass <- function(
   final <- reference_line(
     plot = plt,
     dat = rp_dat,
-    era = era,
+    # era = era,
     label_name = "spawning_biomass",
     reference = ref_line,
     relative = relative,
     scale_amount = scale_amount
   ) + theme_noaa()
 
   # Plot vertical lines if era is not filtering
-  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"
-      )
-  }
+  # 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) {