diff --git a/R/plot_biomass_at_age.R b/R/plot_biomass_at_age.R index 54e7ccac..1bc5e131 100644 --- a/R/plot_biomass_at_age.R +++ b/R/plot_biomass_at_age.R @@ -56,6 +56,7 @@ plot_biomass_at_age <- function( label_name = "^biomass", geom = "point", group = "age", + era = "time", scale_amount = scale_amount, interactive = interactive ) diff --git a/R/plot_fishing_mortality.R b/R/plot_fishing_mortality.R index 7bf802ed..518a8e86 100644 --- a/R/plot_fishing_mortality.R +++ b/R/plot_fishing_mortality.R @@ -34,7 +34,7 @@ plot_fishing_mortality <- function( group = NULL, facet = NULL, ref_line = "msy", - era = "time", + era = NULL, module = NULL, make_rda = FALSE, figures_dir = getwd(), diff --git a/R/plot_recruitment.R b/R/plot_recruitment.R index c8cbef99..69abdd08 100644 --- a/R/plot_recruitment.R +++ b/R/plot_recruitment.R @@ -33,7 +33,7 @@ plot_recruitment <- function( dat, unit_label = "mt", scale_amount = 1, - era = "time", + era = NULL, group = NULL, facet = NULL, # relative = FALSE, @@ -129,25 +129,25 @@ plot_recruitment <- function( } # Plot vertical lines if era is not filtering - if (is.null(era)) { - # Find unique era - eras <- unique(filter_data$era) - if (length(eras) > 1) { - year_vlines <- c() - for (i in 2:length(eras)) { - erax <- filter_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" - ) - } + # if (is.null(era)) { + # # Find unique era + # eras <- unique(filter_data$era) + # if (length(eras) > 1) { + # year_vlines <- c() + # for (i in 2:length(eras)) { + # erax <- filter_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) { diff --git a/R/plot_recruitment_deviations.R b/R/plot_recruitment_deviations.R index 27246a3a..762fa1f5 100644 --- a/R/plot_recruitment_deviations.R +++ b/R/plot_recruitment_deviations.R @@ -33,7 +33,7 @@ plot_recruitment_deviations <- function( dat, module = NULL, - era = "time", + era = NULL, interactive = TRUE, make_rda = FALSE, figures_dir = getwd(), @@ -78,29 +78,29 @@ plot_recruitment_deviations <- function( theme_noaa() # Plot vertical lines if era is not filtering - if (is.null(era)) { - # Find unique era - eras <- unique(filter_data$era) - if (length(eras) > 1) { - # era1 <- filter_data |> - # dplyr::filter(era == eras[1]) |> - # dplyr::pull(year) |> - # max(na.rm = TRUE) - year_vlines <- c() - for (i in 2:length(eras)) { - erax <- filter_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" - ) - } + # if (is.null(era)) { + # # Find unique era + # eras <- unique(filter_data$era) + # if (length(eras) > 1) { + # # era1 <- filter_data |> + # # dplyr::filter(era == eras[1]) |> + # # dplyr::pull(year) |> + # # max(na.rm = TRUE) + # year_vlines <- c() + # for (i in 2:length(eras)) { + # erax <- filter_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) { diff --git a/R/plot_spawning_biomass.R b/R/plot_spawning_biomass.R index 176f0cd0..9938c80c 100644 --- a/R/plot_spawning_biomass.R +++ b/R/plot_spawning_biomass.R @@ -236,7 +236,7 @@ plot_spawning_biomass <- function( ) + theme_noaa() } } - + ### Make RDA ---- if (make_rda) { if (relative) { diff --git a/R/plot_stock_recruitment.R b/R/plot_stock_recruitment.R index 673841d9..810397e8 100644 --- a/R/plot_stock_recruitment.R +++ b/R/plot_stock_recruitment.R @@ -26,14 +26,14 @@ #' interactive = FALSE, #' spawning_biomass_label = "metric tons", #' recruitment_label = "metric tons", -#' module = "SPAWN_RECRUIT" +#' module = "DERIVED_QUANTITIES" #' ) plot_stock_recruitment <- function( dat, spawning_biomass_label = "mt", recruitment_label = "mt", interactive = TRUE, - # era = "time", + era = NULL, module = NULL, scale_amount = 1, make_rda = FALSE, @@ -42,45 +42,80 @@ plot_stock_recruitment <- function( # Extract recruitment recruitment <- filter_data( dat = dat, + # TODO: change string to ^recruitment in naming convention change PR label_name = "recruitment", - era = "time", + era = era, geom = "point", scale_amount = scale_amount, interactive = interactive, module = module + ) |> + # filter for year !na + dplyr::filter( + !is.na(year), + # filter out rec devs if in data + !grepl("deviations", label) + ) + + process_rec <- process_data( + recruitment ) + + rec_proc <- process_rec[[1]] + group <- process_rec[[2]] + facet <- process_rec[[3]] + if (length(unique(recruitment$label)) > 1) { - recruitment <- recruitment |> + rec_proc <- rec_proc |> tidyr::pivot_wider( - id_cols = c(year, model, group_var, estimate_lower, estimate_upper), + id_cols = dplyr::any_of(c("year", "model", "group_var", facet)), names_from = label, - values_from = estimate + values_from = c(estimate, estimate_lower, estimate_upper) ) + # rename columns to remove "estimate" + colnames(rec_proc) <- gsub("estimate_", "", colnames(rec_proc)) } else { - recruitment <- recruitment |> - dplyr::rename(predicted_recruitment = estimate) |> - dplyr::select(-c(label)) + rec_proc <- rec_proc|> + dplyr::rename( + predicted_recruitment = estimate, + lower_predicted_recruitment = estimate_lower, + upper_predicted_recruitment = estimate_upper + ) |> + dplyr::select(-label) } - if (any(grepl("^recruitment$", colnames(recruitment)))) { - recruitment <- dplyr::rename(recruitment, predicted_recruitment = recruitment) - } + # if (any(grepl("^recruitment$", colnames(recruitment)))) { + # # TODO: adjust naming to recruitment_predicted in naming convention change PR + # recruitment <- dplyr::rename(recruitment, predicted_recruitment = recruitment) + # } # Extract spawning biomass sb <- filter_data( dat = dat, label_name = "spawning biomass", geom = "point", - era = "time", + era = era, scale_amount = scale_amount, interactive = interactive, module = module ) |> - dplyr::rename(spawning_biomass = estimate) |> - dplyr::select(-c(label)) + dplyr::filter(!is.na(year)) + process_sb <- process_data( + sb + ) + sb_proc <- process_sb[[1]] |> + dplyr::rename( + spawning_biomass = estimate, + lower_spawning_biomass = estimate_lower, + upper_spawning_biomass = estimate_upper + ) |> + dplyr::select(-label) + # group <- process_sb[[2]] + # facet <- process_sb[[3]] + # Merge recruitment and spawning biomass data - sr <- dplyr::left_join(sb, recruitment) + sr <- dplyr::left_join(sb_proc, rec_proc, by = c("year", "model", "group_var")) # Labs recruitment_lab <- label_magnitude( @@ -100,6 +135,7 @@ plot_stock_recruitment <- function( final <- plot_timeseries( dat = sr, x = "spawning_biomass", + # TODO: change name to recruitment_predicted in naming convention change PR y = "predicted_recruitment", geom = "point", color = "black", diff --git a/R/save_all_plots.R b/R/save_all_plots.R index 84030372..b2119135 100644 --- a/R/save_all_plots.R +++ b/R/save_all_plots.R @@ -252,7 +252,7 @@ save_all_plots <- function( cli::cli_alert_danger("plot_stock_recruitment failed to run.") cli::cli_alert("Tip: check that your arguments are correct.") cli::cli_li("spawning_biomass_label = {spawning_biomass_label}") - cli::cli_li("recruitment_label = {recruitment_label}") + cli::cli_li("recruitment_label = {recruitment_unit_label}") print(e) } ) diff --git a/R/utils_plot.R b/R/utils_plot.R index e294167d..16918a83 100644 --- a/R/utils_plot.R +++ b/R/utils_plot.R @@ -649,7 +649,7 @@ filter_data <- function( dat, label_name, module = NULL, - era = "time", + era = NULL, geom, group = NULL, facet = NULL, diff --git a/data-raw/DATASET.R b/data-raw/DATASET.R index dcdc7dbd..daab29c4 100644 --- a/data-raw/DATASET.R +++ b/data-raw/DATASET.R @@ -1,7 +1,7 @@ ## code to prepare `DATASET` dataset goes here # Path to SS3 output file EX_REPORT_PATH <- file.path("inst", "extdata", "Report.sso") -# Install asar +# Install stockplotr devtools::install_github("nmfs-ost/stockplotr") # Convert output example_data <- stockplotr::convert_output(EX_REPORT_PATH) diff --git a/man/filter_data.Rd b/man/filter_data.Rd index b3f9962c..a20eaa86 100644 --- a/man/filter_data.Rd +++ b/man/filter_data.Rd @@ -8,7 +8,7 @@ filter_data( dat, label_name, module = NULL, - era = "time", + era = NULL, geom, group = NULL, facet = NULL, diff --git a/man/plot_fishing_mortality.Rd b/man/plot_fishing_mortality.Rd index 16765acc..7b7305e7 100644 --- a/man/plot_fishing_mortality.Rd +++ b/man/plot_fishing_mortality.Rd @@ -10,7 +10,7 @@ plot_fishing_mortality( group = NULL, facet = NULL, ref_line = "msy", - era = "time", + era = NULL, module = NULL, make_rda = FALSE, figures_dir = getwd(), diff --git a/man/plot_recruitment.Rd b/man/plot_recruitment.Rd index 0af7a481..90db10fc 100644 --- a/man/plot_recruitment.Rd +++ b/man/plot_recruitment.Rd @@ -8,7 +8,7 @@ plot_recruitment( dat, unit_label = "mt", scale_amount = 1, - era = "time", + era = NULL, group = NULL, facet = NULL, interactive = TRUE, diff --git a/man/plot_recruitment_deviations.Rd b/man/plot_recruitment_deviations.Rd index 3727008d..50e5e034 100644 --- a/man/plot_recruitment_deviations.Rd +++ b/man/plot_recruitment_deviations.Rd @@ -7,7 +7,7 @@ plot_recruitment_deviations( dat, module = NULL, - era = "time", + era = NULL, interactive = TRUE, make_rda = FALSE, figures_dir = getwd(), diff --git a/man/plot_stock_recruitment.Rd b/man/plot_stock_recruitment.Rd index 09a007aa..71049367 100644 --- a/man/plot_stock_recruitment.Rd +++ b/man/plot_stock_recruitment.Rd @@ -9,6 +9,7 @@ plot_stock_recruitment( spawning_biomass_label = "mt", recruitment_label = "mt", interactive = TRUE, + era = NULL, module = NULL, scale_amount = 1, make_rda = FALSE, @@ -31,6 +32,12 @@ plot is being made in is interactive. By default, this is set to false. If true, dependent on your data, a option menu will pop-up.} +\item{era}{A string naming the era of data. + +Default: "time" + +Options: "early", "time", "fore" (forecast), or NULL (all data)} + \item{module}{(Optional) A string indicating the module_name found in `dat`. Default: NULL @@ -72,7 +79,7 @@ plot_stock_recruitment( interactive = FALSE, spawning_biomass_label = "metric tons", recruitment_label = "metric tons", - module = "SPAWN_RECRUIT" + module = "DERIVED_QUANTITIES" ) } \seealso{ diff --git a/tests/testthat/fixtures/ss3_models_converted/Hake_2018/std_output.rda b/tests/testthat/fixtures/ss3_models_converted/Hake_2018/std_output.rda index cd52a36f..12b4dee3 100644 Binary files a/tests/testthat/fixtures/ss3_models_converted/Hake_2018/std_output.rda and b/tests/testthat/fixtures/ss3_models_converted/Hake_2018/std_output.rda differ diff --git a/tests/testthat/test-export_rda.R b/tests/testthat/test-export_rda.R index d4c708c9..e576c74f 100644 --- a/tests/testthat/test-export_rda.R +++ b/tests/testthat/test-export_rda.R @@ -22,8 +22,8 @@ test_that("export_rda works for figures", { ) # make a simple plot - library(ggplot2) - final <- ggplot2::ggplot(Orange, aes(circumference, age)) + + # library(ggplot2) + final <- ggplot2::ggplot(Orange, ggplot2::aes(circumference, age)) + ggplot2::geom_point() # export rda @@ -43,7 +43,7 @@ test_that("export_rda works for figures", { # erase temporary testing files file.remove(fs::path(getwd(), "captions_alt_text.csv")) - file.remove(fs::path(getwd(), "key_quantities.csv")) + # file.remove(fs::path(getwd(), "key_quantities.csv")) # file is not made in this test unlink(fs::path(getwd(), "figures"), recursive = T) }) @@ -85,6 +85,6 @@ test_that("export_rda works for tables", { # erase temporary testing files file.remove(fs::path(getwd(), "captions_alt_text.csv")) - file.remove(fs::path(getwd(), "key_quantities.csv")) + # file.remove(fs::path(getwd(), "key_quantities.csv")) # file is not made in this test ? unlink(fs::path(getwd(), "tables"), recursive = T) }) diff --git a/tests/testthat/test-plot_landings.R b/tests/testthat/test-plot_landings.R index 78c0f7b2..f8d8bc42 100644 --- a/tests/testthat/test-plot_landings.R +++ b/tests/testthat/test-plot_landings.R @@ -21,7 +21,6 @@ test_that("plot_landings generates plots without errors", { test_that("rda file made when indicated", { # export rda plot_landings(out_new, - end_year = 2024, make_rda = TRUE, unit_label = "metric tons", figures_dir = getwd()