Skip to content

Commit

Permalink
updated legends in plot methods
Browse files Browse the repository at this point in the history
  • Loading branch information
@dbarneche
dbarneche committed Sep 22, 2023
1 parent 4400ad9 commit 2be55d5
Show file tree
Hide file tree
Showing 3 changed files with 48 additions and 36 deletions.
1 change: 1 addition & 0 deletions DESCRIPTION
View file
Original file line number Diff line number Diff line change
Expand Up @@ -18,6 +18,7 @@ Imports:
dplyr,
tidyr,
purrr,
tibble,
tidyselect,
evaluate,
rlang,
Expand Down
62 changes: 34 additions & 28 deletions R/autoplot.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -45,24 +45,21 @@ NULL
#'
#' @importFrom dplyr mutate
#' @importFrom chk chk_lgl
#' @importFrom rlang .env
#'
#' @export
autoplot.bayesnecfit <- function(object, ..., nec = TRUE, ecx = FALSE,
xform = identity) {

x <- object
if(!inherits(x, "bnecfit")){
stop("x is not of class bnecfit. x should be an object returned from a call to the function bnec.")
}
chk_lgl(nec)
chk_lgl(ecx)
if(!inherits(xform, "function")){
if (!inherits(xform, "function")) {
stop("xform must be a function.")
}

}
summ <- summary(x, ecx = FALSE)
ggbnec_data(x, add_nec = nec, add_ecx = ecx,
xform = xform, ...) |>
mutate(model = x$model) |>
mutate(model = x$model, tag = rownames(.env$summ$nec_vals)) |>
ggbnec(nec = nec, ecx = ecx)
}

Expand All @@ -85,41 +82,44 @@ autoplot.bayesnecfit <- function(object, ..., nec = TRUE, ecx = FALSE,
#'
#' @inherit autoplot description return examples
#'
#' @importFrom dplyr mutate
#' @importFrom dplyr mutate left_join
#' @importFrom purrr map_dfr
#' @importFrom tibble rownames_to_column
#' @importFrom grDevices devAskNewPage
#' @importFrom chk chk_lgl
#' @importFrom rlang .env
#'
#' @export
autoplot.bayesmanecfit <- function(object, ..., nec = TRUE, ecx = FALSE,
xform = identity,
all_models = FALSE, plot = TRUE, ask = TRUE,
newpage = TRUE, multi_facet = TRUE) {

x <- object

if(!inherits(x, "bnecfit")){
stop("x is not of class bnecfit. x should be an object returned from a call to the function bnec.")
}
chk_lgl(nec)
chk_lgl(ecx)
if(!inherits(xform, "function")){
if (!inherits(xform, "function")) {
stop("xform must be a function.")
}
chk_lgl(all_models)
chk_lgl(plot)
chk_lgl(ask)
chk_lgl(newpage)
chk_lgl(multi_facet)

}
chk_lgl(all_models)
chk_lgl(plot)
chk_lgl(ask)
chk_lgl(newpage)
chk_lgl(multi_facet)
if (all_models) {
all_fits <- lapply(x$success_models, pull_out, manec = x) |>
suppressMessages() |>
suppressWarnings()
if (multi_facet) {
names(all_fits) <- x$success_models
nec_labs <- map_dfr(all_fits, function(x) {
summ <- summary(x, ecx = FALSE)
summ$nec_vals |>
data.frame() |>
rownames_to_column(var = "tag")
}, .id = "model")
map_dfr(all_fits, ggbnec_data, add_nec = nec, add_ecx = ecx,
xform = xform, ..., .id = "model") |>
left_join(y = nec_labs, by = "model") |>
ggbnec(nec = nec, ecx = ecx)
} else {
if (plot) {
Expand All @@ -129,9 +129,11 @@ autoplot.bayesmanecfit <- function(object, ..., nec = TRUE, ecx = FALSE,
}
plots <- vector(mode = "list", length = length(all_fits))
for (i in seq_along(all_fits)) {
summ_i <- summary(all_fits[[i]], ecx = FALSE)
plots[[i]] <- ggbnec_data(all_fits[[i]], add_nec = nec, add_ecx = ecx,
xform = xform, ...) |>
mutate(model = x$success_models[i]) |>
mutate(model = x$success_models[i],
tag = rownames(.env$summ_i$nec_vals)) |>
ggbnec(nec = nec, ecx = ecx)
plot(plots[[i]], newpage = newpage || i > 1)
if (i == 1) {
Expand All @@ -141,8 +143,10 @@ autoplot.bayesmanecfit <- function(object, ..., nec = TRUE, ecx = FALSE,
invisible(plots)
}
} else {
summ <- summary(x, ecx = FALSE)
ggbnec_data(x, add_nec = nec, add_ecx = ecx, xform = xform, ...) |>
mutate(model = "Model averaged predictions") |>
mutate(model = "Model averaged predictions",
tag = rownames(.env$summ$nec_vals)) |>
ggbnec(nec = nec, ecx = ecx)
}
}
Expand Down Expand Up @@ -386,10 +390,12 @@ ggbnec <- function(x, nec = TRUE, ecx = FALSE) {
linetype = ltys, colour = "grey50",
lwd = lwds) +
geom_text(data = x |> filter(!is.na(.data$nec_labs)),
mapping = aes(label = paste0("N(S)EC: ", .data$nec_labs, " (",
.data$nec_labs_l, "-",
.data$nec_labs_u, ")")),
x = Inf, y = Inf, hjust = 1.1, vjust = 1.5, size = 3,
mapping = aes(
label = paste0(
.data$tag, ": ", .data$nec_labs, " (", .data$nec_labs_l,
"-", .data$nec_labs_u, ")"
)
), x = Inf, y = Inf, hjust = 1.1, vjust = 1.5, size = 3,
colour = "grey50")
}
if (ecx) {
Expand Down
21 changes: 13 additions & 8 deletions R/plot.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -137,13 +137,16 @@ plot.bayesnecfit <- function(x, ..., CI = TRUE, add_nec = TRUE,
plot(x_dat, y_dat, ylab = ylab, xlab = xlab,
pch = 16, xaxt = "n", cex = 1.5,
col = adjustcolor(1, alpha.f = 0.25), ...)
nec_tag <- summary(x, ecx = FALSE) |>
(`[[`)("nec_vals") |>
rownames()
if (!inherits(lxform, "function")) {
if (length(xticks) == 1) {
axis(side = 1)
} else {
axis(side = 1, at = signif(xticks, 2))
}
legend_nec <- paste("NEC: ", signif(nec["Estimate"], 2),
legend_nec <- paste(nec_tag, ": ", signif(nec["Estimate"], 2),
" (", signif(nec["Q2.5"], 2), "-",
signif(nec["Q97.5"], 2), ")", sep = "")
legend_ec10 <- paste("EC10: ", signif(ec10[1], 2),
Expand All @@ -152,7 +155,7 @@ plot.bayesnecfit <- function(x, ..., CI = TRUE, add_nec = TRUE,
} else {
x_labs <- signif(lxform(x_ticks), 2)
axis(side = 1, at = x_ticks, labels = x_labs)
legend_nec <- paste("NEC: ", signif(lxform(nec["Estimate"]), 2),
legend_nec <- paste(nec_tag, ": ", signif(lxform(nec["Estimate"]), 2),
" (", signif(lxform(nec["Q2.5"]), 2), "-",
signif(lxform(nec["Q97.5"]), 2), ")", sep = "")
legend_ec10 <- paste("EC10: ", signif(lxform(ec10[1]), 2),
Expand Down Expand Up @@ -228,10 +231,9 @@ plot.bayesmanecfit <- function(x, ..., CI = TRUE, add_nec = TRUE,
par(mfrow = c(ceiling(length(mod_fits) / 2), 2),
mar = c(1.5, 1.5, 1.5, 1.5), oma = c(3, 3, 0, 0))
for (m in seq_along(mod_fits)) {
mod_fits[[m]] <- suppressMessages(suppressWarnings(expand_and_assign_nec(
x = mod_fits[[m]], formula = mod_fits[[m]]$bayesnecformula,
model = names(mod_fits)[m]
)))
mod_fits[[m]] <- pull_out(x, model = names(mod_fits)[m]) |>
suppressWarnings() |>
suppressMessages()
plot(x = mod_fits[[m]], CI = CI, add_nec = add_nec,
position_legend = position_legend, add_ec10 = add_ec10,
xform = xform, lxform = lxform,
Expand Down Expand Up @@ -285,13 +287,16 @@ plot.bayesmanecfit <- function(x, ..., CI = TRUE, add_nec = TRUE,
plot(x_dat, y_dat, ylab = ylab, xlab = xlab,
pch = 16, xaxt = "n", cex = 1.5,
col = adjustcolor(1, alpha.f = 0.25), ...)
nec_tag <- summary(x, ecx = FALSE) |>
(`[[`)("nec_vals") |>
rownames()
if (!inherits(lxform, "function")) {
if (length(xticks) == 1) {
axis(side = 1)
} else {
axis(side = 1, at = signif(xticks, 2))
}
legend_nec <- paste("NEC: ", signif(nec["Estimate"], 2),
legend_nec <- paste(nec_tag, ": ", signif(nec["Estimate"], 2),
" (", signif(nec["Q2.5"], 2), "-",
signif(nec["Q97.5"], 2), ")", sep = "")
legend_ec10 <- paste("EC10: ", signif(ec10[1], 2),
Expand All @@ -300,7 +305,7 @@ plot.bayesmanecfit <- function(x, ..., CI = TRUE, add_nec = TRUE,
} else {
x_labs <- signif(lxform(x_ticks), 2)
axis(side = 1, at = x_ticks, labels = x_labs)
legend_nec <- paste("NEC: ", signif(lxform(nec["Estimate"]), 2),
legend_nec <- paste(nec_tag, ": ", signif(lxform(nec["Estimate"]), 2),
" (", signif(lxform(nec["Q2.5"]), 2), "-",
signif(lxform(nec["Q97.5"]), 2), ")", sep = "")
legend_ec10 <- paste("EC10: ", signif(lxform(ec10[1]), 2),
Expand Down

0 comments on commit 2be55d5

Please sign in to comment.