From d919dfce0961cad7bd3caa98b242cff696c44a6b Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Thu, 4 Sep 2025 18:19:46 +0800 Subject: [PATCH 1/3] WIP --- inst/tinytest/test_cmf.R | 152 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 152 insertions(+) create mode 100644 inst/tinytest/test_cmf.R diff --git a/inst/tinytest/test_cmf.R b/inst/tinytest/test_cmf.R new file mode 100644 index 0000000..99d528f --- /dev/null +++ b/inst/tinytest/test_cmf.R @@ -0,0 +1,152 @@ +if (interactive() && + length(unclass(packageVersion("modelbpp"))[[1]]) == 4) { + +suppressMessages(library(lavaan)) + +#' @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 for to name the models. +#' +#' @param ... Additional arguments to be +#' passed to [model_set()]. +#' +#' @seealso [model_set()] +#' +#' @examples +#' \donttest{ +#' } +#' +#' @export +#' +#' @describeIn topic Description of this function +#' @order 1 +model_set_combined <- function(model_set_outputs, + ...) { + args <- list(...) + + # ---- 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) + + 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) + + out <- model_set(all_fits, + ...) + out +} + +mod1 <- +" +x2 ~ x1 + x4 +x3 ~ x2 +" + +mod2 <- +" +x3 ~ x1 +x3 ~ x2 +x4 ~ x3 +" + +mod3 <- +" +x2 ~ x1 +x2 ~ x3 +x1 ~ x4 +x3 ~ x4 +" + +fit1 <- sem(mod1, HolzingerSwineford1939, fixed.x = FALSE) +fit2 <- sem(mod2, HolzingerSwineford1939, fixed.x = FALSE) +fit3 <- sem(mod3, HolzingerSwineford1939, fixed.x = FALSE) + +out1 <- model_set(fit1, progress = FALSE) +out2 <- model_set(fit2, progress = FALSE) +out3 <- model_set(fit3, progress = FALSE) + +# Need to rename the fits due to name conflicts. +out1b <- out1 +out2b <- out2 +out3b <- out3 +names(out1b$fit) <- paste0("fit1_", names(out1b$fit)) +names(out2b$fit) <- paste0("fit2_", names(out2b$fit)) +names(out3b$fit) <- paste0("fit3_", names(out3b$fit)) + +fit_all <- c(out1b$fit, + out2b$fit, + out3b$fit) +names(fit_all) + +outa <- model_set(fit_all, progress = FALSE) + +outa + +outb <- model_set_combined( + list(fit1 = out1, + fit2 = out2, + fit3 = out3), + progress = FALSE) + +outb + +names(outa) +names(outb) + +expect_equal(outa$bpp, + outb$bpp) + +} \ No newline at end of file From 9d30a6d9314e19739f2cd2dac8605844cf406150 Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Thu, 4 Sep 2025 18:52:57 +0800 Subject: [PATCH 2/3] Update .Rbuildignore --- .Rbuildignore | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) 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$ From 32df21f6a8c277c32a7c85d0d0316065559aa740 Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Thu, 4 Sep 2025 19:07:27 +0800 Subject: [PATCH 3/3] 0.1.5.3: Add model_set_combined Tests, checks, and build_site() passed. --- DESCRIPTION | 2 +- NAMESPACE | 1 + NEWS.md | 9 ++- R/model_set_combined.R | 124 +++++++++++++++++++++++++++++++++ README.md | 2 +- _pkgdown.yml | 1 + inst/tinytest/test_cmf.R | 124 ++++----------------------------- inst/tinytest/test_cmf_error.R | 40 +++++++++++ man/model_set_combined.Rd | 82 ++++++++++++++++++++++ 9 files changed, 271 insertions(+), 114 deletions(-) create mode 100644 R/model_set_combined.R create mode 100644 inst/tinytest/test_cmf_error.R create mode 100644 man/model_set_combined.Rd 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 index 99d528f..1f081e3 100644 --- a/inst/tinytest/test_cmf.R +++ b/inst/tinytest/test_cmf.R @@ -1,94 +1,5 @@ -if (interactive() && - length(unclass(packageVersion("modelbpp"))[[1]]) == 4) { - suppressMessages(library(lavaan)) -#' @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 for to name the models. -#' -#' @param ... Additional arguments to be -#' passed to [model_set()]. -#' -#' @seealso [model_set()] -#' -#' @examples -#' \donttest{ -#' } -#' -#' @export -#' -#' @describeIn topic Description of this function -#' @order 1 -model_set_combined <- function(model_set_outputs, - ...) { - args <- list(...) - - # ---- 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) - - 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) - - out <- model_set(all_fits, - ...) - out -} - mod1 <- " x2 ~ x1 + x4 @@ -102,44 +13,37 @@ x3 ~ x2 x4 ~ x3 " -mod3 <- -" -x2 ~ x1 -x2 ~ x3 -x1 ~ x4 -x3 ~ x4 -" - fit1 <- sem(mod1, HolzingerSwineford1939, fixed.x = FALSE) fit2 <- sem(mod2, HolzingerSwineford1939, fixed.x = FALSE) -fit3 <- sem(mod3, HolzingerSwineford1939, fixed.x = FALSE) -out1 <- model_set(fit1, progress = FALSE) -out2 <- model_set(fit2, progress = FALSE) -out3 <- model_set(fit3, progress = 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 -out3b <- out3 names(out1b$fit) <- paste0("fit1_", names(out1b$fit)) names(out2b$fit) <- paste0("fit2_", names(out2b$fit)) -names(out3b$fit) <- paste0("fit3_", names(out3b$fit)) fit_all <- c(out1b$fit, - out2b$fit, - out3b$fit) + out2b$fit) names(fit_all) -outa <- model_set(fit_all, progress = FALSE) +outa <- model_set(fit_all, + progress = FALSE, + parallel = FALSE) outa outb <- model_set_combined( list(fit1 = out1, - fit2 = out2, - fit3 = out3), - progress = FALSE) + fit2 = out2), + progress = FALSE, + parallel = FALSE) outb @@ -148,5 +52,3 @@ names(outb) expect_equal(outa$bpp, outb$bpp) - -} \ No newline at end of file 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()}} +}