diff --git a/.github/workflows/update-example-data.yml b/.github/workflows/update-example-data.yml new file mode 100644 index 00000000..95dc205a --- /dev/null +++ b/.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 diff --git a/DESCRIPTION b/DESCRIPTION index e1eb071b..7edbe36f 100644 --- a/DESCRIPTION +++ b/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, diff --git a/NAMESPACE b/NAMESPACE index c81267fd..19b69c0f 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/plot_fishing_mortality.R b/R/plot_fishing_mortality.R index 8791455d..619f6d22 100644 --- a/R/plot_fishing_mortality.R +++ b/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, diff --git a/R/plot_indices.R b/R/plot_indices.R index 645bde3c..3b967b07 100644 --- a/R/plot_indices.R +++ b/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) { diff --git a/R/plot_recruitment.R b/R/plot_recruitment.R index 80bf4fc5..6ca40da9 100644 --- a/R/plot_recruitment.R +++ b/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() diff --git a/R/plot_recruitment_deviations.R b/R/plot_recruitment_deviations.R index ed6e90ae..5e41fb50 100644 --- a/R/plot_recruitment_deviations.R +++ b/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 #' diff --git a/R/plot_spawning_biomass.R b/R/plot_spawning_biomass.R index 9448f129..22ba1ff2 100644 --- a/R/plot_spawning_biomass.R +++ b/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,7 +206,7 @@ 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, @@ -213,25 +214,26 @@ plot_spawning_biomass <- function( ) + 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) { diff --git a/R/process_data.R b/R/process_data.R index c58a351a..715ec886 100644 --- a/R/process_data.R +++ b/R/process_data.R @@ -212,8 +212,42 @@ process_data <- function( } } else { # group is null # Set first indexing variable to group - group <- index_variables[1] - data <- dplyr::filter(data, !is.na(.data[[group]])) + # Check if >1 value exists for each model + check_indexing <- data |> + dplyr::group_by(model) |> + dplyr::summarise(dplyr::across(dplyr::all_of(index_variables), ~ dplyr::n_distinct(.x) > 1)) + if (any( + check_indexing |> + dplyr::select(dplyr::all_of(index_variables)) |> + # 2. Turn the columns into a single long format + tidyr::pivot_longer(cols = dplyr::everything()) |> + # 3. Extract the 'value' column as a raw vector + dplyr::pull(value) + )) { + # check which index values contain a TRUE + # if any have FALSE in entire column then remove from index_variables + valid_vars <- check_indexing |> + dplyr::summarise(dplyr::across(-model, any)) |> + tidyr::pivot_longer(dplyr::everything()) |> + dplyr::filter(value == TRUE) |> + dplyr::pull(name) + # Remove any index_variables that aren't in valid_vars + index_variables <- index_variables[grepl(paste(valid_vars, collapse = "|"), index_variables)] + # Set group to first matching valid var + group <- valid_vars[1] + # Remove group from index_variables so no repeats + 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 if (length(index_variables) > 1) { if (!is.null(facet)) { @@ -225,17 +259,20 @@ process_data <- function( # add message for what vaues are in facet cli::cli_alert_info("Faceting by {paste(facet, collapse = ', ')}.") # filter out NA for each value in facet - for (f in facet) { - if (any(is.na(unique(data[[f]]))) & length(unique(data[[f]])) == 2) { - data <- dplyr::filter(data, is.na(.data[[f]])) - facet <- facet[-grepl(f, facet)] - } else { - data <- dplyr::filter(data, !is.na(.data[[f]])) - } - } - } - } - } + # only perform if ==1 model + if (length(unique(data$model)) == 1) { + for (f in facet) { + if (any(is.na(unique(data[[f]]))) & length(unique(data[[f]])) == 2) { + data <- dplyr::filter(data, is.na(.data[[f]])) + facet <- facet[-grepl(f, facet)] + } else { + data <- dplyr::filter(data, !is.na(.data[[f]])) + } # close ifelse + } # close for loop + } # close model check + } # close check for remaining index variables + } # close else group is null + } # close length index_vars > 0 if (!is.null(group) && group != "none") { # check if value varies in ANY year @@ -317,7 +354,16 @@ process_data <- function( group <- NULL } } - + + # Ensure that index_variables -- group or facets are non-numeric to be plotted accurately + data <- data |> + dplyr::mutate( + across( + tidyselect::any_of(c(group, facet)), + as.character + ) + ) + # Export list of objects list( # variable, diff --git a/R/utils_plot.R b/R/utils_plot.R index 0ecff4cd..6b9fb72a 100644 --- a/R/utils_plot.R +++ b/R/utils_plot.R @@ -89,7 +89,13 @@ plot_timeseries <- function( x = .data[[x]], ymin = estimate_lower, ymax = estimate_upper, - fill = interaction(model, group_var) + fill = { + if(length(unique(.data[["model"]])) > 1) { + interaction(model, group_var) + } else { + group_var + } + } ), alpha = 0.3 ) + @@ -101,7 +107,13 @@ plot_timeseries <- function( y = .data[[y]], # linetype = group_var, # linetype = ifelse(!is.null(group), group_var, "solid"), - color = interaction(model, group_var) + color = { + if(length(unique(.data[["model"]])) > 1) { + interaction(model, group_var) + } else { + group_var + } + } ), # linewidth = 1.0, ... @@ -133,10 +145,20 @@ plot_timeseries <- function( ) + ggplot2::theme(legend.title = ggplot2::element_blank()) } else { + if (length(unique(dat$model)) > 1) { + color_lab <- "Model" + } else { + if(!is.null(group)) { + color_lab <- group + } else { + color_lab <- NULL + } + } + # color_lab <- ifelse(length(unique(dat$model)) > 1, "Model", group) labs <- plot + ggplot2::labs( x = xlab, y = ylab, - color = "Model", + color = cap_first_letter(color_lab), linetype = cap_first_letter(group), fill = cap_first_letter(group), shape = cap_first_letter(group) @@ -151,16 +173,15 @@ plot_timeseries <- function( # return plot if option beyond line and point for now labs ) - } - if (length(unique(dat$model)) == 1) { - labs <- switch(geom, - "line" = labs + ggplot2::guides(color = "none"), - "point" = labs + ggplot2::guides(color = "none"), - "area" = labs + ggplot2::guides(fill = "none"), - # return plot if option beyond line and point for now - labs - ) - } + } # else if (length(unique(dat$model)) == 1) { + # labs <- switch(geom, + # "line" = labs + ggplot2::guides(color = "none"), + # "point" = labs + ggplot2::guides(color = "none"), + # "area" = labs + ggplot2::guides(fill = "none"), + # # return plot if option beyond line and point for now + # labs + # ) + # } # Calc axis breaks x_n_breaks <- axis_breaks(dat[[x]]) @@ -178,7 +199,7 @@ plot_timeseries <- function( ) # Remove legend if no group is selected - if (is.null(group) & is.data.frame(dat) & any(is.na(unique(dat$model)))) { + if (is.null(group) & is.data.frame(dat) & any("label" %in% unique(dat$model)) | length(unique(dat$model)) == 1) { final <- final + ggplot2::theme(legend.position = "none") } @@ -500,7 +521,7 @@ cohort_line <- function( reference_line <- function( plot, dat, - era = "time", + # era = "time", label_name, reference, relative = FALSE, @@ -517,9 +538,6 @@ reference_line <- function( ) } - # Rename era arg - era_name <- era - # Add geom for ref line if (is.null(ref_line_val)) { # cli::cli_alert_warning( @@ -538,9 +556,9 @@ reference_line <- function( ggplot2::annotate( geom = "text", # TODO: need to change this for general process - x = as.numeric(max(dat$year[dat$era == era_name], na.rm = TRUE)), # - as.numeric(max(dat$year[dat$era == "time"], na.rm = TRUE))/200, + x = as.numeric(max(ggplot2::ggplot_build(plot)@data[[2]][["x"]], na.rm = TRUE)), # - as.numeric(max(dat$year[dat$era == "time"], na.rm = TRUE))/200, y = ref_line_val / ifelse(relative, ref_line_val, scale_amount), - label = glue::glue("{label_name}[{reference}]"), # list(bquote(label_name[.(reference)])), + label = glue::glue("{stringr::str_replace_all(label_name, '_', '~')}[{reference}]"), # list(bquote(label_name[.(reference)])), parse = TRUE, hjust = 1, vjust = 0, @@ -673,7 +691,7 @@ filter_data <- function( ) |> dplyr::mutate( year = as.numeric(year), - model = ifelse(model_label, get_id(dat)[i], NA), + model = ifelse(model_label, get_id(dat)[i], "1"), # NA -- changed from NA to 1 for processing reasons, might need to change back if issue estimate = as.numeric(estimate) / scale_amount, # calc uncertainty when se # TODO: calculate other sources of error to upper and lower (cv,) @@ -980,3 +998,106 @@ check_grouping <- function(dat) { } dat_index } + +#------------------------------------------------------------------------------ + +#' Plot observed vs. predicted data +#' +#' @inheritParams plot_timeseries +#' @param observed_label a string of the label used to filter the observed data. Default is "observed". +#' @param predicted_label a string of the label used to filter the predicted data. Default is "predicted". +#' +#' @returns Create a plot of observed vs. predicted data for a stock assessment report. +#' @export +#' +plot_obsvpred <- function( + dat, + x = "year", + y = "estimate", + observed_label = "observed", + predicted_label = "predicted", + geom = "line", + xlab = "Year", + ylab = NULL, + group = NULL, + facet = NULL, + ... +) { + # Start plot + plot <- ggplot2::ggplot() + # make into new geom? + # more defaults and fxnality for ggplot + + # Add geom + plot <- plot + + ggplot2::geom_point( + data = dat |> dplyr::filter(grepl(observed_label, label)), + ggplot2::aes( + .data[[x]], + .data[[y]], + color = model + ), + shape = 16 + # ... + ) + + ggplot2::geom_line( + data = dat |> dplyr::filter(grepl(predicted_label, label)), + ggplot2::aes( + x = .data[[x]], + y = .data[[y]], + color = model + ), + linetype = "solid" + ) + + # Add labels to axis and legend + if (length(unique(dat$model)) > 1 & !is.null(group)) { + labs <- plot + ggplot2::labs( + x = xlab, + y = ylab + # color = "Model", + # linetype = cap_first_letter(group), + # fill = cap_first_letter(group), + # shape = cap_first_letter(group) + ) + + ggplot2::theme(legend.title = ggplot2::element_blank()) + } else { + labs <- plot + ggplot2::labs( + x = xlab, + y = ylab, + color = "Model" + ) + } + + # Remove linetype or point when there is no grouping + if (is.null(group) & length(unique(dat$model)) == 1) { + labs <- labs + ggplot2::guides(linetype = "none", shape = "none") + } + if (length(unique(dat$model)) == 1) { + labs <- labs + ggplot2::guides(color = "none") + } + + # Calc axis breaks + x_n_breaks <- axis_breaks(dat[[x]]) + breaks <- ggplot2::scale_x_continuous( + breaks = x_n_breaks, + guide = ggplot2::guide_axis( + minor.ticks = TRUE + ) + ) + + # Put together final plot + final <- labs + breaks + ggplot2::expand_limits(y = 0) + + ggplot2::scale_y_continuous( + labels = scales::label_comma() + ) + + # Check if facet(s) are desired + if (!is.null(facet) & length(facet) > 0) { + facet <- paste("~", paste(facet, collapse = " + ")) + facet_formula <- stats::reformulate(facet) + + final <- final + ggplot2::facet_wrap(facet_formula) + } + final +} diff --git a/inst/resources/captions_alt_text_template.csv b/inst/resources/captions_alt_text_template.csv index 11f564a4..940a7c3c 100644 --- a/inst/resources/captions_alt_text_template.csv +++ b/inst/resources/captions_alt_text_template.csv @@ -19,15 +19,15 @@ mod.fit.catch,figure,Observed catch from the data input file (points) and model mod.fit.abun,figure,Assessment model fits to input catch per unit of effort index values over time calculated from fleet.or.survey.name.,"Point and line graph showing the assessment model fit, displayed as a line, to input catch per unit effort index values, displayed as points over time, for fleet.or.survey.name. The x axis shows years, which spans from mod.fit.abun.start.year to mod.fit.abun.end.year. The y axis shows catch per unit effort in cpue.units, which spans from cpue.min to cpue.max." mod.fit.discards,figure,Observed discards (points) and estimated discards (line).,"Point and line graph showing the assessment model fit to observed discards. Observed discards are represented as points while the model fitted estimates are represented as a line over time for fleet.or.survey.name. The x axis shows the year, which spans from mod.fit.discards.start.year to mod.fit.discards.end.year. The y axis shows discards in mod.fit.discards.units, which spans from mod.fit.discards.min to mod.fit.discards.max." selectivity,figure,Length-based selectivity for each fleet and survey estimated by the assessment model.,"Line graph showing length-based selectivity for fleet.or.survey.name from selectivity.start.year to selectivity.end.year. The x axis shows length in selectivity.length.units, which spans from selectivity.length.min to selectivity.length.max. The y axis shows the proportion of the stock that the gear selects for, which spans from 0--1." -stock_recruitment,figure,Stock recruitment relationship estimated by the assessment model. ,"Point and line graph showing the relationship between stock biomass and newly recruited age sr.age.min fish as estimated by the assessment model. Points represent model estimates of recruitment each year as a function of stock biomass, after adjusted by annual recruitment deviations. The line represents the best fit through the points for the stock relationship selected for use in the assessment model. The x axis shows spawning stock biomass in sr.ssb.units, which spans from sr.ssb.min to sr.ssb.max. The y axis shows recruitment in recruitment.units, which spans from recruitment.min to recruitment.max." +stock_recruitment,figure,Stock recruitment relationship estimated by the assessment model. ,"Point and line graph showing the relationship between stock biomass and newly recruited age sr.age.min fish as estimated by the assessment model. Points represent model estimates of recruitment each year as a function of stock biomass, after adjusted by annual recruitment deviations. The line represents the best fit through the points for the stock relationship selected for use in the assessment model. The x axis shows spawning biomass in sr.ssb.units, which spans from sr.ssb.min to sr.ssb.max. The y axis shows recruitment in recruitment.units, which spans from recruitment.min to recruitment.max." recruitment,figure,Estimated recruitment by the assessment model each year in recruitment.units.,"Line graph showing the assessment model estimated recruitment in recruitment.units for each year. The x axis shows years, which spans from recruitment.start.year to recruitment.end.year. The y axis shows recruitment in recruitment.units, which spans from recruitment.min to recruitment.max." recruitment.comp,figure,Predicted (black points) and expected (red line) recruitment by the assessment model each year in recruitment.units.,"Scatter plot showing the assessment model estimated recruitment in recruitment.units for each year with a red line showing the predicted recruitment in recruitment.units for each year. The x axis shows years, which spans from recruitment.start.year to recruitment.end.year. The y axis shows recruitment in recruitment.units, which spans from recruitment.min to recruitment.max." relative.recruitment,figure,"Estimated relative recruitment by the assessment model each year in recruitment.units, calculated as R/R~0~ where R~0~ is R0.","Line graph showing the assessment model estimated relative recruitment in recruitment.units for each year. The x axis shows year, which spans from recruitment.start.year to recruitment.end.year. The y axis shows relative recruitment (R/R~0~), which spans from rel.recruitment.min to rel.recruitment.max recruitment.units." recruitment_deviations,figure,Annual deviations (on natural log scale) in the number of newly recruited fish the model estimates each year. ,"Scatterplot showing annual deviations in recruitment. Points have error bars and the dashed horizontal line at 0 represents no deviation from what would be estimated by the stock-recruit relationship. Positive values represent an increase in recruitment that year while negative values represent a decrease. The x axis shows year, which spans from recruit.dev.start.year to recruit.dev.end.year. The y axis shows the recruitment deviation, which spans from recruit.dev.min to recruit.dev.max on a natural log scale." 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 stock biomass (SSB) time series. The horizontal dashed line represents the spawning stock biomass associated with the biomass limit reference point (ssb.ref.pt ssb.units).,"Line graph showing estimated spawning stock biomass. The x axis shows the year, which spans from ssb.start.year to ssb.end.year. The y axis shows estimated spawning stock biomass in ssb.units, which spans from ssb.min to ssb.max." -relative.spawning.biomass,figure,Estimated relative spawning stock biomass time series. The horizontal dashed line represents the limit reference point calculated as SSB/SSB(reference point) (ssb.ref.pt ssb.units).,"Line graph showing estimated relative spawning stock biomass. The x axis shows the year, which spans from ssb.start.year to ssb.end.year. The y axis shows estimated relative spawning stock biomass (SSB/SSB~target~), which spans from rel.ssb.min to rel.ssb.max ssb.units." -spr,figure,Estimated spawning potential ratio (SPR) (SSB~current~/SSB~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 SSB~current~/SSB~target~, which spans from spr.min to spr.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." 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., diff --git a/inst/resources/key_quantity_template.csv b/inst/resources/key_quantity_template.csv index f766e082..6a8de059 100644 --- a/inst/resources/key_quantity_template.csv +++ b/inst/resources/key_quantity_template.csv @@ -95,8 +95,8 @@ rel.F.max,,maximum relative fishing mortality,,,, rel.F.min,,minimum relative fishing mortality,,,, rel.recruitment.max,,maximum relative recruitment (R/R0),,,, rel.recruitment.min,,minimum relative recruitment (R/R0),,,, -rel.ssb.max,,maximum relative spawning stock biomass,,,, -rel.ssb.min,,minimum relative spawning stock biomass,,,, +rel.ssb.max,,maximum relative spawning biomass,,,, +rel.ssb.min,,minimum relative spawning biomass,,,, selectivity.end.year,,final year for selectivity estimates,,,, selectivity.length.max,,maximum length for gear selectivity,,,, selectivity.length.min,,minimum length for gear selectivity,,,, @@ -110,11 +110,11 @@ sr.ssb.max,,maximum SSB in stock-recruit relationship,,,, sr.ssb.min,,minimum SSB in stock-recruit relationship,,,, sr.ssb.units,,units for SSB in stock-recruit relationship,,,, ssb.end.year,,final year of the SSB time series,,,, -ssb.max,,maximum spawning stock biomass,,,, -ssb.min,,minimum spawning stock biomass,,,, -ssb.ref.pt,,spawning stock biomass reference point,,,, +ssb.max,,maximum spawning biomass,,,, +ssb.min,,minimum spawning biomass,,,, +ssb.ref.pt,,spawning biomass reference point,,,, ssb.start.year,,start year of the SSB time series,,,, -ssb.units,,units for spawning stock biomass,,,, +ssb.units,,units for spawning biomass,,,, tot.catch.max,,maximum total catch,,,, tot.catch.min,,minimum total catch,,,, total.length.max,,maximum total length,,,, diff --git a/man/plot_indices.Rd b/man/plot_indices.Rd index 15790df6..7f01f6f7 100644 --- a/man/plot_indices.Rd +++ b/man/plot_indices.Rd @@ -8,7 +8,7 @@ plot_indices( dat, unit_label = "", group = NULL, - facet = "fleet", + facet = NULL, interactive = TRUE, module = NULL, focus = NULL, diff --git a/man/plot_obsvpred.Rd b/man/plot_obsvpred.Rd new file mode 100644 index 00000000..9564ccca --- /dev/null +++ b/man/plot_obsvpred.Rd @@ -0,0 +1,56 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils_plot.R +\name{plot_obsvpred} +\alias{plot_obsvpred} +\title{Plot observed vs. predicted data} +\usage{ +plot_obsvpred( + dat, + x = "year", + y = "estimate", + observed_label = "observed", + predicted_label = "predicted", + geom = "line", + xlab = "Year", + ylab = NULL, + group = NULL, + facet = NULL, + ... +) +} +\arguments{ +\item{dat}{filtered data frame from standard output file(s) preformatted for +the target label from \link[stockplotr]{filter_data}} + +\item{x}{a string of the column name of data used to plot on the x-axis (default +is "year")} + +\item{y}{a string of the column name of data used to plot on the y-axis (default +is "estimate")} + +\item{observed_label}{a string of the label used to filter the observed data. Default is "observed".} + +\item{predicted_label}{a string of the label used to filter the predicted data. Default is "predicted".} + +\item{geom}{type of geom to use for plotting found in ggplot2 (e.g. "point", +"line", etc.). Default is "line". Other options are "point" and "area".} + +\item{xlab}{a string of the x-axis label (default is "Year")} + +\item{ylab}{a string of the y-axis label. If NULL, it will be set to the name +of `y`.} + +\item{group}{a string of a single column that groups the data (e.g. "fleet", +"sex", "area", etc.). Currently can only have one level of grouping.} + +\item{facet}{a string or vector of strings of a column that facets the data +(e.g. "year", "area", etc.)} + +\item{...}{inherited arguments from internal functions from ggplot2::geom_xx} +} +\value{ +Create a plot of observed vs. predicted data for a stock assessment report. +} +\description{ +Plot observed vs. predicted data +} diff --git a/man/plot_recruitment.Rd b/man/plot_recruitment.Rd index 466157a3..05f43668 100644 --- a/man/plot_recruitment.Rd +++ b/man/plot_recruitment.Rd @@ -14,7 +14,8 @@ plot_recruitment( interactive = TRUE, module = NULL, make_rda = FALSE, - figures_dir = getwd() + figures_dir = getwd(), + ... ) } \arguments{ @@ -69,6 +70,8 @@ Default: `FALSE`.} Default: `getwd()` The folder is created within the path if it does not exist.} + +\item{...}{Arguments called from \link[ggplot2]{geom_line} or \link[ggplot2]{geom_point}} } \value{ Plot recruitment over time from an assessment model output file diff --git a/man/plot_recruitment_deviations.Rd b/man/plot_recruitment_deviations.Rd index 33d88881..d14b82b7 100644 --- a/man/plot_recruitment_deviations.Rd +++ b/man/plot_recruitment_deviations.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/plot_recruitment_deviations.R \name{plot_recruitment_deviations} \alias{plot_recruitment_deviations} -\title{Plot Recruitment Deviations} +\title{Plot recruitment deviations} \usage{ plot_recruitment_deviations( dat, @@ -53,13 +53,20 @@ The folder is created within the path if it does not exist.} \item{...}{Arguments called from \link[ggplot2]{geom_line} or \link[ggplot2]{geom_point}} } \value{ -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. +A plot showing recruitment deviations relative to one, over time. } \description{ -Plot Recruitment Deviations +Plot recruitment deviations +} +\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()]. } \examples{ plot_recruitment_deviations( @@ -74,3 +81,7 @@ plot_recruitment_deviations( shape = 2 ) } +\seealso{ +[convert_output()], [plot_error()], [filter_data()], +[process_data()] +} diff --git a/man/plot_spawning_biomass.Rd b/man/plot_spawning_biomass.Rd index a14df2ce..218a8570 100644 --- a/man/plot_spawning_biomass.Rd +++ b/man/plot_spawning_biomass.Rd @@ -135,6 +135,7 @@ plot_spawning_biomass( ) } \seealso{ -[plot_timeseries()], [calculate_reference_point()], -[reference_line()], [filter_data()], [process_data()] +[convert_output()], [plot_timeseries()], +[calculate_reference_point()], [reference_line()], [filter_data()], +[process_data()] } diff --git a/man/reference_line.Rd b/man/reference_line.Rd index c3025624..9b1b876c 100644 --- a/man/reference_line.Rd +++ b/man/reference_line.Rd @@ -7,7 +7,6 @@ reference_line( plot, dat, - era = "time", label_name, reference, relative = FALSE, @@ -19,12 +18,6 @@ reference_line( \item{dat}{standard data frame where reference point should be extracted} -\item{era}{A string naming the era of data. - -Default: "time" - -Options: "early", "time", "fore" (forecast), or NULL (all data)} - \item{label_name}{string of the name of the quantity that users want to extract the reference point from} diff --git a/pkgdown/assets/stockplotr_cheatsheet.pdf b/pkgdown/assets/stockplotr_cheatsheet.pdf index 28f0edd0..6e78bc12 100644 Binary files a/pkgdown/assets/stockplotr_cheatsheet.pdf and b/pkgdown/assets/stockplotr_cheatsheet.pdf differ diff --git a/tests/testthat/test-export_rda.R b/tests/testthat/test-export_rda.R index cd543048..b96837f7 100644 --- a/tests/testthat/test-export_rda.R +++ b/tests/testthat/test-export_rda.R @@ -43,6 +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")) unlink(fs::path(getwd(), "figures"), recursive = T) }) @@ -84,5 +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")) unlink(fs::path(getwd(), "tables"), recursive = T) }) diff --git a/tests/testthat/test-extract_caps_alttext.R b/tests/testthat/test-extract_caps_alttext.R index df29d97a..5d4a1c1e 100644 --- a/tests/testthat/test-extract_caps_alttext.R +++ b/tests/testthat/test-extract_caps_alttext.R @@ -33,6 +33,7 @@ test_that("extract_caps_alttext works for figures", { # erase temporary testing files file.remove(fs::path(getwd(), "captions_alt_text.csv")) + file.remove(fs::path(getwd(), "key_quantities.csv")) }) test_that("extract_caps_alttext works for tables", { @@ -60,4 +61,5 @@ test_that("extract_caps_alttext works for tables", { # erase temporary testing files file.remove(fs::path(getwd(), "captions_alt_text.csv")) + file.remove(fs::path(getwd(), "key_quantities.csv")) }) diff --git a/tests/testthat/test-html_all_figs_tables.R b/tests/testthat/test-html_all_figs_tables.R index 44ad84ce..cbc7bb7a 100644 --- a/tests/testthat/test-html_all_figs_tables.R +++ b/tests/testthat/test-html_all_figs_tables.R @@ -30,6 +30,7 @@ load(file.path( # # erase temporary testing files # unlink(fs::path(getwd(), "all_tables_figures"), recursive = T) # file.remove(fs::path(getwd(), "captions_alt_text.csv")) +# file.remove(fs::path(getwd(), "key_quantities.csv")) # file.remove(fs::path(getwd(), "08_tables.qmd")) # file.remove(fs::path(getwd(), "09_figures.qmd")) # unlink(fs::path(getwd(), "figures"), recursive = T) @@ -90,6 +91,7 @@ load(file.path( # # erase temporary testing files # unlink(fs::path(getwd(), "all_tables_figures"), recursive = T) # file.remove(fs::path(getwd(), "captions_alt_text.csv")) +# file.remove(fs::path(getwd(), "key_quantities.csv")) # file.remove(fs::path(getwd(), "08_tables.qmd")) # file.remove(fs::path(getwd(), "09_figures.qmd")) # unlink(fs::path(getwd(), "figures"), recursive = T) diff --git a/tests/testthat/test-plot_abundance_at_age.R b/tests/testthat/test-plot_abundance_at_age.R index ffb01bbb..757c7bef 100644 --- a/tests/testthat/test-plot_abundance_at_age.R +++ b/tests/testthat/test-plot_abundance_at_age.R @@ -50,6 +50,7 @@ test_that("rda file made when indicated", { # 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) }) diff --git a/tests/testthat/test-plot_biomass.R b/tests/testthat/test-plot_biomass.R index 4d989cf5..7a8d96fe 100644 --- a/tests/testthat/test-plot_biomass.R +++ b/tests/testthat/test-plot_biomass.R @@ -121,5 +121,6 @@ test_that("rda file made when indicated", { # 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) }) diff --git a/tests/testthat/test-plot_biomass_at_age.R b/tests/testthat/test-plot_biomass_at_age.R index d152d50b..294920c6 100644 --- a/tests/testthat/test-plot_biomass_at_age.R +++ b/tests/testthat/test-plot_biomass_at_age.R @@ -49,6 +49,7 @@ test_that("rda file made when indicated", { # 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) }) diff --git a/tests/testthat/test-plot_catch_comp.R b/tests/testthat/test-plot_catch_comp.R index c407c091..55c45001 100644 --- a/tests/testthat/test-plot_catch_comp.R +++ b/tests/testthat/test-plot_catch_comp.R @@ -50,6 +50,7 @@ test_that("rda file made when indicated", { # 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) }) diff --git a/tests/testthat/test-plot_indices.R b/tests/testthat/test-plot_indices.R index d7384d84..e4053e74 100644 --- a/tests/testthat/test-plot_indices.R +++ b/tests/testthat/test-plot_indices.R @@ -32,5 +32,6 @@ test_that("rda file made when indicated", { # 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) }) diff --git a/tests/testthat/test-plot_landings.R b/tests/testthat/test-plot_landings.R index d6e62277..78c0f7b2 100644 --- a/tests/testthat/test-plot_landings.R +++ b/tests/testthat/test-plot_landings.R @@ -33,5 +33,6 @@ test_that("rda file made when indicated", { # 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) }) diff --git a/tests/testthat/test-plot_natural_mortality.R b/tests/testthat/test-plot_natural_mortality.R index de9b5e5a..7ce51449 100644 --- a/tests/testthat/test-plot_natural_mortality.R +++ b/tests/testthat/test-plot_natural_mortality.R @@ -40,5 +40,6 @@ test_that("rda file made when indicated", { # 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) }) diff --git a/tests/testthat/test-plot_recruitment.R b/tests/testthat/test-plot_recruitment.R index 2a46dd14..b3b6c895 100644 --- a/tests/testthat/test-plot_recruitment.R +++ b/tests/testthat/test-plot_recruitment.R @@ -70,5 +70,6 @@ test_that("rda file made when indicated", { # 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) }) diff --git a/tests/testthat/test-plot_recruitment_deviations.R b/tests/testthat/test-plot_recruitment_deviations.R index 55f7a38f..995f1b83 100644 --- a/tests/testthat/test-plot_recruitment_deviations.R +++ b/tests/testthat/test-plot_recruitment_deviations.R @@ -49,5 +49,6 @@ test_that("rda file made when indicated", { # 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) }) diff --git a/tests/testthat/test-plot_spawning_biomass.R b/tests/testthat/test-plot_spawning_biomass.R index 5fb2c7c4..74a53c1a 100644 --- a/tests/testthat/test-plot_spawning_biomass.R +++ b/tests/testthat/test-plot_spawning_biomass.R @@ -95,6 +95,7 @@ test_that("rda file made when indicated", { # 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) }) diff --git a/tests/testthat/test-plot_stock_recruitment.R b/tests/testthat/test-plot_stock_recruitment.R index 994f3e9a..f8cae79a 100644 --- a/tests/testthat/test-plot_stock_recruitment.R +++ b/tests/testthat/test-plot_stock_recruitment.R @@ -53,5 +53,6 @@ test_that("rda file made when indicated", { # 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) }) diff --git a/tests/testthat/test-save_all_plots.R b/tests/testthat/test-save_all_plots.R index 909b5198..5266206b 100644 --- a/tests/testthat/test-save_all_plots.R +++ b/tests/testthat/test-save_all_plots.R @@ -53,6 +53,7 @@ test_that("save_all_plots works when all figures/tables are plotted", { # 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) # unlink(fs::path(getwd(), "tables"), recursive = T) }) diff --git a/tests/testthat/test-table_bnc.R b/tests/testthat/test-table_bnc.R index fcc14b95..449aa526 100644 --- a/tests/testthat/test-table_bnc.R +++ b/tests/testthat/test-table_bnc.R @@ -59,6 +59,8 @@ # # 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(), "tables"), recursive = T) # }) diff --git a/tests/testthat/test-table_indices.R b/tests/testthat/test-table_indices.R index 9b4d02d5..50081a07 100644 --- a/tests/testthat/test-table_indices.R +++ b/tests/testthat/test-table_indices.R @@ -47,6 +47,8 @@ # # 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(), "tables"), recursive = T) # }) diff --git a/tests/testthat/test-table_landings.R b/tests/testthat/test-table_landings.R index 7f29ee6d..1b43725c 100644 --- a/tests/testthat/test-table_landings.R +++ b/tests/testthat/test-table_landings.R @@ -61,6 +61,7 @@ test_that("rda file made when indicated", { # 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(), "tables"), recursive = T) })