Skip to content

Commit 7eb871b

Browse files
elgabbaselgabbas
committed
Convergence_Plot: Temp fix for parallel
1 parent 7c93d4c commit 7eb871b

File tree

1 file changed

+22
-152
lines changed

1 file changed

+22
-152
lines changed

‎R/Mod_Convergence_Plot.R‎

Lines changed: 22 additions & 152 deletions
Original file line numberDiff line numberDiff line change
@@ -626,26 +626,27 @@ Convergence_Plot <- function(
626626
invisible(gc())
627627

628628
if (NCores > 1) {
629-
# Prepare working on parallel
630-
IASDT.R::CatTime("Prepare working on parallel", Level = 3)
631-
withr::local_options(
632-
future.globals.maxSize = 8000 * 1024^2, future.gc = TRUE,
633-
future.seed = TRUE)
634-
c1 <- snow::makeSOCKcluster(min(NCores, nrow(Beta_DF)))
635-
on.exit(try(snow::stopCluster(c1), silent = TRUE), add = TRUE)
636-
future::plan("future::cluster", workers = c1, gc = TRUE)
637-
on.exit(future::plan("future::sequential", gc = TRUE), add = TRUE)
638-
629+
if (.Platform$OS.type == "windows") {
630+
# Use cluster for Windows
631+
c1 <- snow::makeSOCKcluster(min(NCores, nrow(Beta_DF)))
632+
on.exit(try(snow::stopCluster(c1), silent = TRUE), add = TRUE)
633+
future::plan("future::cluster", workers = c1)
634+
on.exit(future::plan("future::sequential", gc = TRUE), add = TRUE)
635+
} else {
636+
# Use multicore for Linux/Mac
637+
future::plan("future::multicore", workers = min(NCores, nrow(Beta_DF)))
638+
on.exit(future::plan("future::sequential", gc = TRUE), add = TRUE)
639+
}
639640
} else {
640641
future::plan("future::sequential", gc = TRUE)
641642
}
642643

643644
# Prepare plots
644645
IASDT.R::CatTime("Prepare plots", Level = 3)
645646

646-
PlotObj_Beta <- furrr::future_map(
647-
.x = seq_len(nrow(Beta_DF)),
648-
.f = function(x) {
647+
PlotObj_Beta <- future.apply::future_lapply(
648+
X = seq_len(nrow(Beta_DF)),
649+
FUN = function(x) {
649650
Var_Sp <- Beta_DF$Var_Sp[x]
650651
Species <- Beta_DF$Species[x]
651652
Curr_IAS <- Beta_DF$IAS_ID[x]
@@ -687,7 +688,8 @@ Convergence_Plot <- function(
687688
x = Iter, y = Value, color = factor(Chain))) +
688689
ggplot2::geom_line(linewidth = 0.15, alpha = 0.6) +
689690
ggplot2::geom_smooth(
690-
method = "loess", formula = y ~ x, se = FALSE, linewidth = 0.8) +
691+
method = "loess", formula = y ~ x,
692+
se = FALSE, linewidth = 0.8) +
691693
ggplot2::geom_point(alpha = 0) +
692694
ggplot2::geom_hline(
693695
yintercept = CurrCI, linetype = "dashed", color = "black",
@@ -763,148 +765,16 @@ Convergence_Plot <- function(
763765

764766
return(tibble::tibble(Var_Sp = Var_Sp, Plot_File = Plot_File))
765767
},
766-
.options = furrr::furrr_options(
767-
seed = TRUE, scheduling = 1,
768-
globals = c(
769-
"Beta_DF", "NChains", "SampleSize", "Cols", "MarginType",
770-
"VarsDesc", "CurrCI"),
771-
packages = c(
772-
"dplyr", "ggplot2", "ggtext", "magrittr", "stringr", "ggExtra",
773-
"coda", "IASDT.R", "qs2", "tibble"))) %>%
768+
future.seed = TRUE,
769+
future.globals = c(
770+
"Beta_DF", "NChains", "SampleSize", "Cols", "MarginType"),
771+
future.packages = c(
772+
"dplyr", "ggplot2", "ggtext", "magrittr", "stringr", "ggExtra",
773+
"coda", "IASDT.R", "qs2", "tibble")) %>%
774774
dplyr::bind_rows() %>%
775775
dplyr::left_join(Beta_DF, ., by = "Var_Sp") %>%
776776
dplyr::left_join(VarsDesc, by = "Variable")
777777

778-
# PlotObj_Beta <- future.apply::future_lapply(
779-
# X = seq_len(nrow(Beta_DF)),
780-
# FUN = function(x) {
781-
# Var_Sp <- Beta_DF$Var_Sp[x]
782-
# Species <- Beta_DF$Species[x]
783-
# Curr_IAS <- Beta_DF$IAS_ID[x]
784-
# Var_Sp_File <- Beta_DF$Var_Sp_File[x]
785-
# Plot_File <- stringr::str_replace(Var_Sp_File, ".RData$", "_Plots.qs2")
786-
#
787-
# DT_all <- IASDT.R::LoadAs(Var_Sp_File)
788-
# DT_all$Post <- NULL
789-
# invisible(gc())
790-
#
791-
# ## Gelman convergence diagnostic
792-
# Label_Gelman <- round(DT_all$Gelman$psrf, 3) %>%
793-
# paste0(collapse = " / ") %>%
794-
# paste0("<b><i>Gelman convergence diagnostic:</i></b> ", .) %>%
795-
# data.frame(x = Inf, y = -Inf, label = .)
796-
#
797-
# ## Effective sample size / CI
798-
# Label_ESS <- round(DT_all$ESS / NChains) %>%
799-
# paste0(
800-
# "<b><i>Mean effective sample size:</i></b> ", ., " / ", SampleSize)
801-
# CurrCI <- c(DT_all$CI_025, DT_all$CI_975)
802-
# Label_CI <- paste0(round(CurrCI, 4), collapse = " to ") %>%
803-
# paste0("<b><i>95% credible interval:</i></b> ", .)
804-
# Label_ESS_CI <- data.frame(
805-
# x = -Inf, y = -Inf, label = paste0(Label_ESS, "<br>", Label_CI))
806-
#
807-
# Label_Panel <- data.frame(
808-
# x = Inf, y = Inf, label = paste0("<br><b><i>", Species, "</i></b>"))
809-
#
810-
# PanelTitle <- c(DT_all$Class, DT_all$Order, DT_all$Family) %>%
811-
# paste0(collapse = " | ") %>%
812-
# paste0("<b>", ., "</b>") %>%
813-
# paste0("<br>", Curr_IAS) %>%
814-
# data.frame(x = -Inf, y = Inf, label = .)
815-
#
816-
# Plot <- ggplot2::ggplot(
817-
# data = DT_all$DT,
818-
# mapping = ggplot2::aes(
819-
# x = Iter, y = Value, color = factor(Chain))) +
820-
# ggplot2::geom_line(linewidth = 0.15, alpha = 0.6) +
821-
# ggplot2::geom_smooth(
822-
# method = "loess", formula = y ~ x,
823-
# se = FALSE, linewidth = 0.8) +
824-
# ggplot2::geom_point(alpha = 0) +
825-
# ggplot2::geom_hline(
826-
# yintercept = CurrCI, linetype = "dashed", color = "black",
827-
# linewidth = 1) +
828-
# # Ensure that y-axis always show 0
829-
# ggplot2::geom_hline(
830-
# yintercept = 0, linetype = "dashed",
831-
# color = "transparent", linewidth = 0.6) +
832-
# ggplot2::scale_color_manual(values = Cols) +
833-
# ggplot2::scale_x_continuous(expand = c(0, 0)) +
834-
# ggtext::geom_richtext(
835-
# mapping = ggplot2::aes(x = x, y = y, label = label),
836-
# data = Label_Gelman, inherit.aes = FALSE, size = 3.5, hjust = 1,
837-
# vjust = -0, lineheight = 0, fill = NA, label.color = NA) +
838-
# ggtext::geom_richtext(
839-
# mapping = ggplot2::aes(x = x, y = y, label = label),
840-
# data = Label_ESS_CI, inherit.aes = FALSE, size = 3.5, hjust = 0,
841-
# vjust = 0, lineheight = 0, fill = NA, label.color = NA) +
842-
# ggtext::geom_richtext(
843-
# mapping = ggplot2::aes(x = x, y = y, label = label),
844-
# data = Label_Panel, inherit.aes = FALSE, colour = "blue",
845-
# hjust = 1, vjust = 1, lineheight = 0, fill = NA, label.color = NA) +
846-
# ggtext::geom_richtext(
847-
# mapping = ggplot2::aes(x = x, y = y, label = label),
848-
# data = PanelTitle, inherit.aes = FALSE, hjust = 0, vjust = 1,
849-
# lineheight = 0, fill = NA, label.color = NA) +
850-
# ggplot2::theme_bw() +
851-
# ggplot2::xlab(NULL) +
852-
# ggplot2::ylab(NULL) +
853-
# ggplot2::theme(
854-
# legend.position = "none",
855-
# axis.text = ggplot2::element_text(size = 12))
856-
#
857-
# suppressMessages({
858-
# Plot2 <- Plot +
859-
# ggplot2::scale_y_continuous(
860-
# limits = c(DT_all$Var_Min, DT_all$Var_Max))
861-
# })
862-
#
863-
# if (MarginType == "histogram") {
864-
# Plot_Marginal <- ggExtra::ggMarginal(
865-
# p = Plot, type = MarginType, margins = "y", size = 6,
866-
# color = "steelblue4", fill = "steelblue4", bins = 100)
867-
# } else {
868-
# Plot_Marginal <- ggExtra::ggMarginal(
869-
# p = Plot, type = MarginType, margins = "y", size = 6,
870-
# color = "steelblue4")
871-
# }
872-
# # Making marginal background matching the plot background
873-
# # https://stackoverflow.com/a/78196022/3652584
874-
# Plot_Marginal$layout$t[1] <- 1
875-
# Plot_Marginal$layout$r[1] <- max(Plot_Marginal$layout$r)
876-
#
877-
# if (MarginType == "histogram") {
878-
# Plot2_Marginal <- ggExtra::ggMarginal(
879-
# p = Plot2, type = MarginType, margins = "y", size = 6,
880-
# color = "steelblue4", fill = "steelblue4", bins = 100)
881-
# } else {
882-
# Plot2_Marginal <- ggExtra::ggMarginal(
883-
# p = Plot2, type = MarginType, margins = "y", size = 6,
884-
# color = "steelblue4")
885-
# }
886-
# # Making marginal background matching the plot background
887-
# # https://stackoverflow.com/a/78196022/3652584
888-
# Plot2_Marginal$layout$t[1] <- 1
889-
# Plot2_Marginal$layout$r[1] <- max(Plot2_Marginal$layout$r)
890-
#
891-
# IASDT.R::SaveAs(
892-
# InObj = list(
893-
# Plot = Plot, Plot_Marginal = Plot_Marginal,
894-
# PlotFixedY_Marginal = Plot2_Marginal),
895-
# OutPath = Plot_File)
896-
#
897-
# return(tibble::tibble(Var_Sp = Var_Sp, Plot_File = Plot_File))
898-
# },
899-
# future.seed = TRUE,
900-
# future.globals = c(
901-
# "Beta_DF", "NChains", "SampleSize", "Cols", "MarginType"),
902-
# future.packages = c(
903-
# # "dplyr", "ggplot2", "ggtext", "magrittr", "coda", "IASDT.R")) %>%
904-
# dplyr::bind_rows() %>%
905-
# dplyr::left_join(Beta_DF, ., by = "Var_Sp") %>%
906-
# dplyr::left_join(VarsDesc, by = "Variable")
907-
908778
# Stopping cluster
909779
if (NCores > 1) {
910780
IASDT.R::CatTime("Stopping cluster", Level = 3)

0 commit comments

Comments
 (0)