Skip to content

Commit 3d9a5b0

Browse files
elgabbaselgabbas
committed
convergence_plot: Use repeat/try to fix issue exporting convergence plot of beta parameter for some models
1 parent 5977acc commit 3d9a5b0

File tree

7 files changed

+152
-106
lines changed

7 files changed

+152
-106
lines changed

‎DESCRIPTION‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,7 @@ Package: IASDT.R
33
Title: Modelling the distribution of invasive alien plant species in
44
Europe
55
Version: 0.1.04
6-
Date: 2025-04-10
6+
Date: 2025-04-11
77
Authors@R:
88
person("Ahmed", "El-Gabbas", , "ahmed.el-gabbas@ufz.de", role = c("aut", "cre"),
99
comment = c(ORCID = "0000-0003-2225-088X"))

‎R/general_info_chunk.R‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -53,7 +53,7 @@ info_chunk <- function(
5353
sep_lines_after = sep_lines_after, cat_red = cat_red, cat_bold = cat_bold)
5454
IASDT.R::cat_time(
5555
text = message, msg_n_lines = msg_n_lines,
56-
cat_timestamp = cat_time, cat_date = cat_date, level = level,
56+
cat_timestamp = cat_timestamp, cat_date = cat_date, level = level,
5757
cat_red = cat_red, cat_bold = cat_bold)
5858
IASDT.R::cat_sep(
5959
..., sep_lines_before = sep_lines_before,

‎R/general_load_as.R‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -95,7 +95,7 @@ load_as <- function(file = NULL, n_threads = 5, timeout = 300, ...) {
9595
}
9696

9797
if (!file.exists(file)) {
98-
stop("`file` not found", call. = FALSE)
98+
stop("`file` does not exist: ", file, call. = FALSE)
9999
}
100100

101101
OutFile <- switch(

‎R/mod_convergence_plot.R‎

Lines changed: 144 additions & 100 deletions
Original file line numberDiff line numberDiff line change
@@ -636,123 +636,167 @@ convergence_plot <- function(
636636
PlotObj_Beta <- future.apply::future_lapply(
637637
X = seq_len(nrow(Beta_DF)),
638638
FUN = function(x) {
639+
639640
Var_Sp <- Beta_DF$Var_Sp[x]
640641
Species <- Beta_DF$Species[x]
641642
Curr_IAS <- Beta_DF$IAS_ID[x]
642643
Var_Sp_File <- Beta_DF$Var_Sp_File[x]
643644
Plot_File <- stringr::str_replace(Var_Sp_File, ".RData$", "_Plots.qs2")
644645

645-
DT_all <- IASDT.R::load_as(Var_Sp_File)
646-
DT_all$Post <- NULL
647-
invisible(gc())
646+
# check if input data exists
647+
if (isFALSE(IASDT.R::check_data(Var_Sp_File))) {
648+
stop("File ", Var_Sp_File, " does not exist.", call. = FALSE)
649+
}
648650

649-
## Gelman convergence diagnostic
650-
Label_Gelman <- round(DT_all$Gelman$psrf, 3) %>%
651-
paste(collapse = " / ") %>%
652-
paste0("<b><i>Gelman convergence diagnostic:</i></b> ", .) %>%
653-
data.frame(x = Inf, y = -Inf, label = .)
651+
# Check if the output file already exists
652+
if (IASDT.R::check_data(Plot_File)) {
653+
return(tibble::tibble(Var_Sp = Var_Sp, Plot_File = Plot_File))
654+
}
654655

655-
## Effective sample size / CI
656-
Label_ESS <- round(DT_all$ESS / NChains) %>%
657-
paste0(
658-
"<b><i>Mean effective sample size:</i></b> ", ., " / ", SampleSize)
659-
CurrCI <- c(DT_all$CI_025, DT_all$CI_975)
660-
Label_CI <- paste(round(CurrCI, 4), collapse = " to ") %>%
661-
paste0("<b><i>95% credible interval:</i></b> ", .)
662-
Label_ESS_CI <- data.frame(
663-
x = -Inf, y = -Inf, label = paste0(Label_ESS, "<br>", Label_CI))
656+
attempt <- 1
657+
result <- NULL
664658

665-
Label_Panel <- data.frame(
666-
x = Inf, y = Inf, label = paste0("<br><b><i>", Species, "</i></b>"))
659+
repeat {
667660

668-
PanelTitle <- c(DT_all$Class, DT_all$Order, DT_all$Family) %>%
669-
paste(collapse = " | ") %>%
670-
paste0("<b>", ., "</b>") %>%
671-
paste0("<br>", Curr_IAS) %>%
672-
data.frame(x = -Inf, y = Inf, label = .)
661+
if (attempt > 5) {
662+
stop(
663+
"Maximum attempts (5) reached without success: ", Var_Sp_File,
664+
call. = FALSE)
665+
}
673666

674-
Plot <- ggplot2::ggplot(
675-
data = DT_all$DT,
676-
mapping = ggplot2::aes(
677-
x = Iter, y = Value, color = factor(Chain))) +
678-
ggplot2::geom_line(linewidth = 0.15, alpha = 0.6) +
679-
ggplot2::geom_smooth(
680-
method = "loess", formula = y ~ x,
681-
se = FALSE, linewidth = 0.8) +
682-
ggplot2::geom_point(alpha = 0) +
683-
ggplot2::geom_hline(
684-
yintercept = CurrCI, linetype = "dashed", color = "black",
685-
linewidth = 1) +
686-
# Ensure that y-axis always show 0
687-
ggplot2::geom_hline(
688-
yintercept = 0, linetype = "dashed",
689-
color = "transparent", linewidth = 0.6) +
690-
ggplot2::scale_color_manual(values = chain_colors) +
691-
ggplot2::scale_x_continuous(expand = c(0, 0)) +
692-
ggtext::geom_richtext(
693-
mapping = ggplot2::aes(x = x, y = y, label = label),
694-
data = Label_Gelman, inherit.aes = FALSE, size = 3.5, hjust = 1,
695-
vjust = -0, lineheight = 0, fill = NA, label.color = NA) +
696-
ggtext::geom_richtext(
697-
mapping = ggplot2::aes(x = x, y = y, label = label),
698-
data = Label_ESS_CI, inherit.aes = FALSE, size = 3.5, hjust = 0,
699-
vjust = 0, lineheight = 0, fill = NA, label.color = NA) +
700-
ggtext::geom_richtext(
701-
mapping = ggplot2::aes(x = x, y = y, label = label),
702-
data = Label_Panel, inherit.aes = FALSE, colour = "blue",
703-
hjust = 1, vjust = 1, lineheight = 0, fill = NA, label.color = NA) +
704-
ggtext::geom_richtext(
705-
mapping = ggplot2::aes(x = x, y = y, label = label),
706-
data = PanelTitle, inherit.aes = FALSE, hjust = 0, vjust = 1,
707-
lineheight = 0, fill = NA, label.color = NA) +
708-
ggplot2::theme_bw() +
709-
ggplot2::xlab(NULL) +
710-
ggplot2::ylab(NULL) +
711-
ggplot2::theme(
712-
legend.position = "none",
713-
axis.text = ggplot2::element_text(size = 12))
667+
result <- try({
668+
669+
DT_all <- IASDT.R::load_as(Var_Sp_File)
670+
DT_all$Post <- NULL
671+
invisible(gc())
672+
673+
## Gelman convergence diagnostic
674+
Label_Gelman <- round(DT_all$Gelman$psrf, 3) %>%
675+
paste(collapse = " / ") %>%
676+
paste0("<b><i>Gelman convergence diagnostic:</i></b> ", .) %>%
677+
data.frame(x = Inf, y = -Inf, label = .)
678+
679+
## Effective sample size / CI
680+
Label_ESS <- round(DT_all$ESS / NChains) %>%
681+
paste0(
682+
"<b><i>Mean effective sample size:</i></b> ",
683+
., " / ", SampleSize)
684+
CurrCI <- c(DT_all$CI_025, DT_all$CI_975)
685+
Label_CI <- paste(round(CurrCI, 4), collapse = " to ") %>%
686+
paste0("<b><i>95% credible interval:</i></b> ", .)
687+
Label_ESS_CI <- data.frame(
688+
x = -Inf, y = -Inf, label = paste0(Label_ESS, "<br>", Label_CI))
689+
690+
Label_Panel <- data.frame(
691+
x = Inf, y = Inf,
692+
label = paste0("<br><b><i>", Species, "</i></b>"))
693+
694+
PanelTitle <- c(DT_all$Class, DT_all$Order, DT_all$Family) %>%
695+
paste(collapse = " | ") %>%
696+
paste0("<b>", ., "</b>") %>%
697+
paste0("<br>", Curr_IAS) %>%
698+
data.frame(x = -Inf, y = Inf, label = .)
699+
700+
Plot <- ggplot2::ggplot(
701+
data = DT_all$DT,
702+
mapping = ggplot2::aes(
703+
x = Iter, y = Value, color = factor(Chain))) +
704+
ggplot2::geom_line(linewidth = 0.15, alpha = 0.6) +
705+
ggplot2::geom_smooth(
706+
method = "loess", formula = y ~ x,
707+
se = FALSE, linewidth = 0.8) +
708+
ggplot2::geom_point(alpha = 0) +
709+
ggplot2::geom_hline(
710+
yintercept = CurrCI, linetype = "dashed", color = "black",
711+
linewidth = 1) +
712+
# Ensure that y-axis always show 0
713+
ggplot2::geom_hline(
714+
yintercept = 0, linetype = "dashed",
715+
color = "transparent", linewidth = 0.6) +
716+
ggplot2::scale_color_manual(values = chain_colors) +
717+
ggplot2::scale_x_continuous(expand = c(0, 0)) +
718+
ggtext::geom_richtext(
719+
mapping = ggplot2::aes(x = x, y = y, label = label),
720+
data = Label_Gelman, inherit.aes = FALSE, size = 3.5, hjust = 1,
721+
vjust = -0, lineheight = 0, fill = NA, label.color = NA) +
722+
ggtext::geom_richtext(
723+
mapping = ggplot2::aes(x = x, y = y, label = label),
724+
data = Label_ESS_CI, inherit.aes = FALSE, size = 3.5, hjust = 0,
725+
vjust = 0, lineheight = 0, fill = NA, label.color = NA) +
726+
ggtext::geom_richtext(
727+
mapping = ggplot2::aes(x = x, y = y, label = label),
728+
data = Label_Panel, inherit.aes = FALSE, colour = "blue",
729+
hjust = 1, vjust = 1, lineheight = 0, fill = NA,
730+
label.color = NA) +
731+
ggtext::geom_richtext(
732+
mapping = ggplot2::aes(x = x, y = y, label = label),
733+
data = PanelTitle, inherit.aes = FALSE, hjust = 0, vjust = 1,
734+
lineheight = 0, fill = NA, label.color = NA) +
735+
ggplot2::theme_bw() +
736+
ggplot2::xlab(NULL) +
737+
ggplot2::ylab(NULL) +
738+
ggplot2::theme(
739+
legend.position = "none",
740+
axis.text = ggplot2::element_text(size = 12))
741+
742+
suppressMessages({
743+
Plot2 <- Plot +
744+
ggplot2::scale_y_continuous(
745+
limits = c(DT_all$Var_Min, DT_all$Var_Max))
746+
})
747+
748+
749+
if (margin_type == "histogram") {
750+
Plot_Marginal <- ggExtra::ggMarginal(
751+
p = Plot, type = margin_type, margins = "y", size = 6,
752+
color = "steelblue4", fill = "steelblue4", bins = 100)
753+
} else {
754+
Plot_Marginal <- ggExtra::ggMarginal(
755+
p = Plot, type = margin_type, margins = "y", size = 6,
756+
color = "steelblue4")
757+
}
714758

715-
suppressMessages({
716-
Plot2 <- Plot +
717-
ggplot2::scale_y_continuous(
718-
limits = c(DT_all$Var_Min, DT_all$Var_Max))
719-
})
759+
# Making marginal background matching the plot background
760+
# https://stackoverflow.com/a/78196022/3652584
761+
Plot_Marginal$layout$t[1] <- 1
762+
Plot_Marginal$layout$r[1] <- max(Plot_Marginal$layout$r)
720763

721-
if (margin_type == "histogram") {
722-
Plot_Marginal <- ggExtra::ggMarginal(
723-
p = Plot, type = margin_type, margins = "y", size = 6,
724-
color = "steelblue4", fill = "steelblue4", bins = 100)
725-
} else {
726-
Plot_Marginal <- ggExtra::ggMarginal(
727-
p = Plot, type = margin_type, margins = "y", size = 6,
728-
color = "steelblue4")
729-
}
730-
# Making marginal background matching the plot background
731-
# https://stackoverflow.com/a/78196022/3652584
732-
Plot_Marginal$layout$t[1] <- 1
733-
Plot_Marginal$layout$r[1] <- max(Plot_Marginal$layout$r)
764+
suppressWarnings({
765+
if (margin_type == "histogram") {
766+
Plot2_Marginal <- ggExtra::ggMarginal(
767+
p = Plot2, type = margin_type, margins = "y", size = 6,
768+
color = "steelblue4", fill = "steelblue4", bins = 100)
769+
} else {
770+
Plot2_Marginal <- ggExtra::ggMarginal(
771+
p = Plot2, type = margin_type, margins = "y", size = 6,
772+
color = "steelblue4")
773+
}
774+
})
775+
776+
# Making marginal background matching the plot background
777+
# https://stackoverflow.com/a/78196022/3652584
778+
Plot2_Marginal$layout$t[1] <- 1
779+
Plot2_Marginal$layout$r[1] <- max(Plot2_Marginal$layout$r)
780+
781+
IASDT.R::save_as(
782+
object = list(
783+
Plot = Plot, Plot_Marginal = Plot_Marginal,
784+
PlotFixedY_Marginal = Plot2_Marginal),
785+
out_path = Plot_File)
786+
},
787+
silent = TRUE)
734788

735-
if (margin_type == "histogram") {
736-
Plot2_Marginal <- ggExtra::ggMarginal(
737-
p = Plot2, type = margin_type, margins = "y", size = 6,
738-
color = "steelblue4", fill = "steelblue4", bins = 100)
739-
} else {
740-
Plot2_Marginal <- ggExtra::ggMarginal(
741-
p = Plot2, type = margin_type, margins = "y", size = 6,
742-
color = "steelblue4")
789+
if (IASDT.R::check_data(Plot_File, warning = FALSE)) {
790+
break
791+
}
792+
793+
# Increment attempt counter
794+
attempt <- attempt + 1
743795
}
744-
# Making marginal background matching the plot background
745-
# https://stackoverflow.com/a/78196022/3652584
746-
Plot2_Marginal$layout$t[1] <- 1
747-
Plot2_Marginal$layout$r[1] <- max(Plot2_Marginal$layout$r)
748796

749-
IASDT.R::save_as(
750-
object = list(
751-
Plot = Plot, Plot_Marginal = Plot_Marginal,
752-
PlotFixedY_Marginal = Plot2_Marginal),
753-
out_path = Plot_File)
797+
# Return result if successful
798+
tibble::tibble(Var_Sp = Var_Sp, Plot_File = Plot_File)
754799

755-
return(tibble::tibble(Var_Sp = Var_Sp, Plot_File = Plot_File))
756800
},
757801
future.seed = TRUE,
758802
future.globals = c(

‎R/mod_convergence_plot_all.R‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -553,7 +553,7 @@ convergence_plot_all <- function(
553553
# # ..................................................................... ###
554554

555555
IASDT.R::cat_diff(
556-
init_time = .StartTime, prefix = "Plotting model convergence took ")
556+
init_time = .StartTime, prefix = "\nPlotting model convergence took ")
557557

558558
# # ..................................................................... ###
559559

‎R/mod_merge_chains.R‎

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -407,7 +407,9 @@ mod_merge_chains <- function(
407407

408408
if (length(MissingModelVars) > 0) {
409409
IASDT.R::cat_time("Unsuccessful models")
410-
purrr::walk(MissingModelVars, IASDT.R::cat_time, level = 1)
410+
purrr::walk(
411+
.x = MissingModelVars, .f = IASDT.R::cat_time,
412+
cat_timestamp = FALSE, level = 1)
411413
}
412414
}
413415

‎README.md‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -74,4 +74,4 @@ If you use the `IASDT.R` package, please cite it as:
7474
> <a href="https://biodt.eu" target="_blank">https://biodt.eu</a>.
7575
7676
<span style=" color: grey !important;">Last update:
77-
2025-04-10</span>
77+
2025-04-11</span>

0 commit comments

Comments
 (0)