Skip to content

Update compatability with bgms = 0.2.0.0 #1

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.

Sign up for GitHub

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

Open
sekulovskin wants to merge 6 commits into
base: main
Choose a base branch
from
Open

Update compatability with bgms = 0.2.0.0 #1

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
6 commits
Select commit Hold shift + click to select a range
5cf067f
Update compatability with bgms = 0.1.6.4
Mar 25, 2026
508250d
fix: remove redundant class(fit) reassignment that breaks S7 bgms obj…
MaartenMarsman Mar 31, 2026
f25f884
Merge pull request #2 from Bayesian-Graphical-Modelling-Lab/fix/remov…
MaartenMarsman Mar 31, 2026
c0b6c49
update bgms version requirement
Mar 31, 2026
fb0b125
resovle merge conflicts
Mar 31, 2026
c402b3d
fix type argument to take on a vector for easybgm_compare
Apr 2, 2026
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
13 changes: 7 additions & 6 deletions DESCRIPTION
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -10,11 +10,12 @@ Authors@R: c(
person("Gali", "Geller", role = c("ctb"))
)
Maintainer: Karoline Huth <k.huth@uva.nl>
Description: Fit and visualize the results of a Bayesian analysis of networks commonly found in psychology.
The package supports cross-sectional network models fitted using the packages 'BDgraph', 'bgms' and 'BGGM',
as well as network comparison tests fitted using the packages 'bgms' and 'BBGM'.
The package provides the parameter estimates, posterior inclusion probabilities, inclusion Bayes factor, and the
posterior density of the parameters. In addition, for 'BDgraph' and 'bgms' it allows to assess the posterior
Description: Fit and visualize the results of a Bayesian analysis of networks commonly found in psychology.
The package supports cross-sectional network models for ordinal, binary, continuous, and mixed data,
fitted using the packages 'bgms' (default), 'BDgraph', and 'BGGM',
as well as network comparison tests fitted using the packages 'bgms' and 'BGGM'.
The package provides the parameter estimates, posterior inclusion probabilities, inclusion Bayes factor, and the
posterior density of the parameters. In addition, for 'BDgraph' and 'bgms' it allows to assess the posterior
structure space. Furthermore, the package comes with an extensive suite for visualizing results.
License: GPL (>= 2)
URL: https://github.com/KarolineHuth/easybgm
Expand All @@ -28,7 +29,7 @@ Depends:
Imports:
BDgraph,
BGGM,
bgms (>= 0.1.4),
bgms (>= 0.2.0.0),
dplyr,
ggplot2,
HDInterval,
Expand Down
412 changes: 291 additions & 121 deletions R/easybgm.R
View file
Open in desktop

Large diffs are not rendered by default.

279 changes: 187 additions & 92 deletions R/easybgm_compare.R
View file
Open in desktop

Large diffs are not rendered by default.

115 changes: 65 additions & 50 deletions R/functions.bgms.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -4,30 +4,33 @@
#' @export
bgm_fit.package_bgms <- function(fit, type, data, iter, save,
not_cont, centrality, progress, ...){


if(type == "binary") {
type <- "ordinal"

# Store original easybgm type before mapping
original_type <- type

# Map easybgm type to bgms variable_type
if(length(type) > 1) {
# Vector type: per-variable specification, map binary -> ordinal, pass to bgms
variable_type <- type
variable_type[variable_type == "binary"] <- "ordinal"
# Store a simplified label for display
original_type <- if(length(unique(type)) == 1) unique(type) else "mixed"
} else if(type == "binary") {
variable_type <- "ordinal"
} else if(type == "mixed") {
variable_type <- ifelse(not_cont == 1, "ordinal", "continuous")
} else {
variable_type <- type
}

if(packageVersion("bgms") > "0.1.4.2"){
bgms_fit <- do.call(
bgm, c(list(x = data, iter = iter,
variable_type = type,
display_progress = progress,
...))
)}
if(packageVersion("bgms") < "0.1.6"){
bgms_fit <- do.call(
bgm, c(list(x = data, iter = iter, save = T,
variable_type = type,
display_progress = progress,
...))
)}



fit$model <- type

bgms_fit <- do.call(
bgm, c(list(x = data, iter = iter,
variable_type = variable_type,
display_progress = progress,
...))
)

fit$model <- original_type
fit$packagefit <- bgms_fit
if(is.null(colnames(data))){
fit$var_names <- paste0("V", 1:ncol(data))
Expand All @@ -44,21 +47,23 @@ bgm_fit.package_bgms <- function(fit, type, data, iter, save,
#' @export
bgm_extract.package_bgms <- function(fit, type, save, iter,
not_cont, data, centrality, ...){
if (packageVersion("bgms") < "0.1.4") {
stop("easybgm now requires bgms version 0.1.4 or higher.")
}
# --- Ensure proper bgms object and variable names ---
# Determine display-friendly model label
if(length(type) > 1) {
model_label <- if(length(unique(type)) == 1) unique(type) else "mixed"
} else {
model_label <- type
}

if (!inherits(fit, "bgms")) {
varnames <- fit$var_names
fit <- fit$packagefit
class(fit) <- "bgms"
} else {
varnames <- fit$arguments$data_columnnames
args_tmp <- extract_arguments(fit)
varnames <- args_tmp$data_columnnames
if (is.null(varnames)) {
varnames <- paste0("V", 1:fit$arguments$no_variables)}
}
if(packageVersion("bgms") > "0.1.4.2"){
class(fit) <- "bgms"
varnames <- paste0("V", 1:args_tmp$num_variables)
}
}

# --- Extract model arguments and edge priors ---
Expand All @@ -73,7 +78,7 @@ bgm_extract.package_bgms <- function(fit, type, save, iter,
args$edge_selection <- FALSE
}
}
if (args$edge_prior[1] == "Stochastic-Block" && packageVersion("bgms") > "0.1.6") {
if (args$edge_prior[1] == "Stochastic-Block") {
bgms_res$sbm <- extract_sbm(fit)
}
# extract the prior inclusion probabilities
Expand Down Expand Up @@ -142,12 +147,12 @@ bgm_extract.package_bgms <- function(fit, type, save, iter,
}
# --- Main extraction ---
if (args$save) {
p <- args$no_variables
p <- args$num_variables
pars <- extract_pairwise_interactions(fit)
bgms_res$parameters <- vector2matrix(colMeans(pars), p = p)
bgms_res$samples_posterior <- extract_pairwise_interactions(fit)
bgms_res$thresholds <- extract_category_thresholds(fit)
rownames(bgms_res$parameters) <- colnames(bgms_res$parameters) <- varnames
bgms_res$thresholds <- extract_main_effects(fit)
colnames(bgms_res$parameters) <- varnames
bgms_res$structure <- matrix(1, ncol = p, nrow = p)
if (args$edge_selection) {
bgms_res$inc_probs <- extract_posterior_inclusion_probabilities(fit)
Expand All @@ -159,7 +164,7 @@ bgm_extract.package_bgms <- function(fit, type, save, iter,
(args$beta_bernoulli_alpha / args$beta_bernoulli_beta)
} else if (args$edge_prior[1] == "Stochastic-Block") {
# when there is only one set of hyperparameters for the beta bernoulli
if (is.null(args$beta_bernoulli_alpha_between) | packageVersion("bgms") < "0.1.6") {
if (is.null(args$beta_bernoulli_alpha_between)) {
bgms_res$inc_BF <- (bgms_res$inc_probs / (1 - bgms_res$inc_probs)) /
(args$beta_bernoulli_alpha / args$beta_bernoulli_beta)
} else {
Expand Down Expand Up @@ -190,11 +195,11 @@ bgm_extract.package_bgms <- function(fit, type, save, iter,
bgms_res$sample_graph <- as.character(table_structures[, 1])
}
} else {
p <- args$no_variables
p <- args$num_variables
pars <- extract_pairwise_interactions(fit)
bgms_res$parameters <- vector2matrix(colMeans(pars), p = p)
bgms_res$thresholds <- extract_category_thresholds(fit)
rownames(bgms_res$parameters) <- colnames(bgms_res$parameters) <- varnames
bgms_res$thresholds <- extract_main_effects(fit)
colnames(bgms_res$parameters) <- varnames
bgms_res$structure <- matrix(1, ncol = ncol(bgms_res$parameters),
nrow = nrow(bgms_res$parameters))
if (args$edge_selection) {
Expand Down Expand Up @@ -243,20 +248,30 @@ bgm_extract.package_bgms <- function(fit, type, save, iter,
bgms_res$centrality <- centrality(bgms_res)
}

# --- For newer version compute convergence ---
if (packageVersion("bgms") > "0.1.4.2" && args$edge_selection == T) {

# --- Compute convergence diagnostics ---
if (args$edge_selection == TRUE) {
# extract the Rhat
bgms_res$convergence_parameter <- fit$posterior_summary_pairwise$Rhat
bgms_res$convergence_parameter <- extract_rhat(fit)$pairwise
# calculate MC uncertainty
bgms_res$MCSE_BF <-BF_MCSE(gamma_mat = extract_indicators(fit),
BF_vec = bgms_res$inc_BF[lower.tri(bgms_res$inc_BF)],
ess = fit$posterior_summary_indicator$n_eff,
return = "ci",
smooth_bf = FALSE)
bgms_res$MCSE_BF <- BF_MCSE(gamma_mat = extract_indicators(fit),
BF_vec = bgms_res$inc_BF[lower.tri(bgms_res$inc_BF)],
ess = extract_ess(fit)$indicator,
return = "ci",
smooth_bf = FALSE)
}
# --- Extract interpretable parameter scales ---
# These return NULL when the model type doesn't support them.
# tryCatch guards against edge cases (e.g., mixed models with only
# one variable of a given type, where the sub-matrix is a scalar).
bgms_res$partial_correlations <- tryCatch(
extract_partial_correlations(fit), error = function(e) NULL)
bgms_res$precision_matrix <- tryCatch(
extract_precision(fit), error = function(e) NULL)
bgms_res$log_odds <- tryCatch(
extract_log_odds(fit), error = function(e) NULL)

# --- Finalize output ---
bgms_res$model <- type
bgms_res$model <- model_label
bgms_res$fit_arguments <- args
output <- bgms_res
class(output) <- c("package_bgms", "easybgm")
Expand Down
Loading