Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Change plot_biomass and spawning_biomass plots to work through errors #34

Merged
merged 3 commits into from
Dec 17, 2024
Merged
Show file tree
Hide file tree
Changes from 1 commit
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
56 changes: 42 additions & 14 deletions R/plot_biomass.R
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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)
}
Expand All @@ -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."
))
}

Expand Down Expand Up @@ -99,9 +129,7 @@ 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) +
Expand Down
62 changes: 46 additions & 16 deletions R/plot_spawning_biomass.R
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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.
Expand All @@ -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 |>
Expand Down Expand Up @@ -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(
Expand Down
Loading