0.1.5.3: Add model_set_combined

.Rbuildignore

@@ -6,4 +6,5 @@
 ^pkgdown$
 ^data-raw
 ^\.lintr$
-^\\vignettes\\ExportedItems.bib$
+^\\vignettes\\ExportedItems.bib$
+^rebuild_vignettes.R$

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: modelbpp
 Title: Model BIC Posterior Probability
-Version: 0.1.5.2
+Version: 0.1.5.3
 Authors@R:
     c(person(given = "Shu Fai",
              family = "Cheung",

NAMESPACE

@@ -17,6 +17,7 @@ export(measurement_invariance_models)
 export(min_prior)
 export(model_graph)
 export(model_set)
+export(model_set_combined)
 export(partables_drop)
 export(same_variables)
 export(to_partables)

NEWS.md

@@ -1,4 +1,11 @@
-# modelbpp 0.1.5.2
+# modelbpp 0.1.5.3
+
+## New Features
+
+- Added `model_set_combined()` for
+  computing BPPs for models from two or
+  more calls to `model_set()`.
+  (0.1.5.3)
 
 ## Miscellaneous
 

R/model_set_combined.R

@@ -0,0 +1,124 @@
+#' @title Two or More Hypothesized Model
+#'
+#' @description Combine the 'model_set()'
+#' results of two or more hypothesis
+#' models.
+#'
+#' @details
+#' There are cases in which users
+#' have more than one hypothesized model,
+#' each with its own set of neighboring
+#' models.
+#'
+#' The function [model_set_combined()]
+#' let users combine the [model_set()]
+#' results two or more hypothesized model.
+#' Users can then compare the BPPs
+#' of these hypothesized models, as well
+#' as their neighboring models. Equivalent
+#' models will be removed in the process.
+#'
+#' @return
+#' A `model_set`-class object, which is
+#' simply an output of [model_set()].
+#' All methods and functions for the
+#' output of [model_set()] will also
+#' work on this object.
+#'
+#' @param model_set_outputs This must be
+#' a named list of the outputs of
+#' [model_set()]. The names will be used
+#' as prefixes to name the models.
+#'
+#' @param ... Additional arguments to be
+#' passed to [model_set()].
+#'
+#' @seealso [model_set()]
+#'
+#' @examples
+#'
+#' library(lavaan)
+#'
+#' mod1 <-
+#' "
+#' x4 ~ x1
+#' x7 ~ x4
+#' "
+#'
+#' mod2 <-
+#' "
+#' x1 ~ x4
+#' x7 ~ x4
+#' "
+#'
+#' fit1 <- sem(mod1,
+#'             HolzingerSwineford1939,
+#'             fixed.x = FALSE)
+#' fit2 <- sem(mod2,
+#'             HolzingerSwineford1939,
+#'             fixed.x = FALSE)
+#'
+#' out1 <- model_set(fit1)
+#' out2 <- model_set(fit2)
+#'
+#' out1
+#' out2
+#'
+#' outb <- model_set_combined(
+#'             list(fit1 = out1,
+#'                  fit2 = out2))
+#'
+#' outb
+#'
+#' @export
+model_set_combined <- function(model_set_outputs,
+                               ...) {
+
+  # ---- Sanity Checks ----
+  chk_class <- sapply(
+                  model_set_outputs,
+                  inherits,
+                  what = "model_set")
+  if (!all(chk_class)) {
+    i <- names(chk_class)[!chk_class]
+    tmp <- paste0(i,
+                  collapse = ", ")
+    stop("Some outputs are not from 'model_set()': ",
+         tmp)
+  }
+
+  fit_names <- names(model_set_outputs)
+
+  if (isTRUE(is.null(fit_names))) {
+    stop("model_set_outputs must be a named list")
+  }
+
+  if (!isTRUE(all(sapply(fit_names, nchar) > 0))) {
+    stop("Some elements have no valid names.")
+  }
+
+  # ---- Combine the Models ----
+
+  f <- function(out, fit_name) {
+          fits <- out$fit
+          names(fits) <- paste0(fit_name, "_", names(fits))
+          fits
+        }
+  all_fits <- mapply(
+                f,
+                out = model_set_outputs,
+                fit_name = fit_names,
+                SIMPLIFY = FALSE,
+                USE.NAMES = TRUE
+              )
+
+  all_fits <- unlist(
+                unname(all_fits),
+                recursive = FALSE)
+
+  # ---- Do the Analysis ----
+
+  out <- model_set(all_fits,
+                   ...)
+  out
+}

README.md

@@ -10,7 +10,7 @@
 
 # modelbpp: Model BIC Posterior Probability <img src="man/figures/logo.png" align="right" />
 
-(Version 0.1.5.2 updated on 2025-08-20, [release history](https://sfcheung.github.io/modelbpp/news/index.html))
+(Version 0.1.5.3 updated on 2025-09-04, [release history](https://sfcheung.github.io/modelbpp/news/index.html))
 
 This package is for assessing model uncertainty in structural
 equation modeling (SEM) by the BIC posterior

_pkgdown.yml

@@ -47,6 +47,7 @@ reference:
   - same_variables
   - to_partables
   - measurement_invariance_models
+  - model_set_combined
 - title: Methods
 - contents:
   - print.partables

inst/tinytest/test_cmf.R

@@ -0,0 +1,54 @@
+suppressMessages(library(lavaan))
+
+mod1 <-
+"
+x2 ~ x1 + x4
+x3 ~ x2
+"
+
+mod2 <-
+"
+x3 ~ x1
+x3 ~ x2
+x4 ~ x3
+"
+
+fit1 <- sem(mod1, HolzingerSwineford1939, fixed.x = FALSE)
+fit2 <- sem(mod2, HolzingerSwineford1939, fixed.x = FALSE)
+
+out1 <- model_set(fit1,
+                  progress = FALSE,
+                  parallel = FALSE)
+out2 <- model_set(fit2,
+                  progress = FALSE,
+                  parallel = FALSE)
+
+# Need to rename the fits due to name conflicts.
+out1b <- out1
+out2b <- out2
+names(out1b$fit) <- paste0("fit1_", names(out1b$fit))
+names(out2b$fit) <- paste0("fit2_", names(out2b$fit))
+
+fit_all <- c(out1b$fit,
+             out2b$fit)
+names(fit_all)
+
+outa <- model_set(fit_all,
+                  progress = FALSE,
+                  parallel = FALSE)
+
+outa
+
+outb <- model_set_combined(
+            list(fit1 = out1,
+                 fit2 = out2),
+            progress = FALSE,
+            parallel = FALSE)
+
+outb
+
+names(outa)
+names(outb)
+
+expect_equal(outa$bpp,
+             outb$bpp)

inst/tinytest/test_cmf_error.R

@@ -0,0 +1,40 @@
+suppressMessages(library(lavaan))
+
+mod1 <-
+"
+x2 ~ x1 + x4
+x3 ~ x2
+"
+
+mod2 <-
+"
+x3 ~ x1
+x3 ~ x2
+x4 ~ x3
+"
+
+fit1 <- sem(mod1, HolzingerSwineford1939, fixed.x = FALSE)
+fit2 <- sem(mod2, HolzingerSwineford1939, fixed.x = FALSE)
+
+out1 <- model_set(fit1,
+                  progress = FALSE,
+                  parallel = FALSE)
+out2 <- model_set(fit2,
+                  progress = FALSE,
+                  parallel = FALSE)
+
+expect_error(
+    model_set_combined(
+            list(out1,
+                 out2),
+            progress = FALSE,
+            parallel = FALSE)
+  )
+
+expect_error(
+    model_set_combined(
+            list(a = out1,
+                 out2),
+            progress = FALSE,
+            parallel = FALSE)
+  )