diff --git a/.Rbuildignore b/.Rbuildignore index ccc2c34..c68bb1b 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -6,4 +6,5 @@ ^pkgdown$ ^data-raw ^\.lintr$ -^\\vignettes\\ExportedItems.bib$ \ No newline at end of file +^\\vignettes\\ExportedItems.bib$ +^rebuild_vignettes.R$ diff --git a/DESCRIPTION b/DESCRIPTION index 58e424c..e72e038 100644 --- a/DESCRIPTION +++ b/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", diff --git a/NAMESPACE b/NAMESPACE index 88bf8eb..c3e54db 100644 --- a/NAMESPACE +++ b/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) diff --git a/NEWS.md b/NEWS.md index 6b27bd6..6eeb0b1 100644 --- a/NEWS.md +++ b/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 diff --git a/R/model_set_combined.R b/R/model_set_combined.R new file mode 100644 index 0000000..07d3f28 --- /dev/null +++ b/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 +} \ No newline at end of file diff --git a/README.md b/README.md index 1d22d3d..ea26617 100644 --- a/README.md +++ b/README.md @@ -10,7 +10,7 @@ # modelbpp: Model BIC Posterior Probability -(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 diff --git a/_pkgdown.yml b/_pkgdown.yml index ea2d2c4..0571154 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -47,6 +47,7 @@ reference: - same_variables - to_partables - measurement_invariance_models + - model_set_combined - title: Methods - contents: - print.partables diff --git a/inst/tinytest/test_cmf.R b/inst/tinytest/test_cmf.R new file mode 100644 index 0000000..1f081e3 --- /dev/null +++ b/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) diff --git a/inst/tinytest/test_cmf_error.R b/inst/tinytest/test_cmf_error.R new file mode 100644 index 0000000..0f907e9 --- /dev/null +++ b/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) + ) diff --git a/man/model_set_combined.Rd b/man/model_set_combined.Rd new file mode 100644 index 0000000..a431ca8 --- /dev/null +++ b/man/model_set_combined.Rd @@ -0,0 +1,82 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/model_set_combined.R +\name{model_set_combined} +\alias{model_set_combined} +\title{Two or More Hypothesized Model} +\usage{ +model_set_combined(model_set_outputs, ...) +} +\arguments{ +\item{model_set_outputs}{This must be +a named list of the outputs of +\code{\link[=model_set]{model_set()}}. The names will be used +as prefixes to name the models.} + +\item{...}{Additional arguments to be +passed to \code{\link[=model_set]{model_set()}}.} +} +\value{ +A \code{model_set}-class object, which is +simply an output of \code{\link[=model_set]{model_set()}}. +All methods and functions for the +output of \code{\link[=model_set]{model_set()}} will also +work on this object. +} +\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 \code{\link[=model_set_combined]{model_set_combined()}} +let users combine the \code{\link[=model_set]{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. +} +\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 + +} +\seealso{ +\code{\link[=model_set]{model_set()}} +}