Skip to content

Commit fc42558

Browse files
elgabbaselgabbas
committed
Fix convergence_plot
1 parent 3d9a5b0 commit fc42558

File tree

1 file changed

+82
-29
lines changed

1 file changed

+82
-29
lines changed

‎R/mod_convergence_plot.R‎

Lines changed: 82 additions & 29 deletions
Original file line numberDiff line numberDiff line change
@@ -244,8 +244,7 @@ convergence_plot <- function(
244244
}
245245

246246
IASDT.R::cat_time("Save plots", level = 1)
247-
# Using ggplot2::ggsave directly does not show non-ascii characters
248-
# correctly
247+
# Using ggplot2::ggsave directly does not show non-ascii characters correctly
249248
grDevices::cairo_pdf(
250249
filename = IASDT.R::path(Path_Convergence, "Convergence_Alpha.pdf"),
251250
width = 18, height = 14, onefile = TRUE)
@@ -570,18 +569,25 @@ convergence_plot <- function(
570569
SpeciesTaxonomy <- IASDT.R::get_species_name(env_file = env_file) %>%
571570
dplyr::select(IAS_ID, Class, Order, Family)
572571

572+
# # |||||||||||||||||||||||||||||||||||||||||||||||||||||||| ##
573+
574+
IASDT.R::cat_time("Starting preparing data for plotting", level = 2)
575+
Cols2remove <- c(
576+
"CI_025", "CI_975", "Var_Min", "Var_Max", "Class", "Order", "Family")
573577
Beta_DF <- Beta_DF %>%
574578
dplyr::left_join(VarRanges, by = "Variable") %>%
575579
dplyr::left_join(SpeciesTaxonomy, by = "IAS_ID") %>%
576580
dplyr::mutate(
577581
Var_Sp2 = paste0(Variable, "_", IAS_ID),
578582
Var_Sp_File = IASDT.R::path(Pah_Beta_Data, paste0(Var_Sp2, ".RData")),
583+
Plot_File = IASDT.R::path(Pah_Beta_Data, paste0(Var_Sp2, "_Plots.qs2")),
579584
DT = purrr::pmap(
580585
.l = list(
581586
Var_Sp, DT, CI_025, CI_975, Var_Min,
582587
Var_Max, Class, Order, Family),
583588
.f = function(Var_Sp, DT, CI_025, CI_975, Var_Min,
584589
Var_Max, Class, Order, Family) {
590+
585591
Beta_ID <- which(BetaNames == Var_Sp)
586592
Post <- coda::as.mcmc.list(Obj_Beta[, Beta_ID])
587593

@@ -601,35 +607,66 @@ convergence_plot <- function(
601607
Var_Min = Var_Min, Var_Max = Var_Max,
602608
Class = Class, Order = Order, Family = Family,
603609
Beta_ID = Beta_ID, Post = Post, Gelman = Gelman, ESS = ESS)
604-
}
605-
)) %>%
606-
dplyr::select(
607-
-tidyselect::all_of(
608-
c(
609-
"CI_025", "CI_975", "Var_Min", "Var_Max",
610-
"Class", "Order", "Family")))
611-
612-
Beta_DF %>%
613-
dplyr::group_by(Var_Sp) %>%
614-
dplyr::group_split() %>%
615-
purrr::walk(
616-
.f = ~ IASDT.R::save_as(
617-
object = .x$DT[[1]], object_name = .x$Var_Sp2,
618-
out_path = .x$Var_Sp_File))
619-
620-
Beta_DF <- dplyr::select(Beta_DF, -DT)
621-
622-
rm(CI, VarRanges, SpeciesTaxonomy, Obj_Beta, envir = environment())
610+
})) %>%
611+
dplyr::select(-tidyselect::all_of(Cols2remove))
612+
613+
rm(
614+
CI, VarRanges, SpeciesTaxonomy, Cols2remove, Obj_Beta,
615+
envir = environment())
623616
invisible(gc())
624617

625618
# # |||||||||||||||||||||||||||||||||||||||||||||||||||||||| ##
626619

627620
# Prepare working on parallel
621+
IASDT.R::cat_time("Prepare working on parallel", level = 2)
628622
IASDT.R::set_parallel(n_cores = min(n_cores, nrow(Beta_DF)), level = 2)
629623
withr::defer(future::plan("future::sequential", gc = TRUE))
630624

631625
# # |||||||||||||||||||||||||||||||||||||||||||||||||||||||| ##
632626

627+
# Save a small file for each of variables and species combination
628+
IASDT.R::cat_time(
629+
"Save a small file for each of variables and species combination",
630+
level = 2)
631+
632+
Beta_DF <- Beta_DF %>%
633+
dplyr::mutate(
634+
Save = furrr::future_pmap(
635+
.l = list(Var_Sp_File, Var_Sp2, DT),
636+
.f = function(Var_Sp_File, Var_Sp2, DT) {
637+
638+
# try saving for a max of 5 attempts using repeat loop
639+
attempt <- 1
640+
repeat {
641+
642+
if (attempt > 5) {
643+
stop(
644+
"Maximum attempts (5) reached without success: ",
645+
Var_Sp_File, call. = FALSE)
646+
}
647+
648+
try({
649+
IASDT.R::save_as(
650+
object = DT, object_name = Var_Sp2, out_path = Var_Sp_File)
651+
Sys.sleep(2)
652+
},
653+
silent = TRUE)
654+
655+
if (IASDT.R::check_data(Var_Sp_File, warning = FALSE)) {
656+
break
657+
}
658+
659+
# Increment attempt counter
660+
attempt <- attempt + 1
661+
}
662+
},
663+
.options = furrr::furrr_options(
664+
seed = TRUE, packages = c("IASDT.R", "tibble"))),
665+
Save = NULL,
666+
DT = NULL)
667+
668+
# # |||||||||||||||||||||||||||||||||||||||||||||||||||||||| ##
669+
633670
# Prepare plots
634671
IASDT.R::cat_time("Prepare plots", level = 2)
635672

@@ -641,20 +678,26 @@ convergence_plot <- function(
641678
Species <- Beta_DF$Species[x]
642679
Curr_IAS <- Beta_DF$IAS_ID[x]
643680
Var_Sp_File <- Beta_DF$Var_Sp_File[x]
644-
Plot_File <- stringr::str_replace(Var_Sp_File, ".RData$", "_Plots.qs2")
681+
Plot_File <- Beta_DF$Plot_File[x]
645682

646683
# 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)
684+
if (isFALSE(IASDT.R::check_data(Var_Sp_File, warning = FALSE))) {
685+
stop("File ", x, ": ", Var_Sp_File, " does not exist.", call. = FALSE)
649686
}
650687

651688
# Check if the output file already exists
652-
if (IASDT.R::check_data(Plot_File)) {
689+
if (IASDT.R::check_data(Plot_File, warning = FALSE)) {
653690
return(tibble::tibble(Var_Sp = Var_Sp, Plot_File = Plot_File))
654691
}
655692

693+
# delete file if corrupted
694+
if (file.exists(Plot_File)) {
695+
IASDT.R::system_command(
696+
command = paste0("rm -f ", Plot_File), R_object = FALSE,
697+
ignore.stdout = TRUE)
698+
}
699+
656700
attempt <- 1
657-
result <- NULL
658701

659702
repeat {
660703

@@ -664,12 +707,17 @@ convergence_plot <- function(
664707
call. = FALSE)
665708
}
666709

667-
result <- try({
710+
try({
668711

669712
DT_all <- IASDT.R::load_as(Var_Sp_File)
713+
if (is.null(DT_all) || !is.list(DT_all)) {
714+
stop("Loaded data is invalid for file: ", Var_Sp_File)
715+
}
716+
670717
DT_all$Post <- NULL
671718
invisible(gc())
672719

720+
673721
## Gelman convergence diagnostic
674722
Label_Gelman <- round(DT_all$Gelman$psrf, 3) %>%
675723
paste(collapse = " / ") %>%
@@ -772,7 +820,7 @@ convergence_plot <- function(
772820
color = "steelblue4")
773821
}
774822
})
775-
823+
776824
# Making marginal background matching the plot background
777825
# https://stackoverflow.com/a/78196022/3652584
778826
Plot2_Marginal$layout$t[1] <- 1
@@ -783,6 +831,9 @@ convergence_plot <- function(
783831
Plot = Plot, Plot_Marginal = Plot_Marginal,
784832
PlotFixedY_Marginal = Plot2_Marginal),
785833
out_path = Plot_File)
834+
835+
Sys.sleep(2)
836+
786837
},
787838
silent = TRUE)
788839

@@ -803,7 +854,9 @@ convergence_plot <- function(
803854
"Beta_DF", "NChains", "SampleSize", "chain_colors", "margin_type"),
804855
future.packages = c(
805856
"dplyr", "ggplot2", "ggtext", "magrittr", "stringr", "ggExtra",
806-
"coda", "IASDT.R", "qs2", "tibble")) %>%
857+
"coda", "IASDT.R", "qs2", "tibble"))
858+
859+
PlotObj_Beta <- PlotObj_Beta %>%
807860
dplyr::bind_rows() %>%
808861
dplyr::left_join(Beta_DF, ., by = "Var_Sp") %>%
809862
dplyr::left_join(VarsDesc, by = "Variable")

0 commit comments

Comments
 (0)