From 6815d8485ec3365a8ea354548af88785e738d78a Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Sat, 24 Feb 2024 01:02:40 +0800 Subject: [PATCH 01/70] WIP. Not ready --- R/boot2est_lavaan.R | 17 +++- R/lav_data_used.R | 41 +++++--- tests/testthat/test_mg_boot.R | 177 ++++++++++++++++++++++++++++++++++ 3 files changed, 218 insertions(+), 17 deletions(-) create mode 100644 tests/testthat/test_mg_boot.R diff --git a/R/boot2est_lavaan.R b/R/boot2est_lavaan.R index ce986da3..9803ee2b 100644 --- a/R/boot2est_lavaan.R +++ b/R/boot2est_lavaan.R @@ -181,8 +181,14 @@ fit2boot_out_do_boot <- function(fit, environment(gen_boot_i_lavaan) <- parent.frame() boot_i <- gen_boot_i_lavaan(fit) } - dat_org <- lav_data_used(fit) - n <- nrow(dat_org) + dat_org <- lav_data_used(fit, + drop_list_single_group = TRUE) + ngp <- lavaan::lavTech(fit, "ngroups") + if (ngp == 1) { + n <- nrow(dat_org) + } else { + n <- sapply(dat_org, nrow) + } boot_test <- suppressWarnings(boot_i(dat_org)) if (!isTRUE(all.equal(unclass(lavaan::coef(fit)), lavaan::coef(boot_test)[names(lavaan::coef(fit))], @@ -194,7 +200,12 @@ fit2boot_out_do_boot <- function(fit, ft <- lavaan::lavInspect(boot_test, "timing")$total requireNamespace("parallel", quietly = TRUE) if (!is.null(seed)) set.seed(seed) - ids <- replicate(R, sample.int(n, replace = TRUE), simplify = FALSE) + if (ngp == 1) { + ids <- replicate(R, sample.int(n, replace = TRUE), simplify = FALSE) + } else { + ids <- replicate(R, sapply(n, sample.int, replace = TRUE, simplify = TRUE), + simplify = FALSE) + } if (parallel) { if (is.numeric(ncores)) { ncores0 <- parallel::detectCores() diff --git a/R/lav_data_used.R b/R/lav_data_used.R index d9ce127e..6d7e833c 100644 --- a/R/lav_data_used.R +++ b/R/lav_data_used.R @@ -23,7 +23,8 @@ #' lav_data_used <- function(fit, - drop_colon = TRUE) { + drop_colon = TRUE, + drop_list_single_group = TRUE) { type <- NA if (inherits(fit, "lavaan")) { type <- "lavaan" @@ -36,7 +37,8 @@ lav_data_used <- function(fit, } out <- switch(type, lavaan = lav_data_used_lavaan(fit = fit, - drop_colon = drop_colon), + drop_colon = drop_colon, + drop_list_single_group = drop_list_single_group), lavaan.mi = lav_data_used_lavaan_mi(fit = fit, drop_colon = drop_colon)) out @@ -45,21 +47,32 @@ lav_data_used <- function(fit, #' @noRd lav_data_used_lavaan <- function(fit, - drop_colon = TRUE) { - dat <- lavaan::lavInspect(fit, "data") - i_excluded <- lavaan::lavInspect(fit, "empty.idx") - vnames <- colnames(dat) + drop_colon = TRUE, + drop_list_single_group = TRUE) { + dat <- lavaan::lavInspect(fit, "data", + drop.list.single.group = FALSE) + i_excluded <- lavaan::lavInspect(fit, "empty.idx", + drop.list.single.group = FALSE) + ngp <- lavaan::lavTech(fit, "ngroups") if (drop_colon) { - vraw <- vnames[!grepl(":", colnames(dat))] - vcolon <- apply(expand.grid(vraw, vraw), 1, paste0, collapse = ":") - vkeep <- vnames[!(vnames %in% vcolon)] - dat <- dat[, vkeep] + for (k in seq_len(ngp)) { + dat_i <- dat[[k]] + vnames <- colnames(dat_i) + vraw <- vnames[!grepl(":", colnames(dat_i))] + vcolon <- apply(expand.grid(vraw, vraw), 1, paste0, collapse = ":") + vkeep <- vnames[!(vnames %in% vcolon)] + dat[[k]] <- dat_i[, vkeep] + } } - if (length(i_excluded) > 0) { - return(dat[-i_excluded, ]) - } else { - return(dat) + for (k in seq_len(ngp)) { + if (length(i_excluded[[k]]) > 0) { + dat[[k]] <- dat[[k]][-i_excluded, ] + } + } + if (drop_list_single_group && ngp == 1) { + dat <- dat[[1]] } + return(dat) } #' @noRd diff --git a/tests/testthat/test_mg_boot.R b/tests/testthat/test_mg_boot.R new file mode 100644 index 00000000..28977c11 --- /dev/null +++ b/tests/testthat/test_mg_boot.R @@ -0,0 +1,177 @@ +skip("WIP") + +library(testthat) +library(manymome) +suppressMessages(library(lavaan)) + +dat <- modmed_x1m3w4y1 +n <- nrow(dat) +set.seed(860314) +dat$gp <- sample(c("gp1", "gp2", "gp3"), n, replace = TRUE) +dat$city <- sample(c("alpha", "beta", "gamma", "sigma"), n, replace = TRUE) + +dat <- cbind(dat, factor2var(dat$gp, prefix = "gp", add_rownames = FALSE)) +dat <- cbind(dat, factor2var(dat$city, prefix = "city", add_rownames = FALSE)) + +mod <- +" +m3 ~ m1 + x +y ~ m2 + m3 + x + w4 + x:w4 +" +fit <- sem(mod, dat, meanstructure = TRUE, fixed.x = FALSE, + group = "gp") +set.seed(4456) +fit_boot <- sem(mod, dat, meanstructure = TRUE, fixed.x = FALSE, se = "boot", bootstrap = 5, + warn = FALSE, + group = "gp") + +# TO PROCESS + +boot_out <- do_boot(fit, + R = 5, + seed = 4456, + parallel = FALSE, + progress = FALSE) + +out_mm_1 <- mod_levels_list("w4", c("gpgp2", "gpgp3"), fit = fit, merge = TRUE) + +# Suppress warnings due to small number of bootstrap samples. +suppressWarnings(out_1 <- cond_indirect_effects(wlevels = out_mm_1, x = "x", y = "y", m = "m3", fit = fit)) +suppressWarnings(out_2 <- cond_indirect_effects(wlevels = out_mm_1, x = "x", y = "y", m = "m3", fit = fit, + standardized_x = TRUE)) +suppressWarnings(out_3 <- cond_indirect_effects(wlevels = out_mm_1, x = "x", y = "y", m = "m3", fit = fit, + standardized_y = TRUE)) +suppressWarnings(out_4 <- cond_indirect_effects(wlevels = out_mm_1, x = "x", y = "y", m = "m3", fit = fit, + standardized_x = TRUE, standardized_y = TRUE)) + +suppressWarnings(out_5 <- cond_indirect_effects(wlevels = out_mm_1, x = "x", y = "y", m = "m3", fit = fit_boot, + boot_ci = TRUE)) +suppressWarnings(out_6 <- cond_indirect_effects(wlevels = out_mm_1, x = "x", y = "y", m = "m3", fit = fit_boot, + standardized_x = TRUE, + boot_ci = TRUE)) +suppressWarnings(out_7 <- cond_indirect_effects(wlevels = out_mm_1, x = "x", y = "y", m = "m3", fit = fit_boot, + standardized_y = TRUE, + boot_ci = TRUE)) +suppressWarnings(out_8 <- cond_indirect_effects(wlevels = out_mm_1, x = "x", y = "y", m = "m3", fit = fit_boot, + standardized_x = TRUE, standardized_y = TRUE, + boot_ci = TRUE, output_type = "list")) + +# Moderation only + +outmo_mm_1 <- mod_levels(c("gpgp2", "gpgp3"), fit = fit) + +# Suppress warnings due to small number of bootstrap samples. +suppressWarnings(outmo_1 <- cond_indirect_effects(wlevels = outmo_mm_1, x = "x", y = "m3", fit = fit)) +suppressWarnings(outmo_2 <- cond_indirect_effects(wlevels = outmo_mm_1, x = "x", y = "m3", fit = fit, + standardized_x = TRUE)) +suppressWarnings(outmo_3 <- cond_indirect_effects(wlevels = outmo_mm_1, x = "x", y = "m3", fit = fit, + standardized_y = TRUE)) +suppressWarnings(outmo_4 <- cond_indirect_effects(wlevels = outmo_mm_1, x = "x", y = "m3", fit = fit, + standardized_x = TRUE, standardized_y = TRUE)) + +suppressWarnings(outmo_5 <- cond_indirect_effects(wlevels = outmo_mm_1, x = "x", y = "m3", fit = fit_boot, + boot_ci = TRUE, seed = 87415)) +fit_boot_out <- fit2boot_out(fit_boot) +suppressWarnings(outmo_6 <- cond_indirect_effects(wlevels = outmo_mm_1, x = "x", y = "m3", fit = fit, + standardized_x = TRUE, + boot_ci = TRUE, boot_out = fit_boot_out)) +suppressWarnings(outmo_7 <- cond_indirect_effects(wlevels = outmo_mm_1, x = "x", y = "m3", fit = fit, + standardized_y = TRUE, + boot_ci = TRUE, boot_out = fit_boot_out)) +suppressWarnings(outmo_8 <- cond_indirect_effects(wlevels = outmo_mm_1, x = "x", y = "m3", fit = fit, + standardized_x = TRUE, standardized_y = TRUE, + boot_ci = TRUE, boot_out = fit_boot_out)) + +# Monte Carlo + +## Mediation + +fit_ml <- sem(mod, dat, meanstructure = TRUE, fixed.x = FALSE, se = "standard", warn = FALSE) +fit_mc_out <- do_mc(fit_ml, R = 100, seed = 5155) + +# Suppress warnings due to small number of bootstrap samples. +suppressWarnings(out_5_mc <- cond_indirect_effects(wlevels = out_mm_1, x = "x", y = "y", m = "m3", fit = fit_ml, + mc_ci = TRUE, mc_out = fit_mc_out)) +suppressWarnings(out_6_mc <- cond_indirect_effects(wlevels = out_mm_1, x = "x", y = "y", m = "m3", fit = fit_ml, + standardized_x = TRUE, + mc_ci = TRUE, mc_out = fit_mc_out)) +suppressWarnings(out_7_mc <- cond_indirect_effects(wlevels = out_mm_1, x = "x", y = "y", m = "m3", fit = fit_ml, + standardized_y = TRUE, + mc_ci = TRUE, mc_out = fit_mc_out)) +suppressWarnings(out_8_mc <- cond_indirect_effects(wlevels = out_mm_1, x = "x", y = "y", m = "m3", fit = fit_ml, + standardized_x = TRUE, standardized_y = TRUE, + mc_ci = TRUE, mc_out = fit_mc_out, output_type = "list")) + +## Moderation only + +outmo_mm_1 <- mod_levels(c("gpgp2", "gpgp3"), fit = fit) + +# Suppress warnings due to small number of bootstrap samples. + +suppressWarnings(outmo_5_mc <- cond_indirect_effects(wlevels = outmo_mm_1, x = "x", y = "m3", fit = fit_ml, + mc_ci = TRUE, mc_out = fit_mc_out)) +suppressWarnings(outmo_6_mc <- cond_indirect_effects(wlevels = outmo_mm_1, x = "x", y = "m3", fit = fit_ml, + standardized_x = TRUE, + mc_ci = TRUE, mc_out = fit_mc_out)) +suppressWarnings(outmo_7_mc <- cond_indirect_effects(wlevels = outmo_mm_1, x = "x", y = "m3", fit = fit_ml, + standardized_y = TRUE, + mc_ci = TRUE, mc_out = fit_mc_out)) +suppressWarnings(outmo_8_mc <- cond_indirect_effects(wlevels = outmo_mm_1, x = "x", y = "m3", fit = fit_ml, + standardized_x = TRUE, standardized_y = TRUE, + mc_ci = TRUE, mc_out = fit_mc_out)) + + +# ci_type + +## Mediation + +fit_ml <- sem(mod, dat, meanstructure = TRUE, fixed.x = FALSE, se = "standard", warn = FALSE) +fit_mc_out <- do_mc(fit_ml, R = 100, seed = 5155) + +# Suppress warnings due to small number of bootstrap samples. +suppressWarnings(out_5_mc2 <- cond_indirect_effects(wlevels = out_mm_1, x = "x", y = "y", m = "m3", fit = fit_ml, + ci_type = "mc", mc_out = fit_mc_out)) +suppressWarnings(out_6_boot2 <- cond_indirect_effects(wlevels = out_mm_1, x = "x", y = "y", m = "m3", fit = fit_boot, + standardized_x = TRUE, + ci_type = "boot")) +suppressWarnings(out_7_mc2 <- cond_indirect_effects(wlevels = out_mm_1, x = "x", y = "y", m = "m3", fit = fit_ml, + standardized_y = TRUE, + ci_type = "mc", ci_out = fit_mc_out)) +suppressWarnings(out_8_boot2 <- cond_indirect_effects(wlevels = out_mm_1, x = "x", y = "y", m = "m3", fit = fit_boot, + standardized_x = TRUE, standardized_y = TRUE, + ci_type = "boot")) + +test_that("cond_indirect_effects: ci_type", { + expect_equal(out_5_mc$mc_ci, out_5_mc2$mc_ci) + expect_equal(out_6$boot_ci, out_6_boot2$boot_ci) + expect_equal(out_7_mc$mc_ci, out_7_mc2$mc_ci) + expect_equal(out_8$boot_ci, out_8_boot2$boot_ci) + }) + +## Moderation only + +outmo_mm_1 <- mod_levels(c("gpgp2", "gpgp3"), fit = fit) + +# Suppress warnings due to small number of bootstrap samples. + +suppressWarnings(outmo_5_boot2 <- cond_indirect_effects(wlevels = outmo_mm_1, x = "x", y = "m3", fit = fit_boot, + ci_type = "boot")) +suppressWarnings(outmo_6_mc2 <- cond_indirect_effects(wlevels = outmo_mm_1, x = "x", y = "m3", fit = fit_ml, + standardized_x = TRUE, + ci_type = "mc", ci_out = fit_mc_out)) +suppressWarnings(outmo_7_boot2 <- cond_indirect_effects(wlevels = outmo_mm_1, x = "x", y = "m3", fit = fit_boot, + standardized_y = TRUE, + ci_type = "boot")) +suppressWarnings(outmo_8_mc2 <- cond_indirect_effects(wlevels = outmo_mm_1, x = "x", y = "m3", fit = fit_ml, + standardized_x = TRUE, standardized_y = TRUE, + ci_type = "mc", mc_out = fit_mc_out)) + +test_that("cond_indirect_effects: moderation, ci_type", { + expect_equal(outmo_5$boot_ci, outmo_5_boot2$boot_ci) + expect_equal(outmo_6_mc$mc_ci, outmo_6_mc2$mc_ci) + expect_equal(outmo_7$boot_ci, outmo_7_boot2$boot_ci) + expect_equal(outmo_8_mc$mc_ci, outmo_8_mc2$mc_ci) + }) + + + From f62bbd9d15ef3cc874cda0cd3284018b32c2497a Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Fri, 29 Mar 2024 09:29:16 +0800 Subject: [PATCH 02/70] Update lav_data_used for ngroups > 1 Tests passed. --- R/lav_data_used.R | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/R/lav_data_used.R b/R/lav_data_used.R index 6d7e833c..537e9a8d 100644 --- a/R/lav_data_used.R +++ b/R/lav_data_used.R @@ -25,6 +25,8 @@ lav_data_used <- function(fit, drop_colon = TRUE, drop_list_single_group = TRUE) { + # Return a named list of N matrices if ngroups > 1 + # TODOs: lav_data_used_lavaan_mi() type <- NA if (inherits(fit, "lavaan")) { type <- "lavaan" @@ -49,6 +51,7 @@ lav_data_used <- function(fit, lav_data_used_lavaan <- function(fit, drop_colon = TRUE, drop_list_single_group = TRUE) { + # Return a named list of N matrices if ngroups > 1 dat <- lavaan::lavInspect(fit, "data", drop.list.single.group = FALSE) i_excluded <- lavaan::lavInspect(fit, "empty.idx", @@ -66,10 +69,10 @@ lav_data_used_lavaan <- function(fit, } for (k in seq_len(ngp)) { if (length(i_excluded[[k]]) > 0) { - dat[[k]] <- dat[[k]][-i_excluded, ] + dat[[k]] <- dat[[k]][-i_excluded[[k]], ] } } - if (drop_list_single_group && ngp == 1) { + if (drop_list_single_group && (ngp == 1)) { dat <- dat[[1]] } return(dat) @@ -79,7 +82,7 @@ lav_data_used_lavaan <- function(fit, lav_data_used_lavaan_mi <- function(fit, drop_colon = TRUE) { - + # TODOs: Return a named list of N matrices if ngroups > 1 dat_list <- fit@DataList ovnames <- lavaan::lavNames(fit, "ov") fit_org <- lavaan_from_lavaam_mi(fit, data = FALSE) From c2904ab873ba5232c76e3ddf25b926d52032db13 Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Fri, 29 Mar 2024 09:49:43 +0800 Subject: [PATCH 03/70] Update gen_boot_i_lavaan() for ngroups > 1 Tests passed --- R/boot2est_lavaan.R | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/R/boot2est_lavaan.R b/R/boot2est_lavaan.R index 9803ee2b..da4cdbd0 100644 --- a/R/boot2est_lavaan.R +++ b/R/boot2est_lavaan.R @@ -591,10 +591,16 @@ gen_boot_i_lavaan <- function(fit) { slotOptions = fit_opts, slotParTable = fit_pt)) } else { - # Support for multigroup models will be added later. - b_i <- list(i) + # 2024-03-29: Added support for multigroup models + if (!is.list(i)) { + b_i <- list(i) + } else { + b_i <- i + } X_new <- X_old - X_new[[1]] <- X_new[[1]][i, , drop = FALSE] + for (j in seq_along(X_new)) { + X_new[[j]] <- X_new[[j]][b_i[[j]], , drop = FALSE] + } fit_data_new <- lavaan::lav_data_update( lavdata = fit_data, newX = X_new, @@ -642,6 +648,8 @@ gen_boot_i_lavaan <- function(fit) { implied_stats = NA, ok = FALSE) } + # If ngroups > 1, + # cov, mean, and mean_lv are lists. implied <- list(cov = lavaan::lavInspect(out, "cov.all"), mean = lavaan::lavInspect(out, "mean.ov"), mean_lv = lavaan::lavInspect(out, "mean.lv")) From cd7cd462b9491302f2d11810f462facec618a245 Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Fri, 29 Mar 2024 10:30:13 +0800 Subject: [PATCH 04/70] Revise get_implied_i_lavaan() to support ngroups > 1 Tests passed --- R/boot2est_lavaan.R | 35 +++++++++++++++++++++++++++++++---- 1 file changed, 31 insertions(+), 4 deletions(-) diff --git a/R/boot2est_lavaan.R b/R/boot2est_lavaan.R index da4cdbd0..b41d3f16 100644 --- a/R/boot2est_lavaan.R +++ b/R/boot2est_lavaan.R @@ -456,22 +456,49 @@ get_implied_i_lavaan <- function(est0, fit, fit_tmp = NULL) { delta = TRUE) } out <- lav_implied_all(fit) + ngroups <- lavaan::lavTech(fit, "ngroups") out_names <- names(out) implied_names <- names(implied) out1 <- out + # For multigroup models, use the format of lavaan::lav_model_implied() + # - Estimates than groups. for (x in out_names) { if (x %in% implied_names) { if (!is.null(implied[[x]][[1]])) { - out1[[x]][] <- implied[[x]][[1]] + if (ngroups > 1) { + for (j in seq_len(ngroups)) { + out1[[x]][[j]][] <- implied[[x]][[j]] + } + } else { + out1[[x]][] <- implied[[x]][[1]] + } } else { - out1[[x]][] <- NA + if (ngroups > 1) { + for (j in seq_len(ngroups)) { + out1[[x]][[j]][] <- NA + } + } else { + out1[[x]][] <- NA + } } } else { - out1[[x]][] <- NA + if (ngroups > 1) { + for (j in seq_len(ngroups)) { + out1[[x]][[j]][] <- NA + } + } else { + out1[[x]][] <- NA + } } } if (has_lv) { - out1$mean_lv <- implied$mean_lv[[1]] + if (ngroups > 1) { + for (j in seq_len(ngroups)) { + out1[["mean_lv"]][[j]][] <- NA + } + } else { + out1$mean_lv <- implied$mean_lv[[1]] + } } out1 } From ac9c1af891c7308b4c14a318a4c3a6806a72efd1 Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Fri, 29 Mar 2024 10:44:42 +0800 Subject: [PATCH 05/70] Update find_product for ngroups > 1 --- R/find_product.R | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/R/find_product.R b/R/find_product.R index 5c823513..8e6d8c70 100644 --- a/R/find_product.R +++ b/R/find_product.R @@ -46,6 +46,13 @@ #'@noRd find_product <- function(data, target) { + if (is.list(data)) { + ngroups <- length(data) + # Aasume all groups have the same variables + data <- do.call(rbind, data) + } else { + ngroups <- 1 + } a_col <- data[, target] out <- c(NA, NA) q <- 0 From a1e62a22a59595391ff5c22c23d971623db11ede Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Fri, 29 Mar 2024 10:46:47 +0800 Subject: [PATCH 06/70] Update find_all_products for ngroups > 1 --- R/find_product.R | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/R/find_product.R b/R/find_product.R index 8e6d8c70..275a06a7 100644 --- a/R/find_product.R +++ b/R/find_product.R @@ -76,6 +76,12 @@ find_product <- function(data, target) { #'@noRd find_all_products <- function(data, expand = TRUE) { + if (is.list(data)) { + ngroups <- length(data) + data <- do.call(rbind, data) + } else { + ngroups <- 1 + } out <- sapply(colnames(data), find_product, data = data, USE.NAMES = TRUE, From e5b0331d3402599375fdc994ccdb23c23dece3af Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Fri, 29 Mar 2024 11:05:31 +0800 Subject: [PATCH 07/70] Revise get_b for ngroups > 1 --- R/get_b.R | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/R/get_b.R b/R/get_b.R index e3b0620b..932dc0fd 100644 --- a/R/get_b.R +++ b/R/get_b.R @@ -38,7 +38,16 @@ get_b <- function(x, (est$op == "~") & (est$rhs == x) if (isTRUE(any(i))) { - return(est[i, "est"]) + out <- est[i, "est"] + if (length(out) > 1) { + # Multigroup model + if (!is.null(est$group)) { + names(out) <- est$group[i] + } else { + names(out) <- seq_along(out) + } + } + return(out) } else { return(NA) } From 0d939fdb38878598ddd945324d2860190a9de00c Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Fri, 29 Mar 2024 11:19:51 +0800 Subject: [PATCH 08/70] A better check for ngroups --- R/find_product.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/find_product.R b/R/find_product.R index 275a06a7..eee59a5b 100644 --- a/R/find_product.R +++ b/R/find_product.R @@ -46,7 +46,7 @@ #'@noRd find_product <- function(data, target) { - if (is.list(data)) { + if (is.list(data) && !is.data.frame(data)) { ngroups <- length(data) # Aasume all groups have the same variables data <- do.call(rbind, data) @@ -76,7 +76,7 @@ find_product <- function(data, target) { #'@noRd find_all_products <- function(data, expand = TRUE) { - if (is.list(data)) { + if (is.list(data) && !is.data.frame(data)) { ngroups <- length(data) data <- do.call(rbind, data) } else { From f159b8ee59de4094333b9c2a5843c394513b19c3 Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Fri, 29 Mar 2024 11:24:31 +0800 Subject: [PATCH 09/70] Update test_get_prod_mi.R No need to do compare them --- tests/testthat/test_get_prod_mi.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/tests/testthat/test_get_prod_mi.R b/tests/testthat/test_get_prod_mi.R index 40140f63..3476cc61 100644 --- a/tests/testthat/test_get_prod_mi.R +++ b/tests/testthat/test_get_prod_mi.R @@ -26,7 +26,8 @@ out_mi_6 <- get_prod(x = "w2", y = "m2", fit = fit1_mi) out_mi_7 <- get_prod(x = "m2", y = "m3", fit = fit1_mi) # No need to compare b values -out_mi_3$b[] <- out_3$b +out_mi_3$b <- NULL +out_3$b <- NULL out_mi_6$b[] <- out_6$b test_that("get_prod for lavaan.mi", { From 5bf7de93aa6466b6948734bcbae3510679d07df4 Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Fri, 29 Mar 2024 11:35:51 +0800 Subject: [PATCH 10/70] Revise get_prod() to work with ngroups > 1 Tests passed --- R/get_prod.R | 21 +++++++++++++++++++-- 1 file changed, 19 insertions(+), 2 deletions(-) diff --git a/R/get_prod.R b/R/get_prod.R index d6fd9be9..c2ab3d5a 100644 --- a/R/get_prod.R +++ b/R/get_prod.R @@ -131,10 +131,19 @@ get_prod <- function(x, expand = expand) all_prods_names <- names(all_prods) } + if (!is.null(est$group) || + isTRUE(suppressWarnings(max(est$group) > 1))) { + ngroups <- max(est$group) + } else { + ngroups <- 1 + } + if (ngroups > 1) { + + } i_rhs <- (est$lhs == y) & (est$op == "~") if (isTRUE(any(i_rhs))) { - y_rhs <- est[i_rhs, "rhs"] + y_rhs <- unique(est[i_rhs, "rhs"]) } else { return(NA) } @@ -185,7 +194,15 @@ get_prod <- function(x, } b_prod <- sapply(prod_x, function(x) get_b(x = x, y = y, - est = est)) + est = est), + simplify = FALSE, + USE.NAMES = TRUE) + # Handle multigroup models + if (ngroups == 1) { + b_prod <- unlist(b_prod) + } else { + b_prod <- b_prod + } out <- list(prod = prod_x, b = b_prod, w = w, From a6d1a4d3f97695e638d81ec2f18d820979d10cca Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Fri, 29 Mar 2024 13:09:53 +0800 Subject: [PATCH 11/70] Improve handling of ngroups > 1 --- R/get_b.R | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/R/get_b.R b/R/get_b.R index 932dc0fd..234b2914 100644 --- a/R/get_b.R +++ b/R/get_b.R @@ -30,10 +30,14 @@ get_b <- function(x, y, fit, - est = NULL) { + est = NULL, + group_number = NULL) { if (is.null(est)) { est <- lav_est(fit, se = FALSE, ci = FALSE) } + if (!is.null(group_number)) { + est <- est[est$group == group_number, ] + } i <- (est$lhs == y) & (est$op == "~") & (est$rhs == x) From ae5540b5aa79adc98354bd74bf8609948ddeaa8f Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Fri, 29 Mar 2024 13:10:16 +0800 Subject: [PATCH 12/70] WIP. Not ready --- R/cond_indirect.R | 22 +++- R/indirect.R | 49 +++++-- tests/testthat/test_mg_boot.R | 240 +++++++++++++--------------------- 3 files changed, 146 insertions(+), 165 deletions(-) diff --git a/R/cond_indirect.R b/R/cond_indirect.R index 2170ee6c..9a7598cb 100644 --- a/R/cond_indirect.R +++ b/R/cond_indirect.R @@ -367,6 +367,13 @@ #' supplied, will override `boot_ci` #' and `mc_ci`. #' +#' @param group_number The group number +#' as appeared in the [summary()] +#' or [lavaan::parameterEstimates()] +#' output of an `lavaan`-class object. +#' Used only when the number of +#' groups is greater than one. Default +#' is NULL. #' #' @seealso [mod_levels()] and #' [merge_mod_levels()] for generating @@ -441,7 +448,8 @@ cond_indirect <- function(x, ci_out = NULL, save_ci_full = FALSE, save_ci_out = TRUE, - ci_type = NULL) { + ci_type = NULL, + group_number = NULL) { fit_type <- cond_indirect_check_fit(fit) chkpath <- check_path(x = x, y = y, m = m, fit = fit, est = est) if (!chkpath) { @@ -569,7 +577,8 @@ cond_indirect <- function(x, standardized_y = standardized_y, get_prods_only = TRUE, data = fit_data, - expand = TRUE) + expand = TRUE, + group_number = group_number) } if (get_prods_only) return(prods) out0 <- indirect_i(x = x, @@ -581,7 +590,8 @@ cond_indirect <- function(x, wvalues = wvalues, standardized_x = standardized_x, standardized_y = standardized_y, - prods = prods) + prods = prods, + group_number = group_number) if (mc_ci) { out_mc <- mapply(indirect_i, est = lapply(mc_out, function(x) x$est), @@ -697,7 +707,8 @@ indirect_effect <- function(x, ci_out = NULL, save_ci_full = FALSE, save_ci_out = TRUE, - ci_type = NULL) { + ci_type = NULL, + group_number = NULL) { cond_indirect(x = x, y = y, m = m, @@ -723,7 +734,8 @@ indirect_effect <- function(x, ci_out = ci_out, save_ci_full = save_ci_full, save_ci_out = save_ci_out, - ci_type = ci_type) + ci_type = ci_type, + group_number = group_number) } #' @param w_type Character. Whether the diff --git a/R/indirect.R b/R/indirect.R index 55bf60b3..967a0a27 100644 --- a/R/indirect.R +++ b/R/indirect.R @@ -124,6 +124,14 @@ #' latent variables and observed #' variables. Default is `TRUE`. #' +#' @param group_number The group number +#' as appeared in the [summary()] +#' or [lavaan::parameterEstimates()] +#' output of an `lavaan`-class object. +#' Used only when the number of +#' groups is greater than one. Default +#' is NULL. +#' #' @seealso [indirect_effect()], #' [cond_indirect_effects()], and #' [cond_indirect()], the high level @@ -183,10 +191,20 @@ indirect_i <- function(x, data = NULL, expand = TRUE, warn = TRUE, - allow_mixing_lav_and_obs = TRUE) { + allow_mixing_lav_and_obs = TRUE, + group_number = NULL) { if (is.null(est)) { est <- lav_est(fit) } + ngroups <- 1 + if (!is.null(est$group)) { + if (max(est$group) > 1) { + ngroups <- max(est$group) + } + } + if ((ngroups > 1) && !is.numeric(group_number)) { + stop("The model has more than one group but group_number not set.") + } chkpath <- check_path(x = x, y = y, m = m, fit = fit, est = est) if (!chkpath) { msg <- paste0("No path from ", sQuote(x), " to ", sQuote(y), @@ -206,7 +224,8 @@ indirect_i <- function(x, bs <- mapply(get_b, x = xs, y = ys, - MoreArgs = list(est = est)) + MoreArgs = list(est = est, + group_number = group_number)) bs_org <- bs names(bs_org) <- bs_names chk_lv <- unique(c(xs, ys)) %in% check_lv_in_est(est) @@ -471,15 +490,16 @@ gen_computation <- function(xi, yi, yiname, digits = 3, y, wvalues = NULL, out1 <- paste0(y0, " + ", paste0("(", b_i0, ")*(", w_i2, ")", collapse = " + ")) - - out2 <- paste0("(", formatC(yi, digits = digits, format = "f"), +browser() + out2 <- tryCatch(paste0("(", formatC(yi, digits = digits, format = "f"), ") + ", paste0("(", formatC(b_i, digits = digits, format = "f"), ")*(", wvalues_i0, ")", - collapse = " + ")) + collapse = " + ")), error = function(e) e) + if (inherits(out2, "error")) browser() names(out2) <- out1 out2 } @@ -499,11 +519,20 @@ update_prods <- function(prods, est) { if (all(is.na(prods_i))) { return(pout_i) } else { - est_i <- est[(est$lhs == prods_i$y) & - (est$op == "~") & - (est$rhs %in% prods_i$prod), "est"] - pout_i$b <- est_i - names(pout_i$b) <- prods_i$prod + if (is.list(pout_i$b)) { + for (pp in pout_i$prod) { + est_i <- est[(est$lhs == prods_i$y) & + (est$op == "~") & + (est$rhs %in% pp), "est"] + pout_i$b[[pp]][] <- est_i + } + } else { + est_i <- est[(est$lhs == prods_i$y) & + (est$op == "~") & + (est$rhs %in% prods_i$prod), "est"] + pout_i$b <- est_i + names(pout_i$b) <- prods_i$prod + } return(pout_i) } } diff --git a/tests/testthat/test_mg_boot.R b/tests/testthat/test_mg_boot.R index 28977c11..508a7faa 100644 --- a/tests/testthat/test_mg_boot.R +++ b/tests/testthat/test_mg_boot.R @@ -18,160 +18,100 @@ mod <- m3 ~ m1 + x y ~ m2 + m3 + x + w4 + x:w4 " + +dat$xw4 <- dat$x * dat$w4 +dat$m3w4 <- dat$m3 * dat$w4 +mod2 <- +" +m3 ~ m1 + x +y ~ m2 + m3 + x + w4 + xw4 + w3 + m3:w3 + m3w4 +" + +# Check against lavaan + fit <- sem(mod, dat, meanstructure = TRUE, fixed.x = FALSE, - group = "gp") -set.seed(4456) -fit_boot <- sem(mod, dat, meanstructure = TRUE, fixed.x = FALSE, se = "boot", bootstrap = 5, + group = "gp", + group.label = c("gp3", "gp1", "gp2")) +fit_boot <- sem(mod, dat, meanstructure = TRUE, fixed.x = FALSE, + se = "boot", bootstrap = 5, warn = FALSE, - group = "gp") - -# TO PROCESS - -boot_out <- do_boot(fit, - R = 5, - seed = 4456, - parallel = FALSE, - progress = FALSE) - -out_mm_1 <- mod_levels_list("w4", c("gpgp2", "gpgp3"), fit = fit, merge = TRUE) - -# Suppress warnings due to small number of bootstrap samples. -suppressWarnings(out_1 <- cond_indirect_effects(wlevels = out_mm_1, x = "x", y = "y", m = "m3", fit = fit)) -suppressWarnings(out_2 <- cond_indirect_effects(wlevels = out_mm_1, x = "x", y = "y", m = "m3", fit = fit, - standardized_x = TRUE)) -suppressWarnings(out_3 <- cond_indirect_effects(wlevels = out_mm_1, x = "x", y = "y", m = "m3", fit = fit, - standardized_y = TRUE)) -suppressWarnings(out_4 <- cond_indirect_effects(wlevels = out_mm_1, x = "x", y = "y", m = "m3", fit = fit, - standardized_x = TRUE, standardized_y = TRUE)) - -suppressWarnings(out_5 <- cond_indirect_effects(wlevels = out_mm_1, x = "x", y = "y", m = "m3", fit = fit_boot, - boot_ci = TRUE)) -suppressWarnings(out_6 <- cond_indirect_effects(wlevels = out_mm_1, x = "x", y = "y", m = "m3", fit = fit_boot, - standardized_x = TRUE, - boot_ci = TRUE)) -suppressWarnings(out_7 <- cond_indirect_effects(wlevels = out_mm_1, x = "x", y = "y", m = "m3", fit = fit_boot, - standardized_y = TRUE, - boot_ci = TRUE)) -suppressWarnings(out_8 <- cond_indirect_effects(wlevels = out_mm_1, x = "x", y = "y", m = "m3", fit = fit_boot, - standardized_x = TRUE, standardized_y = TRUE, - boot_ci = TRUE, output_type = "list")) - -# Moderation only - -outmo_mm_1 <- mod_levels(c("gpgp2", "gpgp3"), fit = fit) - -# Suppress warnings due to small number of bootstrap samples. -suppressWarnings(outmo_1 <- cond_indirect_effects(wlevels = outmo_mm_1, x = "x", y = "m3", fit = fit)) -suppressWarnings(outmo_2 <- cond_indirect_effects(wlevels = outmo_mm_1, x = "x", y = "m3", fit = fit, - standardized_x = TRUE)) -suppressWarnings(outmo_3 <- cond_indirect_effects(wlevels = outmo_mm_1, x = "x", y = "m3", fit = fit, - standardized_y = TRUE)) -suppressWarnings(outmo_4 <- cond_indirect_effects(wlevels = outmo_mm_1, x = "x", y = "m3", fit = fit, - standardized_x = TRUE, standardized_y = TRUE)) - -suppressWarnings(outmo_5 <- cond_indirect_effects(wlevels = outmo_mm_1, x = "x", y = "m3", fit = fit_boot, - boot_ci = TRUE, seed = 87415)) -fit_boot_out <- fit2boot_out(fit_boot) -suppressWarnings(outmo_6 <- cond_indirect_effects(wlevels = outmo_mm_1, x = "x", y = "m3", fit = fit, - standardized_x = TRUE, - boot_ci = TRUE, boot_out = fit_boot_out)) -suppressWarnings(outmo_7 <- cond_indirect_effects(wlevels = outmo_mm_1, x = "x", y = "m3", fit = fit, - standardized_y = TRUE, - boot_ci = TRUE, boot_out = fit_boot_out)) -suppressWarnings(outmo_8 <- cond_indirect_effects(wlevels = outmo_mm_1, x = "x", y = "m3", fit = fit, - standardized_x = TRUE, standardized_y = TRUE, - boot_ci = TRUE, boot_out = fit_boot_out)) - -# Monte Carlo - -## Mediation - -fit_ml <- sem(mod, dat, meanstructure = TRUE, fixed.x = FALSE, se = "standard", warn = FALSE) -fit_mc_out <- do_mc(fit_ml, R = 100, seed = 5155) - -# Suppress warnings due to small number of bootstrap samples. -suppressWarnings(out_5_mc <- cond_indirect_effects(wlevels = out_mm_1, x = "x", y = "y", m = "m3", fit = fit_ml, - mc_ci = TRUE, mc_out = fit_mc_out)) -suppressWarnings(out_6_mc <- cond_indirect_effects(wlevels = out_mm_1, x = "x", y = "y", m = "m3", fit = fit_ml, - standardized_x = TRUE, - mc_ci = TRUE, mc_out = fit_mc_out)) -suppressWarnings(out_7_mc <- cond_indirect_effects(wlevels = out_mm_1, x = "x", y = "y", m = "m3", fit = fit_ml, - standardized_y = TRUE, - mc_ci = TRUE, mc_out = fit_mc_out)) -suppressWarnings(out_8_mc <- cond_indirect_effects(wlevels = out_mm_1, x = "x", y = "y", m = "m3", fit = fit_ml, - standardized_x = TRUE, standardized_y = TRUE, - mc_ci = TRUE, mc_out = fit_mc_out, output_type = "list")) - -## Moderation only - -outmo_mm_1 <- mod_levels(c("gpgp2", "gpgp3"), fit = fit) - -# Suppress warnings due to small number of bootstrap samples. - -suppressWarnings(outmo_5_mc <- cond_indirect_effects(wlevels = outmo_mm_1, x = "x", y = "m3", fit = fit_ml, - mc_ci = TRUE, mc_out = fit_mc_out)) -suppressWarnings(outmo_6_mc <- cond_indirect_effects(wlevels = outmo_mm_1, x = "x", y = "m3", fit = fit_ml, - standardized_x = TRUE, - mc_ci = TRUE, mc_out = fit_mc_out)) -suppressWarnings(outmo_7_mc <- cond_indirect_effects(wlevels = outmo_mm_1, x = "x", y = "m3", fit = fit_ml, - standardized_y = TRUE, - mc_ci = TRUE, mc_out = fit_mc_out)) -suppressWarnings(outmo_8_mc <- cond_indirect_effects(wlevels = outmo_mm_1, x = "x", y = "m3", fit = fit_ml, - standardized_x = TRUE, standardized_y = TRUE, - mc_ci = TRUE, mc_out = fit_mc_out)) - - -# ci_type - -## Mediation - -fit_ml <- sem(mod, dat, meanstructure = TRUE, fixed.x = FALSE, se = "standard", warn = FALSE) -fit_mc_out <- do_mc(fit_ml, R = 100, seed = 5155) - -# Suppress warnings due to small number of bootstrap samples. -suppressWarnings(out_5_mc2 <- cond_indirect_effects(wlevels = out_mm_1, x = "x", y = "y", m = "m3", fit = fit_ml, - ci_type = "mc", mc_out = fit_mc_out)) -suppressWarnings(out_6_boot2 <- cond_indirect_effects(wlevels = out_mm_1, x = "x", y = "y", m = "m3", fit = fit_boot, - standardized_x = TRUE, - ci_type = "boot")) -suppressWarnings(out_7_mc2 <- cond_indirect_effects(wlevels = out_mm_1, x = "x", y = "y", m = "m3", fit = fit_ml, - standardized_y = TRUE, - ci_type = "mc", ci_out = fit_mc_out)) -suppressWarnings(out_8_boot2 <- cond_indirect_effects(wlevels = out_mm_1, x = "x", y = "y", m = "m3", fit = fit_boot, - standardized_x = TRUE, standardized_y = TRUE, - ci_type = "boot")) - -test_that("cond_indirect_effects: ci_type", { - expect_equal(out_5_mc$mc_ci, out_5_mc2$mc_ci) - expect_equal(out_6$boot_ci, out_6_boot2$boot_ci) - expect_equal(out_7_mc$mc_ci, out_7_mc2$mc_ci) - expect_equal(out_8$boot_ci, out_8_boot2$boot_ci) + group = "gp", + group.label = c("gp3", "gp1", "gp2"), + iseed = 2345) +do_boot_out <- fit2boot_out_do_boot(fit, R = 5, + seed = 2345, + progress = FALSE, + parallel = FALSE) +lav_boot <- lavInspect(fit_boot, "boot") + +test_that("Check against lavaan boot", { + expect_equal(do_boot_out[[3]]$est$est[1:4], + unname(lav_boot[3, 1:4])) }) -## Moderation only - -outmo_mm_1 <- mod_levels(c("gpgp2", "gpgp3"), fit = fit) - -# Suppress warnings due to small number of bootstrap samples. - -suppressWarnings(outmo_5_boot2 <- cond_indirect_effects(wlevels = outmo_mm_1, x = "x", y = "m3", fit = fit_boot, - ci_type = "boot")) -suppressWarnings(outmo_6_mc2 <- cond_indirect_effects(wlevels = outmo_mm_1, x = "x", y = "m3", fit = fit_ml, - standardized_x = TRUE, - ci_type = "mc", ci_out = fit_mc_out)) -suppressWarnings(outmo_7_boot2 <- cond_indirect_effects(wlevels = outmo_mm_1, x = "x", y = "m3", fit = fit_boot, - standardized_y = TRUE, - ci_type = "boot")) -suppressWarnings(outmo_8_mc2 <- cond_indirect_effects(wlevels = outmo_mm_1, x = "x", y = "m3", fit = fit_ml, - standardized_x = TRUE, standardized_y = TRUE, - ci_type = "mc", mc_out = fit_mc_out)) - -test_that("cond_indirect_effects: moderation, ci_type", { - expect_equal(outmo_5$boot_ci, outmo_5_boot2$boot_ci) - expect_equal(outmo_6_mc$mc_ci, outmo_6_mc2$mc_ci) - expect_equal(outmo_7$boot_ci, outmo_7_boot2$boot_ci) - expect_equal(outmo_8_mc$mc_ci, outmo_8_mc2$mc_ci) - }) +# get_implied_i_lavaan +fit_tmp <- sem(mod, dat[-c(1:10), ], meanstructure = TRUE, fixed.x = FALSE, + group = "gp", + group.label = c("gp3", "gp1", "gp2")) +my_implied <- get_implied_i(coef(fit), fit_tmp) +lav_implied <- lavInspect(fit, "implied") +test_that("Check against lavaan implied", { + expect_equal(unclass(my_implied$cov$gp3), + unclass(lav_implied$gp3$cov)) + }) + +# get_prod + +fit2 <- sem(mod2, dat, meanstructure = TRUE, fixed.x = FALSE, + group = "gp", + group.label = c("gp3", "gp1", "gp2")) +fit2_ng <- sem(mod2, dat, meanstructure = TRUE, fixed.x = FALSE) +dat_tmp <- lav_data_used(fit2) +est_tmp <- lav_est(fit2, se = FALSE, ci = FALSE) +est_tmp2 <- est_tmp +est_tmp2$est <- est_tmp2$est * .5 +est_tmp_ng <- lav_est(fit2_ng, se = FALSE, ci = FALSE) +est_tmp2_ng <- est_tmp_ng +est_tmp2_ng$est <- est_tmp2_ng$est * .5 + +test_that("get_prod and friends", { + expect_true(setequal(c("x", "w4"), + find_product(dat_tmp, "xw4"))) + expect_true(setequal(names(find_all_products(dat_tmp)), + c("m3w4", "xw4"))) + tmp <- get_b(x = "xw4", + y = "y", + est = est_tmp) + tmpchk <- est_tmp[(est_tmp$rhs == "xw4") & + (est_tmp$op == "~"), "est"] + expect_equal(unname(tmp), + unname(tmpchk)) + tmp <- get_prod(x = "x", + y = "y", + fit = fit2, + expand = TRUE) + expect_true(length(tmp$b$xw4) == 3) + }) +tmp1 <- get_prod(x = "x", + y = "y", + fit = fit2, + expand = TRUE) +tmp1_ng <- get_prod(x = "x", + y = "y", + fit = fit2_ng, + expand = TRUE) + +# indirect_i + +indirect_effect(x = "x", + y = "y", + m = "m3", + fit = fit2, + group_number = 2) +indirect_effect(x = "x", + y = "y", + m = "m3", + fit = fit2_ng) From 70090b464ed54d0bdb330af17176b0e309406091 Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Fri, 29 Mar 2024 14:12:23 +0800 Subject: [PATCH 13/70] Can use group number of group label --- R/cond_indirect.R | 16 ++++++----- R/indirect.R | 67 ++++++++++++++++++++++++++++++++++++++++------- 2 files changed, 66 insertions(+), 17 deletions(-) diff --git a/R/cond_indirect.R b/R/cond_indirect.R index 9a7598cb..27732e98 100644 --- a/R/cond_indirect.R +++ b/R/cond_indirect.R @@ -367,10 +367,12 @@ #' supplied, will override `boot_ci` #' and `mc_ci`. #' -#' @param group_number The group number +#' @param group Either the group number #' as appeared in the [summary()] #' or [lavaan::parameterEstimates()] -#' output of an `lavaan`-class object. +#' output of an `lavaan`-class object, +#' or the group label as used in +#' the `lavaan`-class object. #' Used only when the number of #' groups is greater than one. Default #' is NULL. @@ -449,7 +451,7 @@ cond_indirect <- function(x, save_ci_full = FALSE, save_ci_out = TRUE, ci_type = NULL, - group_number = NULL) { + group = NULL) { fit_type <- cond_indirect_check_fit(fit) chkpath <- check_path(x = x, y = y, m = m, fit = fit, est = est) if (!chkpath) { @@ -578,7 +580,7 @@ cond_indirect <- function(x, get_prods_only = TRUE, data = fit_data, expand = TRUE, - group_number = group_number) + group = group) } if (get_prods_only) return(prods) out0 <- indirect_i(x = x, @@ -591,7 +593,7 @@ cond_indirect <- function(x, standardized_x = standardized_x, standardized_y = standardized_y, prods = prods, - group_number = group_number) + group = group) if (mc_ci) { out_mc <- mapply(indirect_i, est = lapply(mc_out, function(x) x$est), @@ -708,7 +710,7 @@ indirect_effect <- function(x, save_ci_full = FALSE, save_ci_out = TRUE, ci_type = NULL, - group_number = NULL) { + group = NULL) { cond_indirect(x = x, y = y, m = m, @@ -735,7 +737,7 @@ indirect_effect <- function(x, save_ci_full = save_ci_full, save_ci_out = save_ci_out, ci_type = ci_type, - group_number = group_number) + group = group) } #' @param w_type Character. Whether the diff --git a/R/indirect.R b/R/indirect.R index 967a0a27..dfc5d971 100644 --- a/R/indirect.R +++ b/R/indirect.R @@ -124,10 +124,12 @@ #' latent variables and observed #' variables. Default is `TRUE`. #' -#' @param group_number The group number +#' @param group Either the group number #' as appeared in the [summary()] #' or [lavaan::parameterEstimates()] -#' output of an `lavaan`-class object. +#' output of an `lavaan`-class object, +#' or the group label as used in +#' the `lavaan`-class object. #' Used only when the number of #' groups is greater than one. Default #' is NULL. @@ -192,7 +194,7 @@ indirect_i <- function(x, expand = TRUE, warn = TRUE, allow_mixing_lav_and_obs = TRUE, - group_number = NULL) { + group = NULL) { if (is.null(est)) { est <- lav_est(fit) } @@ -202,8 +204,25 @@ indirect_i <- function(x, ngroups <- max(est$group) } } - if ((ngroups > 1) && !is.numeric(group_number)) { - stop("The model has more than one group but group_number not set.") + if ((ngroups > 1) && + !is.numeric(group) && + !is.character(group)) { + stop("The model has more than one group but group is not set.") + } + if (ngroups > 1) { + group_labels_all <- lavaan::lavTech(fit, + "group.label") + if (is.numeric(group)) { + group_label <- group_labels_all[group] + group_number <- group + } else { + group_number <- match(group, group_labels_all) + group_label <- group + } + } else { + group_labels_all <- NULL + group_number <- NULL + group_label <- NULL } chkpath <- check_path(x = x, y = y, m = m, fit = fit, est = est) if (!chkpath) { @@ -362,7 +381,9 @@ indirect_i <- function(x, } sum(b_i * wvalues_i) } - b_cond <- sapply(prods, tmpfct) + prods_tmp <- prods_group_i(prods, + group_number = group_number) + b_cond <- sapply(prods_tmp, tmpfct) bs <- bs + b_cond } else { b_cond <- rep(NA, length(bs)) @@ -372,7 +393,8 @@ indirect_i <- function(x, MoreArgs = list(digits = computation_digits, y = y, wvalues = wvalues, - warn = warn), + warn = warn, + group_number = group_number), USE.NAMES = TRUE, SIMPLIFY = FALSE) b_all_str0 <- paste0("(", b_cond_str, ")", collapse = "*") @@ -417,7 +439,9 @@ indirect_i <- function(x, y = y, m = m, computation_values = b_all_str0, - computation_symbols = b_all_str1) + computation_symbols = b_all_str1, + group_number = group_number, + group_label = group_label) class(out) <- "indirect" return(out) } @@ -425,7 +449,8 @@ indirect_i <- function(x, #' @noRd gen_computation <- function(xi, yi, yiname, digits = 3, y, wvalues = NULL, - warn = TRUE) { + warn = TRUE, + group_number = NULL) { yiname_old <- yiname yiname <- paste0("b.", yiname) if (all(is.na(xi)) || is.null(xi$prod)) { @@ -433,6 +458,11 @@ gen_computation <- function(xi, yi, yiname, digits = 3, y, wvalues = NULL, names(out) <- yiname return(out) } + if (is.numeric(group_number)) { + tmp <- sapply(xi$b, function(xx) xx[group_number]) + names(tmp) <- names(xi$b) + xi$b <- tmp + } b_i <- xi$b b_i0 <- paste0("b.", names(b_i)) w_i <- xi$w @@ -490,7 +520,6 @@ gen_computation <- function(xi, yi, yiname, digits = 3, y, wvalues = NULL, out1 <- paste0(y0, " + ", paste0("(", b_i0, ")*(", w_i2, ")", collapse = " + ")) -browser() out2 <- tryCatch(paste0("(", formatC(yi, digits = digits, format = "f"), ") + ", paste0("(", @@ -538,4 +567,22 @@ update_prods <- function(prods, est) { } pout <- sapply(prods, tmpfct, simplify = FALSE) pout + } + +#' @noRd + +prods_group_i <- function(prods, + group_number = NULL) { + if (!is.numeric(group_number)) { + return(prods) + } + pout <- prods + for (i in seq_along(pout)) { + if (!identical(pout[[i]], NA)) { + tmp <- sapply(pout[[i]]$b, function(xx) xx[group_number]) + names(tmp) <- names(pout[[i]]$b) + pout[[i]]$b <- tmp + } + } + pout } \ No newline at end of file From 4a90ecbe49aa10044a4363b6c256e45f7589382b Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Fri, 29 Mar 2024 14:31:01 +0800 Subject: [PATCH 14/70] WIP --- R/indirect.R | 4 + R/lavaan_helpers.R | 30 +++++- tests/testthat/test_mg_boot.R | 174 ++++++++++++++++++++++++++++++++-- 3 files changed, 194 insertions(+), 14 deletions(-) diff --git a/R/indirect.R b/R/indirect.R index dfc5d971..b828bdf2 100644 --- a/R/indirect.R +++ b/R/indirect.R @@ -407,6 +407,10 @@ indirect_i <- function(x, if (is.null(implied_stats)) { implied_stats <- lav_implied_all(fit) } + if (!is.null(group_number)) { + implied_stats <- implied_stats_group_i(implied_stats, + group_number = group_number) + } if (standardized_x) { scale_x <- sqrt(diag(implied_stats$cov)[x]) b_all_str0 <- paste0(b_all_str0, "*(", diff --git a/R/lavaan_helpers.R b/R/lavaan_helpers.R index e312458e..42220647 100644 --- a/R/lavaan_helpers.R +++ b/R/lavaan_helpers.R @@ -1,6 +1,7 @@ #' @noRd -lav_implied_all <- function(fit) { +lav_implied_all <- function(fit, + group_number = NULL) { type <- NA if (inherits(fit, "lavaan")) { type <- "lavaan" @@ -12,14 +13,17 @@ lav_implied_all <- function(fit) { stop("Object is not of a supported type.") } out <- switch(type, - lavaan = lav_implied_all_lavaan(fit), - lavaan.mi = lav_implied_all_lavaan_mi(fit)) + lavaan = lav_implied_all_lavaan(fit, + group_number = group_number), + lavaan.mi = lav_implied_all_lavaan_mi(fit, + group_number = group_number)) out } #' @noRd -lav_implied_all_lavaan <- function(fit) { +lav_implied_all_lavaan <- function(fit, + group_number = NULL) { ovnames <- lavaan::lavNames(fit, "ov") lvnames <- lavaan::lavNames(fit, "lv") allnames <- c(ovnames, lvnames) @@ -42,7 +46,8 @@ lav_implied_all_lavaan <- function(fit) { #' @noRd -lav_implied_all_lavaan_mi <- function(fit) { +lav_implied_all_lavaan_mi <- function(fit, + group_number = NULL) { est0 <- methods::getMethod("coef", signature = "lavaan.mi", where = asNamespace("semTools"))(fit) @@ -192,4 +197,19 @@ lav_ptable_lavaan_mi <- function(fit, ...) { out } +#' @noRd +implied_stats_group_i <- function(object, + group_number = group_number) { + if (is.null(group_number)) { + return(object) + } + out <- lapply(object, function(x) { + if (is.list(x)) { + x[[group_number]] + } else { + x + } + }) + out + } \ No newline at end of file diff --git a/tests/testthat/test_mg_boot.R b/tests/testthat/test_mg_boot.R index 508a7faa..b464bcfc 100644 --- a/tests/testthat/test_mg_boot.R +++ b/tests/testthat/test_mg_boot.R @@ -106,12 +106,168 @@ tmp1_ng <- get_prod(x = "x", # indirect_i -indirect_effect(x = "x", - y = "y", - m = "m3", - fit = fit2, - group_number = 2) -indirect_effect(x = "x", - y = "y", - m = "m3", - fit = fit2_ng) +suppressWarnings(tmp2 <- indirect_effect(x = "x", + y = "y", + m = "m3", + fit = fit2, + group = "gp1")) +suppressWarnings(tmp3 <- indirect_effect(x = "x", + y = "y", + m = "m3", + fit = fit2, + group = 3)) +tmp2_chk <- est_tmp[(est_tmp$lhs == "m3") & + (est_tmp$rhs == "x") & + (est_tmp$group == 2), "est"] * + est_tmp[(est_tmp$lhs == "y") & + (est_tmp$rhs == "m3") & + (est_tmp$group == 2), "est"] +tmp3_chk <- est_tmp[(est_tmp$lhs == "m3") & + (est_tmp$rhs == "x") & + (est_tmp$group == 3), "est"] * + est_tmp[(est_tmp$lhs == "y") & + (est_tmp$rhs == "m3") & + (est_tmp$group == 3), "est"] + +test_that("indirect_effect and multigrop", { + expect_equal(unname(coef(tmp2)), + tmp2_chk) + expect_equal(unname(coef(tmp3)), + tmp3_chk) + }) + +# cond_indirect + +suppressWarnings(tmp2 <- cond_indirect(x = "x", + y = "y", + m = "m3", + fit = fit2, + wvalues = c(w3 = 1, w4 = 2), + group = 2)) +suppressWarnings(tmp3 <- cond_indirect(x = "x", + y = "y", + m = "m3", + fit = fit2, + wvalues = c(w3 = 3, w4 = -2), + group = "gp3")) +tmp2_chk <- est_tmp[(est_tmp$lhs == "m3") & + (est_tmp$rhs == "x") & + (est_tmp$group == 2), "est"] * + (est_tmp[(est_tmp$lhs == "y") & + (est_tmp$rhs == "m3") & + (est_tmp$group == 2), "est"] + + est_tmp[(est_tmp$lhs == "y") & + (est_tmp$rhs == "m3:w3") & + (est_tmp$group == 2), "est"] + + est_tmp[(est_tmp$lhs == "y") & + (est_tmp$rhs == "m3w4") & + (est_tmp$group == 2), "est"] * 2) +tmp3_chk <- est_tmp[(est_tmp$lhs == "m3") & + (est_tmp$rhs == "x") & + (est_tmp$group == 1), "est"] * + (est_tmp[(est_tmp$lhs == "y") & + (est_tmp$rhs == "m3") & + (est_tmp$group == 1), "est"] + + est_tmp[(est_tmp$lhs == "y") & + (est_tmp$rhs == "m3:w3") & + (est_tmp$group == 1), "est"] * 3+ + est_tmp[(est_tmp$lhs == "y") & + (est_tmp$rhs == "m3w4") & + (est_tmp$group == 1), "est"] * -2) + +test_that("indirect_effect and multigrop", { + expect_equal(unname(coef(tmp2)), + tmp2_chk) + expect_equal(unname(coef(tmp3)), + tmp3_chk) + }) + +# indirect_i: stdx / stdy + +suppressWarnings(tmp2 <- indirect_effect(x = "x", + y = "y", + m = "m3", + fit = fit2, + group = "gp1", + standardized_x = TRUE)) +suppressWarnings(tmp3 <- indirect_effect(x = "x", + y = "y", + m = "m3", + fit = fit2, + group = 3, + standardized_y = TRUE)) +sd_x_2 <- sqrt(lavInspect(fit2, "implied")$gp1$cov["x", "x"]) +sd_y_2 <- sqrt(lavInspect(fit2, "implied")$gp1$cov["y", "y"]) +sd_x_3 <- sqrt(lavInspect(fit2, "implied")[[3]]$cov["x", "x"]) +sd_y_3 <- sqrt(lavInspect(fit2, "implied")[[3]]$cov["y", "y"]) +tmp2_chk <- est_tmp[(est_tmp$lhs == "m3") & + (est_tmp$rhs == "x") & + (est_tmp$group == 2), "est"] * + est_tmp[(est_tmp$lhs == "y") & + (est_tmp$rhs == "m3") & + (est_tmp$group == 2), "est"] * sd_x_2 / 1 +tmp3_chk <- est_tmp[(est_tmp$lhs == "m3") & + (est_tmp$rhs == "x") & + (est_tmp$group == 3), "est"] * + est_tmp[(est_tmp$lhs == "y") & + (est_tmp$rhs == "m3") & + (est_tmp$group == 3), "est"] * 1 / sd_y_3 + +test_that("indirect_effect and multigrop", { + expect_equal(unname(coef(tmp2)), + tmp2_chk) + expect_equal(unname(coef(tmp3)), + tmp3_chk) + }) + +# cond_indirect: stdx / stdy + +suppressWarnings(tmp2 <- cond_indirect(x = "x", + y = "y", + m = "m3", + fit = fit2, + wvalues = c(w3 = 1, w4 = 2), + group = 2, + standardized_x = TRUE)) +suppressWarnings(tmp3 <- cond_indirect(x = "x", + y = "y", + m = "m3", + fit = fit2, + wvalues = c(w3 = 3, w4 = -2), + group = "gp3", + standardized_y = TRUE)) +sd_x_2 <- sqrt(lavInspect(fit2, "implied")$gp1$cov["x", "x"]) +sd_y_2 <- sqrt(lavInspect(fit2, "implied")$gp1$cov["y", "y"]) +sd_x_3 <- sqrt(lavInspect(fit2, "implied")[[1]]$cov["x", "x"]) +sd_y_3 <- sqrt(lavInspect(fit2, "implied")[[1]]$cov["y", "y"]) +tmp2_chk <- est_tmp[(est_tmp$lhs == "m3") & + (est_tmp$rhs == "x") & + (est_tmp$group == 2), "est"] * + (est_tmp[(est_tmp$lhs == "y") & + (est_tmp$rhs == "m3") & + (est_tmp$group == 2), "est"] + + est_tmp[(est_tmp$lhs == "y") & + (est_tmp$rhs == "m3:w3") & + (est_tmp$group == 2), "est"] + + est_tmp[(est_tmp$lhs == "y") & + (est_tmp$rhs == "m3w4") & + (est_tmp$group == 2), "est"] * 2) * sd_x_2 +tmp3_chk <- est_tmp[(est_tmp$lhs == "m3") & + (est_tmp$rhs == "x") & + (est_tmp$group == 1), "est"] * + (est_tmp[(est_tmp$lhs == "y") & + (est_tmp$rhs == "m3") & + (est_tmp$group == 1), "est"] + + est_tmp[(est_tmp$lhs == "y") & + (est_tmp$rhs == "m3:w3") & + (est_tmp$group == 1), "est"] * 3+ + est_tmp[(est_tmp$lhs == "y") & + (est_tmp$rhs == "m3w4") & + (est_tmp$group == 1), "est"] * -2) * 1 / sd_y_3 + +test_that("indirect_effect and multigrop", { + expect_equal(unname(coef(tmp2)), + tmp2_chk) + expect_equal(unname(coef(tmp3)), + tmp3_chk) + }) From cdc05cf6ed93d4c61af0d6aade8b979aea504911 Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Fri, 29 Mar 2024 14:59:29 +0800 Subject: [PATCH 15/70] Update doc --- man/cond_indirect.Rd | 16 ++++++++++++++-- man/indirect_i.Rd | 13 ++++++++++++- 2 files changed, 26 insertions(+), 3 deletions(-) diff --git a/man/cond_indirect.Rd b/man/cond_indirect.Rd index 778b337c..2bd28fca 100644 --- a/man/cond_indirect.Rd +++ b/man/cond_indirect.Rd @@ -38,7 +38,8 @@ cond_indirect( ci_out = NULL, save_ci_full = FALSE, save_ci_out = TRUE, - ci_type = NULL + ci_type = NULL, + group = NULL ) cond_indirect_effects( @@ -96,7 +97,8 @@ indirect_effect( ci_out = NULL, save_ci_full = FALSE, save_ci_out = TRUE, - ci_type = NULL + ci_type = NULL, + group = NULL ) many_indirect_effects(paths, ...) @@ -304,6 +306,16 @@ other arguments supplied, will override \code{boot_ci} and \code{mc_ci}.} +\item{group}{Either the group number +as appeared in the \code{\link[=summary]{summary()}} +or \code{\link[lavaan:parameterEstimates]{lavaan::parameterEstimates()}} +output of an \code{lavaan}-class object, +or the group label as used in +the \code{lavaan}-class object. +Used only when the number of +groups is greater than one. Default +is NULL.} + \item{wlevels}{The output of \code{\link[=merge_mod_levels]{merge_mod_levels()}}, or the moderator(s) to be passed to diff --git a/man/indirect_i.Rd b/man/indirect_i.Rd index 9ba7fdb3..9a799360 100644 --- a/man/indirect_i.Rd +++ b/man/indirect_i.Rd @@ -21,7 +21,8 @@ indirect_i( data = NULL, expand = TRUE, warn = TRUE, - allow_mixing_lav_and_obs = TRUE + allow_mixing_lav_and_obs = TRUE, + group = NULL ) } \arguments{ @@ -122,6 +123,16 @@ omitted intentionally.} \code{TRUE}, it accepts a path with both latent variables and observed variables. Default is \code{TRUE}.} + +\item{group}{Either the group number +as appeared in the \code{\link[=summary]{summary()}} +or \code{\link[lavaan:parameterEstimates]{lavaan::parameterEstimates()}} +output of an \code{lavaan}-class object, +or the group label as used in +the \code{lavaan}-class object. +Used only when the number of +groups is greater than one. Default +is NULL.} } \value{ It returns an From 5276aa7bf8350bff7604a5a268d564a8099b66fb Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Fri, 29 Mar 2024 15:26:39 +0800 Subject: [PATCH 16/70] Update print.indirect() for ngroups > 1 Tests passed --- R/print_indirect.R | 42 ++++++++++++++++++++++++++++++++++++++---- 1 file changed, 38 insertions(+), 4 deletions(-) diff --git a/R/print_indirect.R b/R/print_indirect.R index c4483dc0..595fb0bc 100644 --- a/R/print_indirect.R +++ b/R/print_indirect.R @@ -134,6 +134,11 @@ print.indirect <- function(x, standardized <- (standardized_x && standardized_y) has_ci <- FALSE ci_type <- NULL + if (is.numeric(x$group_number)) { + has_group <- TRUE + } else { + has_group <- FALSE + } if (isTRUE(!is.null(x$boot_ci))) { has_ci <- TRUE ci_type <- "boot" @@ -216,7 +221,8 @@ print.indirect <- function(x, cat("\n== Conditional", cond_str2, "Effect", std_str, " ==") } else { - cat("\n==", cond_str2, "Effect ==") + cat("\n==", cond_str2, "Effect", + std_str, "==") } cat("\n") ptable <- data.frame(Factor = "Path:", Value = path) @@ -283,7 +289,7 @@ print.indirect <- function(x, } else { if (is.null(x$op)) { ptable <- rbind(ptable, - c(ifelse(has_m, "Indirect Effect", "Effect"), + c(ifelse(has_m, "Indirect Effect:", "Effect:"), formatC(x$indirect, digits = digits, format = "f"))) } else { ptable <- rbind(ptable, @@ -292,6 +298,12 @@ print.indirect <- function(x, } if (has_ci) {ptable <- rbind(ptable, b_row, b_row2, b_row3)} } + if (has_group) { + ptable <- rbind(ptable, + c("Group Label:", x$group_label)) + ptable <- rbind(ptable, + c("Group Number:", x$group_number)) + } ptable <- data.frame(lapply(ptable, format)) colnames(ptable) <- c("", "") print(ptable, row.names = FALSE) @@ -355,10 +367,32 @@ print.indirect <- function(x, cat("\nCoefficients of Component Paths:") cat("\n") print(out, digits = digits, row.names = FALSE) + print_note <- FALSE + if (standardized_x || + standardized_y || + has_group) { + print_note <- TRUE + } + note_str <- character(0) if (standardized_x || standardized_y) { - cat("\nNOTE: The effects of the component paths are from the model, not standardized.") + note_str <- c(note_str, + strwrap("- The effects of the component paths are from the model, not standardized.", + exdent = 2)) + if (has_group) { + note_str <- c(note_str, + strwrap("- SD(s) in the selected group is/are used in standardiziation.", + exdent = 2)) + } + } + if (has_group) { + note_str <- c(note_str, + strwrap("- The group number is the number used internally in lavaan.", + exdent = 2)) } + if (length(note_str) > 0) { + cat("\nNOTE:\n") + cat(note_str, sep = "\n") + } } - cat("\n") invisible(x) } From 81cce3fb1f7195e74e2f30bfa048b796131de2d4 Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Fri, 29 Mar 2024 16:51:36 +0800 Subject: [PATCH 17/70] Make boot_ci works for ngroups > 1 Tests passed --- R/boot2est_lavaan.R | 16 +++++++++++----- R/cond_indirect.R | 6 ++++-- 2 files changed, 15 insertions(+), 7 deletions(-) diff --git a/R/boot2est_lavaan.R b/R/boot2est_lavaan.R index b41d3f16..ab091e43 100644 --- a/R/boot2est_lavaan.R +++ b/R/boot2est_lavaan.R @@ -189,10 +189,12 @@ fit2boot_out_do_boot <- function(fit, } else { n <- sapply(dat_org, nrow) } - boot_test <- suppressWarnings(boot_i(dat_org)) + boot_test <- suppressWarnings(boot_i(dat_org, + start = lavaan::parameterTable(fit)$start)) + # Increase the tolerance for mutliple group model if (!isTRUE(all.equal(unclass(lavaan::coef(fit)), lavaan::coef(boot_test)[names(lavaan::coef(fit))], - tolerance = sqrt(.Machine$double.eps * 1e04)))) { + tolerance = sqrt(.Machine$double.eps * 1e08)))) { stop(paste("Something is wrong.", "This function cannot reproduce the results.", "Please fit the model with se = 'boot'")) @@ -604,19 +606,23 @@ gen_boot_i_lavaan <- function(fit) { X_old <- fit_data@X - function(d, i = NULL) { + function(d, i = NULL, start = NULL) { force(fit_data) force(fit_model) force(fit_sampstats) force(fit_opts) force(fit_pt) force(fit) + fit_pt1 <- fit_pt + if (!is.null(start)) { + fit_pt1$start <- start + } if (is.null(i)) { return(lavaan::lavaan(slotData = fit_data, slotModel = fit_model, slotSampleStats = fit_sampstats, slotOptions = fit_opts, - slotParTable = fit_pt)) + slotParTable = fit_pt1)) } else { # 2024-03-29: Added support for multigroup models if (!is.list(i)) { @@ -659,7 +665,7 @@ gen_boot_i_lavaan <- function(fit) { slotModel = fit_model_i, slotSampleStats = fit_sampstats_new, slotOptions = fit_opts, - slotParTable = fit_pt), + slotParTable = fit_pt1), error = function(e) e, warning = function(e) e) if (inherits(out, "error") || inherits(out, "warning")) { diff --git a/R/cond_indirect.R b/R/cond_indirect.R index 27732e98..b23ec04a 100644 --- a/R/cond_indirect.R +++ b/R/cond_indirect.R @@ -606,7 +606,8 @@ cond_indirect <- function(x, standardized_x = standardized_x, standardized_y = standardized_y, warn = FALSE, - prods = prods), + prods = prods, + group = group), SIMPLIFY = FALSE) if (save_mc_full) { out0$mc_full <- out_mc @@ -644,7 +645,8 @@ cond_indirect <- function(x, standardized_x = standardized_x, standardized_y = standardized_y, warn = FALSE, - prods = prods), + prods = prods, + group = group), SIMPLIFY = FALSE) if (save_boot_full) { out0$boot_full <- out_boot From 85ae0f4c85b4ef5d6952fd40cc3430399478c69b Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Fri, 29 Mar 2024 19:02:10 +0800 Subject: [PATCH 18/70] Update test_mg_boot.R --- tests/testthat/test_mg_boot.R | 261 ++++++++++++++++++++++++++++------ 1 file changed, 218 insertions(+), 43 deletions(-) diff --git a/tests/testthat/test_mg_boot.R b/tests/testthat/test_mg_boot.R index b464bcfc..7ad8bad6 100644 --- a/tests/testthat/test_mg_boot.R +++ b/tests/testthat/test_mg_boot.R @@ -1,4 +1,4 @@ -skip("WIP") +skip_on_cran() library(testthat) library(manymome) @@ -27,6 +27,31 @@ m3 ~ m1 + x y ~ m2 + m3 + x + w4 + xw4 + w3 + m3:w3 + m3w4 " +# This model is not exactly identical to the previous one +# due the labelled variances +mod2_chk <- +" +m3 ~ m1 + c(a1, a2, a3)*x +y ~ m2 + c(b1, b2, b3)*m3 + x + w4 + xw4 + w3 + c(d31, d32, d33)*m3:w3 + c(d41, d42, d43)*m3w4 +ab1 := a1*b1 +ab2 := a2*b2 +ab3 := a3*b3 +ab2_d := a2*(b2 + 1*d32 + 2*d42) +ab1_d := a1*(b1 + 3*d31 + (-2)*d41) +x ~~ c(v_x1, v_x2, v_x3) * x +ab1_stdx := a1*b1*sqrt(v_x1) +ab2_stdx := a2*b2*sqrt(v_x2) +ab3_stdx := a3*b3*sqrt(v_x3) +" + +dat$m3w3 <- dat$m3 * dat$w3 +mod3 <- +" +m3 ~ m1 + x +y ~ m2 + m3 + x + w4 + xw4 + w3 + m3w3 + m3w4 +" + + # Check against lavaan fit <- sem(mod, dat, meanstructure = TRUE, fixed.x = FALSE, @@ -67,6 +92,10 @@ test_that("Check against lavaan implied", { fit2 <- sem(mod2, dat, meanstructure = TRUE, fixed.x = FALSE, group = "gp", group.label = c("gp3", "gp1", "gp2")) +fit2_chk <- sem(mod2_chk, dat, meanstructure = TRUE, fixed.x = FALSE, + group = "gp", + group.label = c("gp3", "gp1", "gp2")) + fit2_ng <- sem(mod2, dat, meanstructure = TRUE, fixed.x = FALSE) dat_tmp <- lav_data_used(fit2) est_tmp <- lav_est(fit2, se = FALSE, ci = FALSE) @@ -115,25 +144,29 @@ suppressWarnings(tmp3 <- indirect_effect(x = "x", y = "y", m = "m3", fit = fit2, - group = 3)) -tmp2_chk <- est_tmp[(est_tmp$lhs == "m3") & - (est_tmp$rhs == "x") & - (est_tmp$group == 2), "est"] * - est_tmp[(est_tmp$lhs == "y") & - (est_tmp$rhs == "m3") & - (est_tmp$group == 2), "est"] -tmp3_chk <- est_tmp[(est_tmp$lhs == "m3") & - (est_tmp$rhs == "x") & - (est_tmp$group == 3), "est"] * - est_tmp[(est_tmp$lhs == "y") & - (est_tmp$rhs == "m3") & - (est_tmp$group == 3), "est"] + group = 1)) +# tmp2_chk <- est_tmp[(est_tmp$lhs == "m3") & +# (est_tmp$rhs == "x") & +# (est_tmp$group == 2), "est"] * +# est_tmp[(est_tmp$lhs == "y") & +# (est_tmp$rhs == "m3") & +# (est_tmp$group == 2), "est"] +tmp2_chk <- coef(fit2_chk, type = "user")["ab2"] +# tmp3_chk <- est_tmp[(est_tmp$lhs == "m3") & +# (est_tmp$rhs == "x") & +# (est_tmp$group == 1), "est"] * +# est_tmp[(est_tmp$lhs == "y") & +# (est_tmp$rhs == "m3") & +# (est_tmp$group == 1), "est"] +tmp3_chk <- coef(fit2_chk, type = "user")["ab1"] test_that("indirect_effect and multigrop", { expect_equal(unname(coef(tmp2)), - tmp2_chk) - expect_equal(unname(coef(tmp3)), - tmp3_chk) + unname(tmp2_chk), + tolerance = 1e-05) + # Can't just compare them. Don't know why. + expect_equal(unname(coef(tmp3)) - unname(tmp3_chk), + 0) }) # cond_indirect @@ -150,36 +183,40 @@ suppressWarnings(tmp3 <- cond_indirect(x = "x", fit = fit2, wvalues = c(w3 = 3, w4 = -2), group = "gp3")) -tmp2_chk <- est_tmp[(est_tmp$lhs == "m3") & - (est_tmp$rhs == "x") & - (est_tmp$group == 2), "est"] * - (est_tmp[(est_tmp$lhs == "y") & - (est_tmp$rhs == "m3") & - (est_tmp$group == 2), "est"] + - est_tmp[(est_tmp$lhs == "y") & - (est_tmp$rhs == "m3:w3") & - (est_tmp$group == 2), "est"] + - est_tmp[(est_tmp$lhs == "y") & - (est_tmp$rhs == "m3w4") & - (est_tmp$group == 2), "est"] * 2) -tmp3_chk <- est_tmp[(est_tmp$lhs == "m3") & - (est_tmp$rhs == "x") & - (est_tmp$group == 1), "est"] * - (est_tmp[(est_tmp$lhs == "y") & - (est_tmp$rhs == "m3") & - (est_tmp$group == 1), "est"] + - est_tmp[(est_tmp$lhs == "y") & - (est_tmp$rhs == "m3:w3") & - (est_tmp$group == 1), "est"] * 3+ - est_tmp[(est_tmp$lhs == "y") & - (est_tmp$rhs == "m3w4") & - (est_tmp$group == 1), "est"] * -2) +# tmp2_chk <- est_tmp[(est_tmp$lhs == "m3") & +# (est_tmp$rhs == "x") & +# (est_tmp$group == 2), "est"] * +# (est_tmp[(est_tmp$lhs == "y") & +# (est_tmp$rhs == "m3") & +# (est_tmp$group == 2), "est"] + +# est_tmp[(est_tmp$lhs == "y") & +# (est_tmp$rhs == "m3:w3") & +# (est_tmp$group == 2), "est"] + +# est_tmp[(est_tmp$lhs == "y") & +# (est_tmp$rhs == "m3w4") & +# (est_tmp$group == 2), "est"] * 2) +tmp2_chk <- coef(fit2_chk, type = "user")["ab2_d"] +# tmp3_chk <- est_tmp[(est_tmp$lhs == "m3") & +# (est_tmp$rhs == "x") & +# (est_tmp$group == 1), "est"] * +# (est_tmp[(est_tmp$lhs == "y") & +# (est_tmp$rhs == "m3") & +# (est_tmp$group == 1), "est"] + +# est_tmp[(est_tmp$lhs == "y") & +# (est_tmp$rhs == "m3:w3") & +# (est_tmp$group == 1), "est"] * 3+ +# est_tmp[(est_tmp$lhs == "y") & +# (est_tmp$rhs == "m3w4") & +# (est_tmp$group == 1), "est"] * -2) +tmp3_chk <- coef(fit2_chk, type = "user")["ab1_d"] test_that("indirect_effect and multigrop", { expect_equal(unname(coef(tmp2)), - tmp2_chk) + unname(tmp2_chk), + tolerance = 1e-5) expect_equal(unname(coef(tmp3)), - tmp3_chk) + unname(tmp3_chk), + tolerance = 1e-4) }) # indirect_i: stdx / stdy @@ -196,6 +233,13 @@ suppressWarnings(tmp3 <- indirect_effect(x = "x", fit = fit2, group = 3, standardized_y = TRUE)) +suppressWarnings(tmp4 <- indirect_effect(x = "x", + y = "y", + m = "m3", + fit = fit2, + group = 3, + standardized_y = TRUE, + standardized_x = TRUE)) sd_x_2 <- sqrt(lavInspect(fit2, "implied")$gp1$cov["x", "x"]) sd_y_2 <- sqrt(lavInspect(fit2, "implied")$gp1$cov["y", "y"]) sd_x_3 <- sqrt(lavInspect(fit2, "implied")[[3]]$cov["x", "x"]) @@ -218,6 +262,8 @@ test_that("indirect_effect and multigrop", { tmp2_chk) expect_equal(unname(coef(tmp3)), tmp3_chk) + expect_equal(unname(coef(tmp4)), + tmp3_chk * sd_x_3) }) # cond_indirect: stdx / stdy @@ -271,3 +317,132 @@ test_that("indirect_effect and multigrop", { expect_equal(unname(coef(tmp3)), tmp3_chk) }) + +skip("Long tests: Test in interactive sections") + +# Indirect with bootstrap + +fit3 <- sem(mod3, dat, meanstructure = TRUE, fixed.x = FALSE, + group = "gp", + group.label = c("gp3", "gp1", "gp2")) + +fit2_boot_out <- do_boot(fit2, + R = 50, + seed = 1234, + parallel = FALSE, + progress = FALSE) + +suppressWarnings(fit2_chk_boot <- sem(mod2_chk, dat, meanstructure = TRUE, fixed.x = FALSE, + group = "gp", + group.label = c("gp3", "gp1", "gp2"), + se = "bootstrap", + bootstrap = 50, + iseed = 1234)) + +fit2_chk_boot_out <- do_boot(fit2_chk_boot) + +suppressWarnings(tmp2 <- indirect_effect(x = "x", + y = "y", + m = "m3", + fit = fit2, + group = "gp1", + boot_ci = TRUE, + boot_out = fit2_boot_out)) +suppressWarnings(tmp3 <- indirect_effect(x = "x", + y = "y", + m = "m3", + fit = fit2, + group = 3, + boot_ci = TRUE, + boot_out = fit2_boot_out)) + +suppressWarnings(tmp2_chk_boot <- indirect_effect(x = "x", + y = "y", + m = "m3", + fit = fit2_chk_boot, + group = "gp1", + boot_ci = TRUE)) +suppressWarnings(tmp3_chk_boot <- indirect_effect(x = "x", + y = "y", + m = "m3", + fit = fit2_chk_boot, + group = 3, + boot_ci = TRUE)) + +est_chk <- parameterEstimates(fit2_chk_boot) + +test_that("indirect_effect and multigrop", { + i <- match("ab2", est_chk$lhs) + expect_equal(unname(as.vector(confint(tmp2))), + unname(unlist(est_chk[i, c("ci.lower", "ci.upper")])), + tolerance = 1e-4) + i <- match("ab3", est_chk$lhs) + expect_equal(unname(as.vector(confint(tmp3))), + unname(unlist(est_chk[i, c("ci.lower", "ci.upper")])), + tolerance = 1e-4) + i <- match("ab2", est_chk$lhs) + expect_equal(unname(as.vector(confint(tmp2_chk_boot))), + unname(unlist(est_chk[i, c("ci.lower", "ci.upper")])), + tolerance = 1e-4) + i <- match("ab3", est_chk$lhs) + expect_equal(unname(as.vector(confint(tmp3_chk_boot))), + unname(unlist(est_chk[i, c("ci.lower", "ci.upper")])), + tolerance = 1e-4) + }) + + +# Indirect with bootstrap: stdx / stdy + +suppressWarnings(tmp2 <- indirect_effect(x = "x", + y = "y", + m = "m3", + fit = fit2, + group = "gp1", + boot_ci = TRUE, + boot_out = fit2_boot_out, + standardized_x = TRUE)) +suppressWarnings(tmp3 <- indirect_effect(x = "x", + y = "y", + m = "m3", + fit = fit2, + group = 3, + boot_ci = TRUE, + boot_out = fit2_boot_out, + standardized_x = TRUE)) + +suppressWarnings(tmp2_chk_boot <- indirect_effect(x = "x", + y = "y", + m = "m3", + fit = fit2_chk_boot, + group = "gp1", + boot_ci = TRUE, + standardized_x = TRUE)) +suppressWarnings(tmp3_chk_boot <- indirect_effect(x = "x", + y = "y", + m = "m3", + fit = fit2_chk_boot, + group = 3, + boot_ci = TRUE, + standardized_x = TRUE)) + +est_chk <- parameterEstimates(fit2_chk_boot) + +test_that("indirect_effect and multigrop", { + i <- match("ab2_stdx", est_chk$lhs) + expect_equal(unname(as.vector(confint(tmp2))), + unname(unlist(est_chk[i, c("ci.lower", "ci.upper")])), + tolerance = 1e-4) + i <- match("ab3_stdx", est_chk$lhs) + expect_equal(unname(as.vector(confint(tmp3))), + unname(unlist(est_chk[i, c("ci.lower", "ci.upper")])), + tolerance = 1e-4) + i <- match("ab2_stdx", est_chk$lhs) + expect_equal(unname(as.vector(confint(tmp2_chk_boot))), + unname(unlist(est_chk[i, c("ci.lower", "ci.upper")])), + tolerance = 1e-4) + i <- match("ab3_stdx", est_chk$lhs) + expect_equal(unname(as.vector(confint(tmp3_chk_boot))), + unname(unlist(est_chk[i, c("ci.lower", "ci.upper")])), + tolerance = 1e-4) + }) + From a1ddbe9aa7f350404b7ab02d3e8c0ed8dce12b2c Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Fri, 29 Mar 2024 20:08:01 +0800 Subject: [PATCH 19/70] Update set_est_i_lavaan() to work with ngroups > 1 Tests passed --- R/boot2est_lavaan.R | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/R/boot2est_lavaan.R b/R/boot2est_lavaan.R index ab091e43..28134d65 100644 --- a/R/boot2est_lavaan.R +++ b/R/boot2est_lavaan.R @@ -374,8 +374,13 @@ set_est_i_lavaan <- function(est0, fit, p_free, est_df = NULL) { ptable <- as.data.frame(fit@ParTable) if (!is.null(est_df)) { est_df$est <- NULL - est0 <- merge(est_df, ptable[, c("lhs", "op", "rhs", "est")], - sort = FALSE) + if ("group" %in% colnames(est_df)) { + est0 <- merge(est_df, ptable[, c("lhs", "op", "rhs", "block", "group", "est")], + sort = FALSE) + } else { + est0 <- merge(est_df, ptable[, c("lhs", "op", "rhs", "est")], + sort = FALSE) + } class(est0) <- class(est_df) return(est0) } else { From 4ff3fa44028a3f43a5c8149d1e701281e1fd5857 Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Fri, 29 Mar 2024 20:50:00 +0800 Subject: [PATCH 20/70] Update test_mg_boot.R --- tests/testthat/test_mg_boot.R | 184 +++++++++++++++++++++++++++++++++- 1 file changed, 183 insertions(+), 1 deletion(-) diff --git a/tests/testthat/test_mg_boot.R b/tests/testthat/test_mg_boot.R index 7ad8bad6..03fa0eaa 100644 --- a/tests/testthat/test_mg_boot.R +++ b/tests/testthat/test_mg_boot.R @@ -318,6 +318,189 @@ test_that("indirect_effect and multigrop", { tmp3_chk) }) +# Check do_mc + +fit_eq <- sem(mod, dat, meanstructure = TRUE, fixed.x = FALSE, + group = "gp", + group.label = c("gp3", "gp1", "gp2"), + group.equal = "regressions") + +fit_mc_out <- do_mc(fit, R = 4, + seed = 2345, + progress = FALSE, + parallel = FALSE) + +fit_eq_mc_out <- do_mc(fit_eq, R = 4, + seed = 2345, + progress = FALSE, + parallel = FALSE) + +fit_mc_out <- do_mc(fit2, R = 50, + seed = 2345, + progress = FALSE, + parallel = FALSE) + +get_mc_est <- function(object, lhs, op = "~", rhs, group = NA) { + out <- sapply(object, function(x) { + esti <- x$est + out1 <- esti[(esti$lhs == lhs) & (esti$op == op) & (esti$rhs == rhs), ] + if (!is.na(group)) { + out1 <- out1[out1$group == group, ] + } + out1[, "est"] + }) + out + } + +get_mc_implied <- function(object, var, group = NA) { + out <- sapply(object, function(x) { + imp <- x$implied_stats$cov + if (!is.na(group)) { + out <- imp[[group]][var, var] + } else { + out <- imp[var, var] + } + out + }) + out + } + +# indirect_i: mc + +suppressWarnings(tmp2 <- indirect_effect(x = "x", + y = "y", + m = "m3", + fit = fit2, + group = "gp1", + mc_ci = TRUE, + mc_out = fit_mc_out)) +suppressWarnings(tmp3 <- indirect_effect(x = "x", + y = "y", + m = "m3", + fit = fit2, + group = 1, + mc_ci = TRUE, + mc_out = fit_mc_out)) + +tmp2a <- get_mc_est(fit_mc_out, lhs = "m3", rhs = "x", group = 2) +tmp2b <- get_mc_est(fit_mc_out, lhs = "y", rhs = "m3", group = 2) +tmp2ab <- tmp2a * tmp2b +tmp3a <- get_mc_est(fit_mc_out, lhs = "m3", rhs = "x", group = 1) +tmp3b <- get_mc_est(fit_mc_out, lhs = "y", rhs = "m3", group = 1) +tmp3ab <- tmp3a * tmp3b + +test_that("indirect_effect and multigrop", { + expect_equal(tmp2$mc_indirect, + tmp2ab) + expect_equal(tmp3$mc_indirect, + tmp3ab) + }) + +# indirect_i: mc, stdx / stdy + +suppressWarnings(tmp2 <- indirect_effect(x = "x", + y = "y", + m = "m3", + fit = fit2, + group = "gp1", + mc_ci = TRUE, + mc_out = fit_mc_out, + standardized_y = TRUE)) +suppressWarnings(tmp3 <- indirect_effect(x = "x", + y = "y", + m = "m3", + fit = fit2, + group = 1, + mc_ci = TRUE, + mc_out = fit_mc_out, + standardized_x = TRUE)) +suppressWarnings(tmp4 <- indirect_effect(x = "x", + y = "y", + m = "m3", + fit = fit2, + group = 1, + mc_ci = TRUE, + mc_out = fit_mc_out, + standardized_y = TRUE, + standardized_x = TRUE)) + +tmp2a <- get_mc_est(fit_mc_out, lhs = "m3", rhs = "x", group = 2) +tmp2b <- get_mc_est(fit_mc_out, lhs = "y", rhs = "m3", group = 2) +tmp2ysd <- sqrt(get_mc_implied(fit_mc_out, var = "y", group = 2)) +tmp2ab <- tmp2a * tmp2b / tmp2ysd +tmp3a <- get_mc_est(fit_mc_out, lhs = "m3", rhs = "x", group = 1) +tmp3b <- get_mc_est(fit_mc_out, lhs = "y", rhs = "m3", group = 1) +tmp3xsd <- sqrt(get_mc_implied(fit_mc_out, var = "x", group = 1)) +tmp3ysd <- sqrt(get_mc_implied(fit_mc_out, var = "y", group = 1)) +tmp3ab <- tmp3a * tmp3b * tmp3xsd +tmp4ab <- tmp3a * tmp3b * tmp3xsd / tmp3ysd + +test_that("indirect_effect and multigrop", { + expect_equal(tmp2$mc_indirect, + tmp2ab) + expect_equal(tmp3$mc_indirect, + tmp3ab) + expect_equal(tmp4$mc_indirect, + tmp4ab) + }) + +# cond_indirect, stdx / stdy: mc + +suppressWarnings(tmp2 <- cond_indirect(x = "x", + y = "y", + m = "m3", + fit = fit2, + wvalues = c(w3 = 1, w4 = 2), + group = 2, + mc_ci = TRUE, + mc_out = fit_mc_out, + standardized_y = TRUE)) +suppressWarnings(tmp3 <- cond_indirect(x = "x", + y = "y", + m = "m3", + fit = fit2, + wvalues = c(w3 = 3, w4 = -2), + group = "gp3", + mc_ci = TRUE, + mc_out = fit_mc_out, + standardized_x = TRUE)) +suppressWarnings(tmp4 <- cond_indirect(x = "x", + y = "y", + m = "m3", + fit = fit2, + wvalues = c(w3 = 3, w4 = -2), + group = "gp3", + mc_ci = TRUE, + mc_out = fit_mc_out, + standardized_y = TRUE, + standardized_x = TRUE)) + +tmp2a <- get_mc_est(fit_mc_out, lhs = "m3", rhs = "x", group = 2) +tmp2b <- get_mc_est(fit_mc_out, lhs = "y", rhs = "m3", group = 2) +tmp2d1 <- get_mc_est(fit_mc_out, lhs = "y", rhs = "m3:w3", group = 2) +tmp2d2 <- get_mc_est(fit_mc_out, lhs = "y", rhs = "m3w4", group = 2) +tmp2ysd <- sqrt(get_mc_implied(fit_mc_out, var = "y", group = 2)) +tmp2ab <- tmp2a * (tmp2b + 1 * tmp2d1 + 2 * tmp2d2) / tmp2ysd + +tmp3a <- get_mc_est(fit_mc_out, lhs = "m3", rhs = "x", group = 1) +tmp3b <- get_mc_est(fit_mc_out, lhs = "y", rhs = "m3", group = 1) +tmp3d1 <- get_mc_est(fit_mc_out, lhs = "y", rhs = "m3:w3", group = 1) +tmp3d2 <- get_mc_est(fit_mc_out, lhs = "y", rhs = "m3w4", group = 1) +tmp3xsd <- sqrt(get_mc_implied(fit_mc_out, var = "x", group = 1)) +tmp3ysd <- sqrt(get_mc_implied(fit_mc_out, var = "y", group = 1)) +tmp3ab <- tmp3a * (tmp3b + 3 * tmp3d1 + (-2) * tmp3d2) * tmp3xsd + +tmp4ab <- tmp3a * (tmp3b + 3 * tmp3d1 + (-2) * tmp3d2) * tmp3xsd / tmp3ysd + +test_that("indirect_effect and multigrop", { + expect_equal(tmp2$mc_indirect, + tmp2ab) + expect_equal(tmp3$mc_indirect, + tmp3ab) + expect_equal(tmp4$mc_indirect, + tmp4ab) + }) + skip("Long tests: Test in interactive sections") # Indirect with bootstrap @@ -445,4 +628,3 @@ test_that("indirect_effect and multigrop", { unname(unlist(est_chk[i, c("ci.lower", "ci.upper")])), tolerance = 1e-4) }) - From 0d5b246d286b5d1009e676da4533af07af751850 Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Fri, 29 Mar 2024 21:08:03 +0800 Subject: [PATCH 21/70] No longer require two paths to be different in math Tests passed --- R/cond_indirect_effects_math.R | 9 ++++++--- tests/testthat/test_cond_indirect_math.R | 3 ++- 2 files changed, 8 insertions(+), 4 deletions(-) diff --git a/R/cond_indirect_effects_math.R b/R/cond_indirect_effects_math.R index 49714760..97ca03f9 100644 --- a/R/cond_indirect_effects_math.R +++ b/R/cond_indirect_effects_math.R @@ -282,9 +282,12 @@ check_xy <- function(e1, e2) { m2 <- list(m2) } m1m2_chk <- intersect(m1, m2) - if (length(m1m2_chk) != 0) { - stop("The objects have one or more paths in common.") - } + # Disable this test. + # - The two effects can be two conditional effects. + # - The two effects can be from two different groups. + # if (length(m1m2_chk) != 0) { + # stop("The objects have one or more paths in common.") + # } if (!identical(stdx1, stdx2)) { stop("x is standardized in one object but not in the other.") } diff --git a/tests/testthat/test_cond_indirect_math.R b/tests/testthat/test_cond_indirect_math.R index 54e7f42a..ea4d9caf 100644 --- a/tests/testthat/test_cond_indirect_math.R +++ b/tests/testthat/test_cond_indirect_math.R @@ -137,7 +137,8 @@ test_that("math for indirect: mediation", { expect_equal(out1m1m2m3boot2$indirect_raw, outm_boot$indirect_raw + outm2_boot$indirect_raw + outm3_boot$indirect_raw) expect_equal(outm1minus2boot$indirect_raw, outm_boot$indirect_raw - outm2_boot$indirect_raw) expect_equal(outm1minus3boot$indirect_raw, outm_boot$indirect_raw - outm3_boot$indirect_raw) - expect_error(outm_boot + outm_boot) + # No longer a requirement + # expect_error(outm_boot + outm_boot) expect_equal(coef(outm1minus2), outm1minus2$indirect, ignore_attr = TRUE) expect_equal(coef(outm1plus3), outm1plus3$indirect, ignore_attr = TRUE) expect_equal(coef(outm1minus2boot), outm1minus2boot$indirect, ignore_attr = TRUE) From fcf1bdbdbfeb4d829b1e4e86783d066e08a790f5 Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Fri, 29 Mar 2024 22:17:50 +0800 Subject: [PATCH 22/70] Revise MathOp to support ngroups > 1 Tests passed. --- R/cond_indirect_effects_math.R | 54 ++++++++++++++++--- R/print_indirect.R | 48 ++++++++++------- tests/testthat/test_mg_boot.R | 96 ++++++++++++++++++++++++++++++++++ 3 files changed, 172 insertions(+), 26 deletions(-) diff --git a/R/cond_indirect_effects_math.R b/R/cond_indirect_effects_math.R index 97ca03f9..daa44636 100644 --- a/R/cond_indirect_effects_math.R +++ b/R/cond_indirect_effects_math.R @@ -107,24 +107,43 @@ NULL plusminus <- function(e1, e2, op = c("+", "-")) { op <- match.arg(op, c("+", "-")) check_xy(e1, e2) + # group_number and group_label can be vectors + group_number_1 <- e1$group_number + group_number_2 <- e2$group_number + group_label_1 <- e1$group_label + group_label_2 <- e2$group_label + if (is.numeric(group_number_1) && is.numeric(group_number_2)) { + has_group <- TRUE + group_labels <- c(group_label_1, group_label_2) + } else { + has_group <- FALSE + } cp1 <- if (is.list(e1$components)) e1$components else list(e1$components) cp2 <- if (is.list(e2$components)) e2$components else list(e2$components) cp0 <- c(cp1, cp2) + if (has_group) names(cp0) <- group_labels cpc1 <- if (is.list(e1$components_conditional)) e1$components_conditional else list(e1$components_conditional) cpc2 <- if (is.list(e2$components_conditional)) e2$components_conditional else list(e2$components_conditional) cpc0 <- c(cpc1, cpc2) + if (has_group) names(cpc0) <- group_labels m1 <- if (is.list(e1$m)) e1$m else list(e1$m) m2 <- if (is.list(e2$m)) e2$m else list(e2$m) m0 <- c(m1, m2) + if (has_group) names(m0) <- group_labels cv1 <- if (is.list(e1$computation_values)) e1$computation_values else list(e1$computation_values) cv2 <- if (is.list(e2$computation_values)) e2$computation_values else list(e2$computation_values) cv0 <- c(cv1, cv2) + if (has_group) names(cv0) <- group_labels cs1 <- if (is.list(e1$computation_symbols)) e1$computation_symbols else list(e1$computation_symbols) cs2 <- if (is.list(e2$computation_symbols)) e2$computation_symbols else list(e2$computation_symbols) cs0 <- c(cs1, cs2) + if (has_group) names(cs0) <- group_labels ca1 <- if (is.list(e1$call)) e1$call else list(e1$call) ca2 <- if (is.list(e2$call)) e2$call else list(e2$call) ca0 <- c(ca1, ca2) + if (has_group) names(ca0) <- group_labels + gnumber0 <- c(group_number_1, group_number_2) + glabel0 <- c(group_label_1, group_label_2) est0 <- switch(op, "+" = e1$indirect + e2$indirect, "-" = e1$indirect - e2$indirect) @@ -182,6 +201,10 @@ plusminus <- function(e1, e2, op = c("+", "-")) { paste(eval(e1$m), collapse = "->"), "->", e1$y) } + if (has_group && (length(group_label_1) == 1)) { + op1 <- paste0(group_label_1, "[", + group_number_1, "]: ", op1) + } } if (is.null(op2)) { if (is.null(e2$m)) { @@ -191,6 +214,10 @@ plusminus <- function(e1, e2, op = c("+", "-")) { paste(eval(e2$m), collapse = "->"), "->", e2$y) } + if (has_group && (length(group_label_2) == 1)) { + op2 <- paste0(group_label_2, "[", + group_number_2, "]: ", op2) + } } op0 <- paste0("(", op1, ")", "\n", op, "(", op2, ")") @@ -243,7 +270,9 @@ plusminus <- function(e1, e2, op = c("+", "-")) { mc_scale_y = e1$mc_scale_y, level = level0, boot_out = e1$boot_out, - mc_out = e1$mc_out + mc_out = e1$mc_out, + group_number = gnumber0, + group_label = glabel0 ) class(out) <- c("indirect", class(out)) out @@ -269,6 +298,17 @@ check_xy <- function(e1, e2) { scy1 <- e1$scale_y scx2 <- e2$scale_x scy2 <- e2$scale_y + group1 <- e1$group_number + group2 <- e2$group_number + if (is.numeric(group1) && is.numeric(group2)) { + has_group <- TRUE + } else { + has_group <- FALSE + } + if ((is.null(group1) && is.numeric(group2)) || + (is.null(group2) && is.numeric(group1))) { + stop("The objects do not agree in the number of groups.") + } if (!identical(x1, x2)) { stop("The objects to be added do not have the same 'x'.") } @@ -306,11 +346,13 @@ check_xy <- function(e1, e2) { } } } - if (!identical(scx1, scx2)) { - stop("x is not scaled by the same factor (SD) in the two objects.") - } - if (!identical(scy1, scy2)) { - stop("y is not scaled by the same factor (SD) in the two objects.") + if (!has_group) { + if (!identical(scx1, scx2)) { + stop("x is not scaled by the same factor (SD) in the two objects.") + } + if (!identical(scy1, scy2)) { + stop("y is not scaled by the same factor (SD) in the two objects.") + } } if (!identical(e1$level, e2$level)) { stop("The two objects do not have the same level for confidence interval.") diff --git a/R/print_indirect.R b/R/print_indirect.R index 595fb0bc..cf09c0c7 100644 --- a/R/print_indirect.R +++ b/R/print_indirect.R @@ -199,6 +199,11 @@ print.indirect <- function(x, } else { path <- paste(x0, "->", y0) } + if (has_group) { + path <- paste0(x$group_label, "[", + x$group_number, "]: ", + path) + } std_str <- "" if (standardized) { std_str <- paste0("(Both ", sQuote(x0), @@ -299,10 +304,10 @@ print.indirect <- function(x, if (has_ci) {ptable <- rbind(ptable, b_row, b_row2, b_row3)} } if (has_group) { - ptable <- rbind(ptable, - c("Group Label:", x$group_label)) - ptable <- rbind(ptable, - c("Group Number:", x$group_number)) + # ptable <- rbind(ptable, + # c("Group Label:", x$group_label)) + # ptable <- rbind(ptable, + # c("Group Number:", x$group_number)) } ptable <- data.frame(lapply(ptable, format)) colnames(ptable) <- c("", "") @@ -354,6 +359,13 @@ print.indirect <- function(x, cat(strwrap(tmp1), sep = "\n") } } + print_note <- FALSE + if (standardized_x || + standardized_y || + has_group) { + print_note <- TRUE + } + note_str <- character(0) if (has_m & !is.list(mpathnames)) { if (has_w) { out <- data.frame(mpathnames, m0c, m0) @@ -367,13 +379,6 @@ print.indirect <- function(x, cat("\nCoefficients of Component Paths:") cat("\n") print(out, digits = digits, row.names = FALSE) - print_note <- FALSE - if (standardized_x || - standardized_y || - has_group) { - print_note <- TRUE - } - note_str <- character(0) if (standardized_x || standardized_y) { note_str <- c(note_str, strwrap("- The effects of the component paths are from the model, not standardized.", @@ -384,15 +389,18 @@ print.indirect <- function(x, exdent = 2)) } } - if (has_group) { - note_str <- c(note_str, - strwrap("- The group number is the number used internally in lavaan.", - exdent = 2)) - } - if (length(note_str) > 0) { - cat("\nNOTE:\n") - cat(note_str, sep = "\n") - } + } + if (has_group) { + note_str <- c(note_str, + strwrap("- The group label is printed before each path.", + exdent = 2)) + note_str <- c(note_str, + strwrap("- The group number in square brackets is the number used internally in lavaan.", + exdent = 2)) + } + if (length(note_str) > 0) { + cat("\nNOTE:\n") + cat(note_str, sep = "\n") } invisible(x) } diff --git a/tests/testthat/test_mg_boot.R b/tests/testthat/test_mg_boot.R index 03fa0eaa..13ef1803 100644 --- a/tests/testthat/test_mg_boot.R +++ b/tests/testthat/test_mg_boot.R @@ -266,6 +266,33 @@ test_that("indirect_effect and multigrop", { tmp3_chk * sd_x_3) }) +## Math + +suppressWarnings(tmp3b <- indirect_effect(x = "x", + y = "y", + m = "m3", + fit = fit2, + group = 2, + standardized_y = TRUE)) +suppressWarnings(tmp3c <- indirect_effect(x = "x", + y = "y", + m = "m3", + fit = fit2, + group = 1, + standardized_y = TRUE)) + +tmpmath3a <- tmp3b - tmp3 +tmpmath3b <- tmp3b + tmp3 +tmpmath3c <- tmpmath3b - tmp3c +test_that("indirect_effect and multigrop: Math", { + expect_equal(coef(tmpmath3a), + coef(tmp3b) - coef(tmp3)) + expect_equal(coef(tmpmath3b), + coef(tmp3b) + coef(tmp3)) + expect_equal(coef(tmpmath3c), + coef(tmp3b) + coef(tmp3) - coef(tmp3c)) + }) + # cond_indirect: stdx / stdy suppressWarnings(tmp2 <- cond_indirect(x = "x", @@ -444,6 +471,28 @@ test_that("indirect_effect and multigrop", { tmp4ab) }) +## Math + +suppressWarnings(tmp3b <- indirect_effect(x = "x", + y = "y", + m = "m3", + fit = fit2, + group = 3, + mc_ci = TRUE, + mc_out = fit_mc_out, + standardized_x = TRUE)) + +tmpmath3a <- tmp3b - tmp3 +tmpmath3b <- tmp3b + tmp3 +tmpmath3c <- tmpmath3b + tmpmath3a +test_that("indirect_effect and multigrop, MC: Math", { + expect_equal(coef(tmpmath3a), + coef(tmp3b) - coef(tmp3)) + expect_equal(coef(tmpmath3b), + coef(tmp3b) + coef(tmp3)) + }) + + # cond_indirect, stdx / stdy: mc suppressWarnings(tmp2 <- cond_indirect(x = "x", @@ -573,6 +622,29 @@ test_that("indirect_effect and multigrop", { tolerance = 1e-4) }) +## Math + +suppressWarnings(tmp3b <- indirect_effect(x = "x", + y = "y", + m = "m3", + fit = fit2, + group = 2, + boot_ci = TRUE, + boot_out = fit2_boot_out)) + +tmpmath3a <- tmp3b - tmp3 +tmpmath3b <- tmp3b + tmp3 +test_that("indirect_effect and multigrop, boot: Math", { + expect_equal(coef(tmpmath3a), + coef(tmp3b) - coef(tmp3)) + expect_equal(coef(tmpmath3b), + coef(tmp3b) + coef(tmp3)) + expect_equal(tmpmath3a$boot_indirect, + tmp3b$boot_indirect - tmp3$boot_indirect) + expect_equal(tmpmath3b$boot_indirect, + tmp3b$boot_indirect + tmp3$boot_indirect) + }) + # Indirect with bootstrap: stdx / stdy @@ -628,3 +700,27 @@ test_that("indirect_effect and multigrop", { unname(unlist(est_chk[i, c("ci.lower", "ci.upper")])), tolerance = 1e-4) }) + +## Math + +suppressWarnings(tmp3b <- indirect_effect(x = "x", + y = "y", + m = "m3", + fit = fit2, + group = 1, + boot_ci = TRUE, + boot_out = fit2_boot_out, + standardized_x = TRUE)) + +tmpmath3a <- tmp3b - tmp3 +tmpmath3b <- tmp3b + tmp3 +test_that("indirect_effect and multigrop, boot: Math", { + expect_equal(coef(tmpmath3a), + coef(tmp3b) - coef(tmp3)) + expect_equal(coef(tmpmath3b), + coef(tmp3b) + coef(tmp3)) + expect_equal(tmpmath3a$boot_indirect, + tmp3b$boot_indirect - tmp3$boot_indirect) + expect_equal(tmpmath3b$boot_indirect, + tmp3b$boot_indirect + tmp3$boot_indirect) + }) From 9d9d55aaf7fa6cb28d6437b77b9e10b303d8ad7b Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Fri, 29 Mar 2024 22:42:55 +0800 Subject: [PATCH 23/70] Revise all_indirect_paths for ngroups > 1 Tests passed. --- R/all_indirect_paths.R | 7 ++++++- tests/testthat/test_mg_boot.R | 9 +++++++++ 2 files changed, 15 insertions(+), 1 deletion(-) diff --git a/R/all_indirect_paths.R b/R/all_indirect_paths.R index 49e2a060..0e9a2e0e 100644 --- a/R/all_indirect_paths.R +++ b/R/all_indirect_paths.R @@ -102,9 +102,14 @@ all_indirect_paths <- function(fit = NULL, # Create an adjancey matrix if (identical(fit_type, "lavaan")) { - beta <- lavaan::lavInspect(fit)$beta + tmp <- lavaan::lavInspect(fit, + drop.list.single.group = FALSE) + tmp <- lapply(tmp, function(x) x$beta) + beta <- Reduce(`+`, tmp) } if (identical(fit_type, "lavaan.mi")) { + # TODO: + # Add support for multiple group models. beta <- lavaan::lavInspect(fit)$beta } if (identical(fit_type, "lm")) { diff --git a/tests/testthat/test_mg_boot.R b/tests/testthat/test_mg_boot.R index 13ef1803..20dbcae5 100644 --- a/tests/testthat/test_mg_boot.R +++ b/tests/testthat/test_mg_boot.R @@ -550,6 +550,15 @@ test_that("indirect_effect and multigrop", { tmp4ab) }) +# All direct paths + +test_that("All direct path: Multiple group", { + expect_equal(all_indirect_paths(fit), + all_indirect_paths(fit2), + ignore_attr = TRUE) + }) + + skip("Long tests: Test in interactive sections") # Indirect with bootstrap From 0178b4da5abd512f562f2a74a4b80dd5f010830e Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Fri, 29 Mar 2024 22:53:25 +0800 Subject: [PATCH 24/70] Can selection group when enumerating paths Tests passed --- R/all_indirect_paths.R | 38 ++++++++++++++++++++++++++++++++++++-- 1 file changed, 36 insertions(+), 2 deletions(-) diff --git a/R/all_indirect_paths.R b/R/all_indirect_paths.R index 0e9a2e0e..5350791a 100644 --- a/R/all_indirect_paths.R +++ b/R/all_indirect_paths.R @@ -49,6 +49,19 @@ #' @param all_paths An `all_paths`-class object. For example, #' the output of [all_indirect_paths()]. #' +#' @param group Either the group number +#' as appeared in the [summary()] +#' or [lavaan::parameterEstimates()] +#' output of an `lavaan`-class object, +#' or the group label as used in +#' the `lavaan`-class object. +#' Used only when the number of +#' groups is greater than one. Default +#' is NULL. If not specified by the model +#' has more than one group, than paths +#' that appears in at least one group +#' will be included in the output. +#' #' @author Shu Fai Cheung #' #' @seealso [indirect_effect()], [lm2list()]. @@ -94,7 +107,8 @@ all_indirect_paths <- function(fit = NULL, exclude = NULL, x = NULL, - y = NULL) { + y = NULL, + group = NULL) { fit_type <- cond_indirect_check_fit(fit) if (is.na(fit_type)) { stop("'fit' is not of a supported type.") @@ -102,10 +116,30 @@ all_indirect_paths <- function(fit = NULL, # Create an adjancey matrix if (identical(fit_type, "lavaan")) { + + ngroups <- lavaan::lavTech(fit, "ngroups") + if ((ngroups > 1) && !is.null(group)) { + group_labels_all <- lavaan::lavTech(fit, + "group.label") + if (is.numeric(group)) { + group_label <- group_labels_all[group] + group_number <- group + } else { + group_number <- match(group, group_labels_all) + group_label <- group + } + } else { + group_number <- NULL + group_label <- NULL + } tmp <- lavaan::lavInspect(fit, drop.list.single.group = FALSE) tmp <- lapply(tmp, function(x) x$beta) - beta <- Reduce(`+`, tmp) + if (is.null(group_number)) { + beta <- Reduce(`+`, tmp) + } else { + beta <- tmp[[group_number]] + } } if (identical(fit_type, "lavaan.mi")) { # TODO: From d8f0191edac5aa7c25994124da54f073942b0d6d Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Fri, 29 Mar 2024 23:43:21 +0800 Subject: [PATCH 25/70] Can enumerate path in one group tests passed --- R/all_indirect_paths.R | 89 +++++++++++++++++++++++++++++------ tests/testthat/test_mg_boot.R | 3 ++ 2 files changed, 78 insertions(+), 14 deletions(-) diff --git a/R/all_indirect_paths.R b/R/all_indirect_paths.R index 5350791a..e340a866 100644 --- a/R/all_indirect_paths.R +++ b/R/all_indirect_paths.R @@ -113,6 +113,9 @@ all_indirect_paths <- function(fit = NULL, if (is.na(fit_type)) { stop("'fit' is not of a supported type.") } + ngroups <- 1 + group_number <- NULL + group_label <- NULL # Create an adjancey matrix if (identical(fit_type, "lavaan")) { @@ -128,31 +131,91 @@ all_indirect_paths <- function(fit = NULL, group_number <- match(group, group_labels_all) group_label <- group } - } else { - group_number <- NULL - group_label <- NULL } tmp <- lavaan::lavInspect(fit, drop.list.single.group = FALSE) tmp <- lapply(tmp, function(x) x$beta) - if (is.null(group_number)) { - beta <- Reduce(`+`, tmp) - } else { - beta <- tmp[[group_number]] - } + beta <- tmp } if (identical(fit_type, "lavaan.mi")) { # TODO: # Add support for multiple group models. - beta <- lavaan::lavInspect(fit)$beta + beta <- list(lavaan::lavInspect(fit)$beta) } if (identical(fit_type, "lm")) { - beta <- beta_from_lm(fit) + beta <- list(beta_from_lm(fit)) } - adj <- beta + if ((ngroups > 1) && + (identical(fit_type, "lavaan"))) { + group_labels_all <- lavaan::lavTech(fit, + "group.label") + if (is.null(group)) { + groups <- group_labels_all + group_numbers <- seq_len(ngroups) + } else { + beta <- beta[group_number] + groups <- group + group_numbers <- group_number + group_labels_all <- group_labels_all[group_number] + } + tmpfct <- function(adj_i, + group_i, + group_label_i, + group_number_i, + exclude = exclude, + x = x, + y = y, + fit = fit, + fit_type = fit_type) { + out <- all_indirect_paths_i(adj = adj_i, + exclude = exclude, + x = x, + y = y, + fit = fit, + fit_type = fit_type) + for (i in seq_along(out)) { + out[[i]]$group_label <- group_label_i + out[[i]]$group_number <- group_number_i + } + out + } + out3 <- mapply(tmpfct, + adj_i = beta, + group_i = groups, + group_label_i = group_labels_all, + group_number_i = group_numbers, + MoreArgs = list(exclude = exclude, + x = x, + y = y, + fit = fit, + fit_type = fit_type), + SIMPLIFY = FALSE) + out3 <- unlist(out3, + recursive = FALSE) + } else { + out3 <- all_indirect_paths_i(adj = beta[[1]], + exclude = exclude, + x = x, + y = y, + fit = fit, + fit_type = fit_type) + } + + class(out3) <- c("all_paths", class(out3)) + attr(out3, "call") <- match.call() + out3 + } + +#' @noRd + +all_indirect_paths_i <- function(adj, + exclude = NULL, + x = NULL, + y = NULL, + fit = NULL, + fit_type = NULL) { adj[adj > 0] <- 1 adj <- t(adj) - # Remove excluded variables if (is.character(exclude)) { adj <- adj[!(rownames(adj) %in% exclude), @@ -209,8 +272,6 @@ all_indirect_paths <- function(fit = NULL, # Format the output out3 <- lapply(out2, to_x_y_m) names(out3) <- sapply(out3, path_name) - class(out3) <- c("all_paths", class(out3)) - attr(out3, "call") <- match.call() out3 } diff --git a/tests/testthat/test_mg_boot.R b/tests/testthat/test_mg_boot.R index 20dbcae5..ce02dab2 100644 --- a/tests/testthat/test_mg_boot.R +++ b/tests/testthat/test_mg_boot.R @@ -556,6 +556,9 @@ test_that("All direct path: Multiple group", { expect_equal(all_indirect_paths(fit), all_indirect_paths(fit2), ignore_attr = TRUE) + expect_equal(all_indirect_paths(fit, group = 2), + all_indirect_paths(fit2, group = "gp1"), + ignore_attr = TRUE) }) From 7b0971f0bebb4982aa5d5ccb40f1bcea58070831 Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Fri, 29 Mar 2024 23:47:46 +0800 Subject: [PATCH 26/70] Update test_mg_boot.R --- tests/testthat/test_mg_boot.R | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/tests/testthat/test_mg_boot.R b/tests/testthat/test_mg_boot.R index ce02dab2..8b9463ac 100644 --- a/tests/testthat/test_mg_boot.R +++ b/tests/testthat/test_mg_boot.R @@ -552,6 +552,16 @@ test_that("indirect_effect and multigrop", { # All direct paths +mod_tmp <- +" +m3 ~ c(NA, 0, NA)*m1 +y ~ m3 +" + +fit_tmp <- sem(mod_tmp, dat, meanstructure = TRUE, fixed.x = FALSE, + group = "gp", + group.label = c("gp3", "gp1", "gp2")) + test_that("All direct path: Multiple group", { expect_equal(all_indirect_paths(fit), all_indirect_paths(fit2), @@ -559,6 +569,7 @@ test_that("All direct path: Multiple group", { expect_equal(all_indirect_paths(fit, group = 2), all_indirect_paths(fit2, group = "gp1"), ignore_attr = TRUE) + expect_true(length(all_indirect_paths(fit_tmp, group = 2)) == 0) }) From 6daf7165093c65561d238e6e753fdbaa544ef32b Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Sat, 30 Mar 2024 00:01:15 +0800 Subject: [PATCH 27/70] Store group info in all_paths_to_df Tests passed --- R/all_indirect_paths.R | 6 ++++++ tests/testthat/test_mg_boot.R | 16 ++++++++++++++++ 2 files changed, 22 insertions(+) diff --git a/R/all_indirect_paths.R b/R/all_indirect_paths.R index e340a866..e622d70c 100644 --- a/R/all_indirect_paths.R +++ b/R/all_indirect_paths.R @@ -288,9 +288,15 @@ all_paths_to_df <- function(all_paths) { all_y <- sapply(all_paths, function(x) x$y) all_m <- sapply(all_paths, function(x) x$m, simplify = FALSE) + all_group_label <- sapply(all_paths, function(x) x$group_label) + all_group_number <- sapply(all_paths, function(x) x$group_number) out <- data.frame(x = all_x, y = all_y) out$m <- all_m + if (!any(sapply(all_group_label, is.null))) { + out$group_label <- all_group_label + out$group_number <- all_group_number + } out } diff --git a/tests/testthat/test_mg_boot.R b/tests/testthat/test_mg_boot.R index 8b9463ac..0cb00afe 100644 --- a/tests/testthat/test_mg_boot.R +++ b/tests/testthat/test_mg_boot.R @@ -572,6 +572,22 @@ test_that("All direct path: Multiple group", { expect_true(length(all_indirect_paths(fit_tmp, group = 2)) == 0) }) +# Many direct path + +mod_tmp <- +" +m3 ~ c(NA, 0, NA)*m1 + c(NA, NA, 0)*x +m2 ~ c(0, 0, NA)*m1 + c(NA, NA, 0)*x +w3 ~ c(NA, 0, 0)*m2 +y ~ c(NA, 0, NA)*m3 + w3 +" + +fit_tmp <- sem(mod_tmp, dat, meanstructure = TRUE, fixed.x = FALSE, + group = "gp", + group.label = c("gp3", "gp1", "gp2")) + +all_tmp <- all_indirect_paths(fit_tmp) +all_paths_to_df(all_tmp) skip("Long tests: Test in interactive sections") From 3ab4495249e9004c92f7593f37a318e5fba02be5 Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Sat, 30 Mar 2024 00:08:14 +0800 Subject: [PATCH 28/70] many_indirect can work with ngroups > 1 --- R/cond_indirect.R | 22 ++++++++++++++++------ tests/testthat/test_mg_boot.R | 13 ++++++++++++- 2 files changed, 28 insertions(+), 7 deletions(-) diff --git a/R/cond_indirect.R b/R/cond_indirect.R index b23ec04a..2fbd66b1 100644 --- a/R/cond_indirect.R +++ b/R/cond_indirect.R @@ -1083,12 +1083,22 @@ cond_indirect_effects <- function(wlevels, many_indirect_effects <- function(paths, ...) { path_names <- names(paths) xym <- all_paths_to_df(paths) - out <- mapply(indirect_effect, - x = xym$x, - y = xym$y, - m = xym$m, - MoreArgs = list(...), - SIMPLIFY = FALSE) + if ("group_label" %in% colnames(xym)) { + out <- mapply(indirect_effect, + x = xym$x, + y = xym$y, + m = xym$m, + group = xym$group_number, + MoreArgs = list(...), + SIMPLIFY = FALSE) + } else { + out <- mapply(indirect_effect, + x = xym$x, + y = xym$y, + m = xym$m, + MoreArgs = list(...), + SIMPLIFY = FALSE) + } names(out) <- path_names class(out) <- c("indirect_list", class(out)) attr(out, "paths") <- paths diff --git a/tests/testthat/test_mg_boot.R b/tests/testthat/test_mg_boot.R index 0cb00afe..fa826b4a 100644 --- a/tests/testthat/test_mg_boot.R +++ b/tests/testthat/test_mg_boot.R @@ -587,7 +587,18 @@ fit_tmp <- sem(mod_tmp, dat, meanstructure = TRUE, fixed.x = FALSE, group.label = c("gp3", "gp1", "gp2")) all_tmp <- all_indirect_paths(fit_tmp) -all_paths_to_df(all_tmp) +all_paths <- all_paths_to_df(all_tmp) +all_ind <- many_indirect_effects(all_tmp, fit = fit_tmp) +ind_chk <- indirect_effect(x = "x", + y = "w3", + m = "m2", + fit = fit_tmp, + group = "gp3") + +test_that("many_indirect: multiple group", { + expect_equal(coef(all_ind[[3]]), + coef(ind_chk)) + }) skip("Long tests: Test in interactive sections") From 41a532c53255393c89dcb368c1eab49450cc802c Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Sat, 30 Mar 2024 00:36:28 +0800 Subject: [PATCH 29/70] Update all_indirect_paths.Rd --- man/all_indirect_paths.Rd | 21 ++++++++++++++++++++- 1 file changed, 20 insertions(+), 1 deletion(-) diff --git a/man/all_indirect_paths.Rd b/man/all_indirect_paths.Rd index ad3c30cf..4d113670 100644 --- a/man/all_indirect_paths.Rd +++ b/man/all_indirect_paths.Rd @@ -5,7 +5,13 @@ \alias{all_paths_to_df} \title{Enumerate All Indirect Effects in a Model} \usage{ -all_indirect_paths(fit = NULL, exclude = NULL, x = NULL, y = NULL) +all_indirect_paths( + fit = NULL, + exclude = NULL, + x = NULL, + y = NULL, + group = NULL +) all_paths_to_df(all_paths) } @@ -36,6 +42,19 @@ the outcome variables in at least one regression equation will be included in the search.} +\item{group}{Either the group number +as appeared in the \code{\link[=summary]{summary()}} +or \code{\link[lavaan:parameterEstimates]{lavaan::parameterEstimates()}} +output of an \code{lavaan}-class object, +or the group label as used in +the \code{lavaan}-class object. +Used only when the number of +groups is greater than one. Default +is NULL. If not specified by the model +has more than one group, than paths +that appears in at least one group +will be included in the output.} + \item{all_paths}{An \code{all_paths}-class object. For example, the output of \code{\link[=all_indirect_paths]{all_indirect_paths()}}.} } From 388f4788b8814eddb9a35dae15b50368ddfd10f6 Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Sat, 30 Mar 2024 10:02:13 +0800 Subject: [PATCH 30/70] Add a helper for group labels --- R/lavaan_helpers.R | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) diff --git a/R/lavaan_helpers.R b/R/lavaan_helpers.R index 42220647..f1efab40 100644 --- a/R/lavaan_helpers.R +++ b/R/lavaan_helpers.R @@ -212,4 +212,31 @@ implied_stats_group_i <- function(object, } }) out + } + +#' @noRd + +group_labels_and_numbers <- function(groups, + fit) { + if (!inherits(fit, "lavaan")) { + stop("The argument 'fit' must be a lavaan object.") + } + group_labels_all <- lavaan::lavInspect(fit, "group.label") + group_numbers_all <- seq_len(lavaan::lavInspect(fit, "ngroups")) + if (is.numeric(groups)) { + if (!all(groups %in% group_numbers_all)) { + stop("Group numbers not among the numbers in the fit object.") + } + group_numbers <- groups + group_labels <- group_labels_all[group_numbers] + } + if (is.character(groups)) { + if (!all(groups %in% group_labels_all)) { + stop("Group label(s) not among the labels in the fit object.") + } + group_labels <- groups + group_numbers <- match(groups, group_labels_all) + } + list(label = group_labels, + number = group_numbers) } \ No newline at end of file From 734c712cf04676d9fdac152a902d830b45f7c988 Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Sat, 30 Mar 2024 10:08:54 +0800 Subject: [PATCH 31/70] Update group_labels_and_numbers --- R/lavaan_helpers.R | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/R/lavaan_helpers.R b/R/lavaan_helpers.R index f1efab40..01fc8869 100644 --- a/R/lavaan_helpers.R +++ b/R/lavaan_helpers.R @@ -216,13 +216,18 @@ implied_stats_group_i <- function(object, #' @noRd -group_labels_and_numbers <- function(groups, +group_labels_and_numbers <- function(groups = NULL, fit) { if (!inherits(fit, "lavaan")) { stop("The argument 'fit' must be a lavaan object.") } group_labels_all <- lavaan::lavInspect(fit, "group.label") group_numbers_all <- seq_len(lavaan::lavInspect(fit, "ngroups")) + if (is.null(groups)) { + out <- list(label = group_labels_all, + number = group_numbers_all) + return(out) + } if (is.numeric(groups)) { if (!all(groups %in% group_numbers_all)) { stop("Group numbers not among the numbers in the fit object.") From 6f018b2325554e5bb88fca5a177b3c86cf35968b Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Sat, 30 Mar 2024 10:19:50 +0800 Subject: [PATCH 32/70] Support using group as a moderator in multiple-group models Tests passed --- R/cond_indirect.R | 389 ++++++++++++++++++++++++++++++++++++---------- 1 file changed, 305 insertions(+), 84 deletions(-) diff --git a/R/cond_indirect.R b/R/cond_indirect.R index 2fbd66b1..d879229c 100644 --- a/R/cond_indirect.R +++ b/R/cond_indirect.R @@ -704,6 +704,7 @@ indirect_effect <- function(x, make_cluster_args = list(), progress = TRUE, save_boot_full = FALSE, + save_boot_out = TRUE, mc_ci = FALSE, mc_out = NULL, save_mc_full = FALSE, @@ -731,6 +732,7 @@ indirect_effect <- function(x, make_cluster_args = make_cluster_args, progress = progress, save_boot_full = save_boot_full, + save_boot_out = save_boot_out, mc_ci = mc_ci, mc_out = mc_out, save_mc_full = save_mc_full, @@ -839,8 +841,31 @@ cond_indirect_effects <- function(wlevels, mc_out = NULL, ci_out = NULL, ci_type = NULL, + groups = NULL, ...) { + # Check the number of groups and handle multiple-group models + has_group <- FALSE + ngroups <- 1 + group_numbers <- NULL + group_labels <- NULL + if (inherits(fit, "lavaan")) { + ngroups <- lavaan::lavTech(fit, "ngroups") + if (ngroups > 1) { + has_group <- TRUE + tmp <- group_labels_and_numbers(groups = groups, + fit = fit) + group_numbers <- tmp$number + group_labels <- tmp$label + } else { + if (!is.null(groups)) { + stop("The model has only one group but 'groups' is set.") + } + } + } + # Check and process the levels of moderators + has_wlevels <- FALSE if (!missing(wlevels)) { + has_wlevels <- TRUE wlevels_check <- check_wlevels(wlevels) if (!is.null(wlevels_check)) { wlevels <- wlevels_check @@ -862,12 +887,21 @@ cond_indirect_effects <- function(wlevels, } } else { - stop("wlevels is required.") + wlevels <- NULL + if (!has_group) { + stop("wlevels is required for single-group models.") + } + } + if (has_group && has_wlevels) { + stop("Multiple group models with moderators not yet supported.", + "Will be supported soon.") + } + if (has_wlevels) { + k <- nrow(wlevels) + wlevels1 <- split(wlevels, seq_len(k)) + wlevels2 <- lapply(wlevels1, unlist) + names(wlevels2) <- rownames(wlevels) } - k <- nrow(wlevels) - wlevels1 <- split(wlevels, seq_len(k)) - wlevels2 <- lapply(wlevels1, unlist) - names(wlevels2) <- rownames(wlevels) fit_type <- cond_indirect_check_fit(fit) if ((fit_type == "lm") && !inherits(fit, "lm_list") && is.list(fit)) { @@ -946,78 +980,245 @@ cond_indirect_effects <- function(wlevels, progress = progress) } } - prods <- cond_indirect(wvalues = wlevels2[[1]], - x = x, - y = y, - m = m, - fit = fit, - est = est, - implied_stats = implied_stats, - get_prods_only = TRUE, - ...) - out <- lapply(wlevels2, - function(wv, - x, - y, - m, - fit, - est, - implied_stats, - boot_ci, - boot_out, - R, - seed, - prods, - save_boot_out, - mc_ci, - mc_out, - save_mc_out, - ci_type, - ci_out, - save_ci_out, - ...) { - cond_indirect(wvalues = wv, - x = x, - y = y, - m = m, - fit = fit, - est = est, - implied_stats = implied_stats, - boot_ci = boot_ci, - boot_out = boot_out, - R = R, - seed = seed, - prods = prods, - save_boot_out = FALSE, - mc_ci = mc_ci, - mc_out = mc_out, - save_mc_out = FALSE, - ci_type = ci_type, - ci_out = ci_out, - save_ci_out = FALSE, - ...) - }, - x = x, - y = y, - m = m, - fit = fit, - est = est, - implied_stats = implied_stats, - boot_ci = boot_ci, - boot_out = boot_out, - R = R, - seed = seed, - prods = prods, - save_boot_out = FALSE, - mc_ci = mc_ci, - mc_out = mc_out, - save_mc_out = FALSE, - ci_type = ci_type, - ci_out = ci_out, - save_ci_out = FALSE, - ...) + # TODO: + # Revise cond_indirect and friends such that + # no need to have three very similar blocks. + if (has_wlevels && !has_group) { + prods <- cond_indirect(wvalues = wlevels2[[1]], + x = x, + y = y, + m = m, + fit = fit, + est = est, + implied_stats = implied_stats, + get_prods_only = TRUE, + ...) + } + if (!has_wlevels && has_group) { + prods <- cond_indirect(x = x, + y = y, + m = m, + fit = fit, + est = est, + implied_stats = implied_stats, + get_prods_only = TRUE, + group = 1, + ...) + } + if (has_wlevels && has_group) { + prods <- cond_indirect(wvalues = wlevels2[[1]], + x = x, + y = y, + m = m, + fit = fit, + est = est, + implied_stats = implied_stats, + get_prods_only = TRUE, + group = 1, + ...) + } + # TODO: + # Revise cond_indirect and friends such that + # no need to have three very similar blocks. + if (has_wlevels && !has_group) { + out <- lapply(wlevels2, + function(wv, + x, + y, + m, + fit, + est, + implied_stats, + boot_ci, + boot_out, + R, + seed, + prods, + save_boot_out, + mc_ci, + mc_out, + save_mc_out, + ci_type, + ci_out, + save_ci_out, + ...) { + cond_indirect(wvalues = wv, + x = x, + y = y, + m = m, + fit = fit, + est = est, + implied_stats = implied_stats, + boot_ci = boot_ci, + boot_out = boot_out, + R = R, + seed = seed, + prods = prods, + save_boot_out = FALSE, + mc_ci = mc_ci, + mc_out = mc_out, + save_mc_out = FALSE, + ci_type = ci_type, + ci_out = ci_out, + save_ci_out = FALSE, + ...) + }, + x = x, + y = y, + m = m, + fit = fit, + est = est, + implied_stats = implied_stats, + boot_ci = boot_ci, + boot_out = boot_out, + R = R, + seed = seed, + prods = prods, + save_boot_out = FALSE, + mc_ci = mc_ci, + mc_out = mc_out, + save_mc_out = FALSE, + ci_type = ci_type, + ci_out = ci_out, + save_ci_out = FALSE, + ...) + } + if (!has_wlevels && has_group) { + out <- lapply(group_numbers, + function(gn, + x, + y, + m, + fit, + est, + implied_stats, + boot_ci, + boot_out, + R, + seed, + prods, + save_boot_out, + mc_ci, + mc_out, + save_mc_out, + ci_type, + ci_out, + save_ci_out, + ...) { + indirect_effect(x = x, + y = y, + m = m, + fit = fit, + est = est, + implied_stats = implied_stats, + boot_ci = boot_ci, + boot_out = boot_out, + R = R, + seed = seed, + save_boot_out = FALSE, + mc_ci = mc_ci, + mc_out = mc_out, + save_mc_out = FALSE, + ci_type = ci_type, + ci_out = ci_out, + save_ci_out = FALSE, + group = gn, + ...) + }, + x = x, + y = y, + m = m, + fit = fit, + est = est, + implied_stats = implied_stats, + boot_ci = boot_ci, + boot_out = boot_out, + R = R, + seed = seed, + save_boot_out = FALSE, + mc_ci = mc_ci, + mc_out = mc_out, + save_mc_out = FALSE, + ci_type = ci_type, + ci_out = ci_out, + save_ci_out = FALSE, + ...) + } + if (has_wlevels && has_group) { + # TODO + # - Not yet supported. + # - Need to use expand.grid to create + # all combinations of group and wlevels + out <- mapply(function(gn, + wv, + x, + y, + m, + fit, + est, + implied_stats, + boot_ci, + boot_out, + R, + seed, + prods, + save_boot_out, + mc_ci, + mc_out, + save_mc_out, + ci_type, + ci_out, + save_ci_out, + ...) { + cond_indirect(wvalues = wv, + x = x, + y = y, + m = m, + fit = fit, + est = est, + implied_stats = implied_stats, + boot_ci = boot_ci, + boot_out = boot_out, + R = R, + seed = seed, + prods = prods, + save_boot_out = FALSE, + mc_ci = mc_ci, + mc_out = mc_out, + save_mc_out = FALSE, + ci_type = ci_type, + ci_out = ci_out, + save_ci_out = FALSE, + group = gn, + ...) + }, + gn = group_numbers_long, + wv = wlevels2_long, + x = x, + y = y, + m = m, + fit = fit, + est = est, + implied_stats = implied_stats, + boot_ci = boot_ci, + boot_out = boot_out, + R = R, + seed = seed, + prods = prods, + save_boot_out = FALSE, + mc_ci = mc_ci, + mc_out = mc_out, + save_mc_out = FALSE, + ci_type = ci_type, + ci_out = ci_out, + save_ci_out = FALSE, + ...) + } if (output_type == "data.frame") { - out1 <- cond_indirect_effects_to_df(out, wlevels = wlevels) + out1 <- cond_indirect_effects_to_df(out, + wlevels = wlevels, + group_numbers = group_numbers, + group_labels = group_labels) class(out1) <- c("cond_indirect_effects", class(out1)) attr(out1, "call") <- match.call() attr(out1, "full_output") <- out @@ -1031,6 +1232,8 @@ cond_indirect_effects <- function(wlevels, attr(out1, "x") <- x attr(out1, "y") <- y attr(out1, "m") <- m + # TODO: + # - Store the expanded combination of group and wlevels return(out1) } else { return(out) @@ -1136,12 +1339,25 @@ cond_indirect_check_fit <- function(fit) { # information on the levels of moderators. #' @noRd -cond_indirect_effects_to_df <- function(x, wlevels) { - k <- nrow(wlevels) - wlevels_label <- attr(wlevels, "wlevels") - colnames(wlevels_label) <- paste0("[", colnames(wlevels_label), "]") - wlevels2 <- wlevels - colnames(wlevels2) <- paste0("(", colnames(wlevels2), ")") +cond_indirect_effects_to_df <- function(x, + wlevels = NULL, + group_numbers = NULL, + group_labels = NULL) { + has_wlevels <- !is.null(wlevels) + has_group <- !is.null(group_numbers) || !is.null(group_labels) + if (has_wlevels) { + # TOFIX + wlevels_label <- attr(wlevels, "wlevels") + colnames(wlevels_label) <- paste0("[", colnames(wlevels_label), "]") + wlevels2 <- wlevels + colnames(wlevels2) <- paste0("(", colnames(wlevels2), ")") + } + if (has_group) { + group_numbers <- sapply(x, function(x) x$group_number) + group_labels <- sapply(x, function(x) x$group_label) + gp_df <- data.frame(Group = group_labels, + Group_ID = group_numbers) + } standardized_x <- x[[1]]$standardized_x standardized_y <- x[[1]]$standardized_y if (standardized_x || standardized_y) { @@ -1193,8 +1409,13 @@ cond_indirect_effects_to_df <- function(x, wlevels) { out <- data.frame(std = indirect_std, cc, ustd = indirect, check.names = FALSE) } } - out1 <- cbind(wlevels_label, wlevels2, out) - out1 + if (has_wlevels) { + out <- cbind(wlevels_label, wlevels2, out) + } + if (has_group) { + out <- cbind(gp_df, out) + } + out } # Check the argument `wlevels` and convert it to a valid data From c9120691297e8fa6ffd09213cfd1beff22559d87 Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Sat, 30 Mar 2024 10:20:10 +0800 Subject: [PATCH 33/70] Update doc --- man/cond_indirect.Rd | 2 ++ 1 file changed, 2 insertions(+) diff --git a/man/cond_indirect.Rd b/man/cond_indirect.Rd index 2bd28fca..947c4237 100644 --- a/man/cond_indirect.Rd +++ b/man/cond_indirect.Rd @@ -68,6 +68,7 @@ cond_indirect_effects( mc_out = NULL, ci_out = NULL, ci_type = NULL, + groups = NULL, ... ) @@ -90,6 +91,7 @@ indirect_effect( make_cluster_args = list(), progress = TRUE, save_boot_full = FALSE, + save_boot_out = TRUE, mc_ci = FALSE, mc_out = NULL, save_mc_full = FALSE, From 729114fbd8f1975f863b1f5d0682f155ebf5c6aa Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Sat, 30 Mar 2024 10:40:34 +0800 Subject: [PATCH 34/70] Fix an issue with R CMD check --- R/cond_indirect.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/R/cond_indirect.R b/R/cond_indirect.R index d879229c..8da85ab2 100644 --- a/R/cond_indirect.R +++ b/R/cond_indirect.R @@ -1149,6 +1149,8 @@ cond_indirect_effects <- function(wlevels, # - Not yet supported. # - Need to use expand.grid to create # all combinations of group and wlevels + group_numbers_long <- NULL + wlevels2_long <- NULL out <- mapply(function(gn, wv, x, From 81a73cbebb886eb8b86226155f9ffef79059999d Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Sat, 30 Mar 2024 10:45:05 +0800 Subject: [PATCH 35/70] Update doc --- R/cond_indirect.R | 11 +++++++++++ man/cond_indirect.Rd | 11 +++++++++++ 2 files changed, 22 insertions(+) diff --git a/R/cond_indirect.R b/R/cond_indirect.R index 8da85ab2..c5252e32 100644 --- a/R/cond_indirect.R +++ b/R/cond_indirect.R @@ -377,6 +377,17 @@ #' groups is greater than one. Default #' is NULL. #' +#' @param groups Either a vector of +#' group numbers +#' as appeared in the [summary()] +#' or [lavaan::parameterEstimates()] +#' output of an `lavaan`-class object, +#' or a vector of group labels as used in +#' the `lavaan`-class object. +#' Used only when the number of +#' groups is greater than one. Default +#' is NULL. +#' #' @seealso [mod_levels()] and #' [merge_mod_levels()] for generating #' levels of moderators. [do_boot] for diff --git a/man/cond_indirect.Rd b/man/cond_indirect.Rd index 947c4237..538301e5 100644 --- a/man/cond_indirect.Rd +++ b/man/cond_indirect.Rd @@ -397,6 +397,17 @@ output is a list of the outputs from for creating the levels of moderators. Default is \code{list()}.} +\item{groups}{Either a vector of +group numbers +as appeared in the \code{\link[=summary]{summary()}} +or \code{\link[lavaan:parameterEstimates]{lavaan::parameterEstimates()}} +output of an \code{lavaan}-class object, +or a vector of group labels as used in +the \code{lavaan}-class object. +Used only when the number of +groups is greater than one. Default +is NULL.} + \item{...}{For \code{\link[=many_indirect_effects]{many_indirect_effects()}}, these are arguments to be passed to \code{\link[=indirect_effect]{indirect_effect()}}.} From c030c2366fc2f06f87effea6396af4cbceba1605 Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Sat, 30 Mar 2024 10:45:13 +0800 Subject: [PATCH 36/70] Add tests for cond_indirect_effects Tests passed --- tests/testthat/test_mg_boot.R | 82 +++++++++++++++++++++++++++++++++++ 1 file changed, 82 insertions(+) diff --git a/tests/testthat/test_mg_boot.R b/tests/testthat/test_mg_boot.R index fa826b4a..30916449 100644 --- a/tests/testthat/test_mg_boot.R +++ b/tests/testthat/test_mg_boot.R @@ -51,6 +51,13 @@ m3 ~ m1 + x y ~ m2 + m3 + x + w4 + xw4 + w3 + m3w3 + m3w4 " +mod_med <- +" +m1 ~ x +m2 ~ m1 +y ~ m2 + x +" + # Check against lavaan @@ -600,6 +607,81 @@ test_that("many_indirect: multiple group", { coef(ind_chk)) }) +# Mediation only + +fit_med <- sem(mod_med, dat, meanstructure = TRUE, fixed.x = FALSE, + group = "gp", + group.label = c("gp3", "gp1", "gp2")) + +tmp1 <- cond_indirect_effects(x = "x", + y = "y", + m = c("m1", "m2"), + fit = fit_med) +tmp1_chk1 <- indirect_effect(x = "x", + y = "y", + m = c("m1", "m2"), + fit = fit_med, + group = 1) +tmp1_chk2 <- indirect_effect(x = "x", + y = "y", + m = c("m1", "m2"), + fit = fit_med, + group = 2) +tmp1_chk3 <- indirect_effect(x = "x", + y = "y", + m = c("m1", "m2"), + fit = fit_med, + group = 3) + +tmp2 <- cond_indirect_effects(x = "x", + y = "y", + m = c("m1", "m2"), + fit = fit_med, + groups = c(2, 1)) + +tmp3 <- cond_indirect_effects(x = "x", + y = "y", + m = c("m1", "m2"), + fit = fit_med, + groups = c("gp1", "gp3")) + +test_that("cond_indirect_effects for multiple group", { + expect_equal(coef(tmp1), + unname(c(coef(tmp1_chk1), + coef(tmp1_chk2), + coef(tmp1_chk3)))) + expect_equal(coef(tmp2), + unname(c(coef(tmp1_chk2), + coef(tmp1_chk1)))) + expect_equal(coef(tmp3), + unname(c(coef(tmp1_chk2), + coef(tmp1_chk1)))) + expect_error(tmp2 <- cond_indirect_effects(x = "x", + y = "y", + m = c("m1", "m2"), + fit = fit_med, + groups = c(10, 20))) + }) + + + +# Group labels helpers + +chk1 <- lavTech(fit2, "group.label") +test_that("group labels helpers", { + expect_equal(group_labels_and_numbers(c(3, 1), fit2)$label, + chk1[c(3, 1)]) + expect_equal(group_labels_and_numbers(c("gp1", "gp3"), fit2)$number, + c(2, 1)) + expect_error(group_labels_and_numbers(c("gp5", "gp3"), fit2)) + expect_error(group_labels_and_numbers(10, fit2)) + expect_error(group_labels_and_numbers(1:2, "test")) + expect_equal(group_labels_and_numbers(fit = fit2)$label, + chk1) + expect_equal(group_labels_and_numbers(fit = fit2)$number, + seq_along(chk1)) + }) + skip("Long tests: Test in interactive sections") # Indirect with bootstrap From 6d7c991fdb900f60edad817ee75d0f8deeff4539 Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Sat, 30 Mar 2024 14:56:24 +0800 Subject: [PATCH 37/70] Update print.cond_indirect_effects() to support ngroups > 1 Tests passed --- R/print_cond_indirect_effect.R | 42 +++++++++++++++++++++++++++++----- tests/testthat/test_mg_boot.R | 24 +++++++++++++++++++ 2 files changed, 60 insertions(+), 6 deletions(-) diff --git a/R/print_cond_indirect_effect.R b/R/print_cond_indirect_effect.R index e32f34d6..e822fb97 100644 --- a/R/print_cond_indirect_effect.R +++ b/R/print_cond_indirect_effect.R @@ -107,6 +107,8 @@ print.cond_indirect_effects <- function(x, digits = 3, pvalue_digits = 3, se = FALSE, ...) { + # TODO: + # - Support cases with both moderators and groups. full_output <- attr(x, "full_output") x_i <- full_output[[1]] my_call <- attr(x, "call") @@ -114,6 +116,15 @@ print.cond_indirect_effects <- function(x, digits = 3, boot_ci <- !is.null(x_i$boot_ci) has_ci <- FALSE ci_type <- NULL + has_groups <- ("group" %in% tolower(colnames(x))) + if (has_groups) { + group_labels <- unique(x$Group) + group_numbers <- unique(x$Group_ID) + } else { + group_labels <- NULL + group_numbers <- NULL + } + has_wlevels <- !is.null(attr(x, "wlevels")) if (!is.null(x_i$boot_ci)) { has_ci <- TRUE ci_type <- "boot" @@ -178,9 +189,15 @@ print.cond_indirect_effects <- function(x, digits = 3, } } out1 <- data.frame(out, check.names = FALSE) - wlevels <- attr(x, "wlevels") - w0 <- colnames(attr(wlevels, "wlevels")) - w1 <- colnames(wlevels) + if (has_wlevels) { + wlevels <- attr(x, "wlevels") + w0 <- colnames(attr(wlevels, "wlevels")) + w1 <- colnames(wlevels) + } else { + wlevels <- NULL + w0 <- NULL + w1 <- NULL + } mcond <- names(x_i$components) cond_str <- "" cond_str2 <- "" @@ -194,8 +211,15 @@ print.cond_indirect_effects <- function(x, digits = 3, cat("\n== Conditional effects ==\n") } cat("\n Path:", path) - cat("\n Conditional on moderator(s):", paste0(w0, collapse = ", ")) - cat("\n Moderator(s) represented by:", paste0(w1, collapse = ", ")) + if (has_wlevels) { + cat("\n Conditional on moderator(s):", paste0(w0, collapse = ", ")) + cat("\n Moderator(s) represented by:", paste0(w1, collapse = ", ")) + } + if (has_groups) { + tmp <- paste0(group_labels, "[", group_numbers, "]", + collapse = ", ") + cat("\n Conditional on group(s):", tmp) + } xold <- x x <- out1 cat("\n\n") @@ -243,9 +267,15 @@ print.cond_indirect_effects <- function(x, digits = 3, cat(" - The 'ind' column shows the", cond_str, "effects.", sep = " ") } cat("\n ") + tmp <- ifelse(has_wlevels && has_groups, + "the moderators and/or groups.", + ifelse(has_wlevels, + "the moderator(s).", + "the group(s).")) cat(strwrap(paste("\n -", paste(sQuote(mcond), collapse = ","), "is/are the path coefficient(s) along the path", - "conditional on the moderators."), exdent = 3), sep = "\n") + "conditional on", + tmp), exdent = 3), sep = "\n") cat("\n") } invisible(x) diff --git a/tests/testthat/test_mg_boot.R b/tests/testthat/test_mg_boot.R index 30916449..9608b66e 100644 --- a/tests/testthat/test_mg_boot.R +++ b/tests/testthat/test_mg_boot.R @@ -682,6 +682,30 @@ test_that("group labels helpers", { seq_along(chk1)) }) +# print.cond_indirect_effects + +fit_med <- sem(mod_med, dat, meanstructure = TRUE, fixed.x = FALSE, + group = "gp", + group.label = c("gp3", "gp1", "gp2")) + +tmp1 <- cond_indirect_effects(x = "x", + y = "y", + m = c("m1", "m2"), + fit = fit_med) +tmp2 <- cond_indirect_effects(x = "x", + y = "y", + m = c("m1", "m2"), + fit = fit_med, + groups = c(2, 1)) +tmp3 <- cond_indirect_effects(x = "x", + y = "y", + m = c("m1", "m2"), + fit = fit_med, + groups = c("gp1", "gp3")) + +tmp3 + + skip("Long tests: Test in interactive sections") # Indirect with bootstrap From a520874231ec0e4e29c4f3f5cefcf95e3e740f4c Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Sat, 30 Mar 2024 15:03:17 +0800 Subject: [PATCH 38/70] Fix confint.cond_indirect_effects() when no CI Tests passed. --- R/confint_cond_indirect_effects.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/confint_cond_indirect_effects.R b/R/confint_cond_indirect_effects.R index def9677a..0688da27 100644 --- a/R/confint_cond_indirect_effects.R +++ b/R/confint_cond_indirect_effects.R @@ -96,11 +96,11 @@ confint.cond_indirect_effects <- function(object, parm, level = .95, ...) { out0 <- as.data.frame(object) full_output <- attr(object, "full_output") has_ci <- FALSE - if (is.null(full_output[[1]]$boot_ci)) { + if (!is.null(full_output[[1]]$boot_ci)) { has_ci <- TRUE ci_type <- "boot" } - if (is.null(full_output[[1]]$mc_ci)) { + if (!is.null(full_output[[1]]$mc_ci)) { has_ci <- TRUE ci_type <- "mc" } From dcfc74270f4b87f890b846bfec2ec844aa7f80a2 Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Sat, 30 Mar 2024 15:14:18 +0800 Subject: [PATCH 39/70] Helpers for cond_indirect_effects methods --- R/lavaan_helpers.R | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) diff --git a/R/lavaan_helpers.R b/R/lavaan_helpers.R index 01fc8869..1ae06e9d 100644 --- a/R/lavaan_helpers.R +++ b/R/lavaan_helpers.R @@ -244,4 +244,26 @@ group_labels_and_numbers <- function(groups = NULL, } list(label = group_labels, number = group_numbers) + } + +#' @noRd +# Check if a cond_indirect_effects-class object has wlevels. + +has_wlevels <- function(object) { + if (!is.null(attr(object, "wlevels"))) { + return(TRUE) + } else { + return(FALSE) + } + } + +#' @noRd +# Check if a cond_indirect_effects-class object has groups. + +has_groups <- function(object) { + if (isTRUE("group" %in% tolower(colnames(object)))) { + return(TRUE) + } else { + return(FALSE) + } } \ No newline at end of file From c952f79193cd85348f72a51ee501b4e28eeaac20 Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Sat, 30 Mar 2024 15:15:19 +0800 Subject: [PATCH 40/70] Update the helpers for cond_indirect_effects --- R/lavaan_helpers.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/lavaan_helpers.R b/R/lavaan_helpers.R index 1ae06e9d..16510f6b 100644 --- a/R/lavaan_helpers.R +++ b/R/lavaan_helpers.R @@ -249,7 +249,7 @@ group_labels_and_numbers <- function(groups = NULL, #' @noRd # Check if a cond_indirect_effects-class object has wlevels. -has_wlevels <- function(object) { +cond_indirect_effects_has_wlevels <- function(object) { if (!is.null(attr(object, "wlevels"))) { return(TRUE) } else { @@ -260,7 +260,7 @@ has_wlevels <- function(object) { #' @noRd # Check if a cond_indirect_effects-class object has groups. -has_groups <- function(object) { +cond_indirect_effects_has_groups <- function(object) { if (isTRUE("group" %in% tolower(colnames(object)))) { return(TRUE) } else { From c64ba289041f80bcc951433b9d55f81177292516 Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Sat, 30 Mar 2024 15:19:42 +0800 Subject: [PATCH 41/70] Update confint.cond_indirect_effects for ngroups > 1 Tests passed --- R/confint_cond_indirect_effects.R | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) diff --git a/R/confint_cond_indirect_effects.R b/R/confint_cond_indirect_effects.R index 0688da27..0e2b3485 100644 --- a/R/confint_cond_indirect_effects.R +++ b/R/confint_cond_indirect_effects.R @@ -93,6 +93,8 @@ confint.cond_indirect_effects <- function(object, parm, level = .95, ...) { # warning("Bootstrapping interval not in the object.") # out0 <- c(NA, NA) # } + has_wlevels <- cond_indirect_effects_has_wlevels(object) + has_groups <- cond_indirect_effects_has_groups(object) out0 <- as.data.frame(object) full_output <- attr(object, "full_output") has_ci <- FALSE @@ -117,8 +119,18 @@ confint.cond_indirect_effects <- function(object, parm, level = .95, ...) { trim = TRUE, scientific = FALSE, digits = 2), "%") - wlevels <- attr(object, "wlevels") colnames(out) <- cnames - rownames(out) <- rownames(wlevels) + if (has_wlevels && !has_groups) { + wlevels <- attr(object, "wlevels") + rownames(out) <- rownames(wlevels) + } + if (!has_wlevels && has_groups) { + tmp <- paste0(object$Group, " [", object$Group_ID, "]") + rownames(out) <- tmp + } + if (has_wlevels && has_groups) { + # TODO: + # - Support for having both wlevels and groups + } out } From 149331e1cd276fb27ae1e49d226a7fcd139424f6 Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Sat, 30 Mar 2024 15:19:46 +0800 Subject: [PATCH 42/70] Update test_mg_boot.R --- tests/testthat/test_mg_boot.R | 48 +++++++++++++++++++++++++++-------- 1 file changed, 37 insertions(+), 11 deletions(-) diff --git a/tests/testthat/test_mg_boot.R b/tests/testthat/test_mg_boot.R index 9608b66e..2c3fb521 100644 --- a/tests/testthat/test_mg_boot.R +++ b/tests/testthat/test_mg_boot.R @@ -692,18 +692,12 @@ tmp1 <- cond_indirect_effects(x = "x", y = "y", m = c("m1", "m2"), fit = fit_med) -tmp2 <- cond_indirect_effects(x = "x", - y = "y", - m = c("m1", "m2"), - fit = fit_med, - groups = c(2, 1)) -tmp3 <- cond_indirect_effects(x = "x", - y = "y", - m = c("m1", "m2"), - fit = fit_med, - groups = c("gp1", "gp3")) -tmp3 +test_that("print.cond_indirect_effects: Multiple groups", { + expect_output(print(tmp1), + "Conditional on group(s)", + fixed = TRUE) + }) skip("Long tests: Test in interactive sections") @@ -729,6 +723,15 @@ suppressWarnings(fit2_chk_boot <- sem(mod2_chk, dat, meanstructure = TRUE, fixed fit2_chk_boot_out <- do_boot(fit2_chk_boot) +fit_med <- sem(mod_med, dat, meanstructure = TRUE, fixed.x = FALSE, + group = "gp", + group.label = c("gp3", "gp1", "gp2")) +fit_med_boot_out <- do_boot(fit_med, + R = 50, + seed = 1234, + parallel = FALSE, + progress = FALSE) + suppressWarnings(tmp2 <- indirect_effect(x = "x", y = "y", m = "m3", @@ -880,3 +883,26 @@ test_that("indirect_effect and multigrop, boot: Math", { expect_equal(tmpmath3b$boot_indirect, tmp3b$boot_indirect + tmp3$boot_indirect) }) + +# confint.cond_indirect_effects + +tmp1_boot <- cond_indirect_effects(x = "x", + y = "y", + m = c("m1", "m2"), + fit = fit_med, + boot_ci = TRUE, + boot_out = fit_med_boot_out) +suppressWarnings(tmp1_2 <- indirect_effect(x = "x", + y = "y", + m = c("m1", "m2"), + fit = fit_med, + group = 3, + boot_ci = TRUE, + boot_out = fit_med_boot_out)) + +tmp1_boot_ci <- confint(tmp1_boot) + +test_that("confint.cond_indirect_effects with multiple groups", { + expect_equal(unname(unlist(tmp1_boot_ci[3, ])), + unname(as.vector(confint(tmp1_2)))) + }) From a4e24688ff5338c3bbe4448253ed7bd109e431b4 Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Sat, 30 Mar 2024 15:27:17 +0800 Subject: [PATCH 43/70] Update coef.cond_indirect_effects for ngroups > 1 Tests passesd. --- R/coef_cond_indirect_effects.R | 12 +++++++++++- tests/testthat/test_mg_boot.R | 31 ++++++++++++++++++++++++++++--- 2 files changed, 39 insertions(+), 4 deletions(-) diff --git a/R/coef_cond_indirect_effects.R b/R/coef_cond_indirect_effects.R index a7a70aac..89cf7778 100644 --- a/R/coef_cond_indirect_effects.R +++ b/R/coef_cond_indirect_effects.R @@ -62,14 +62,24 @@ #' @export coef.cond_indirect_effects <- function(object, ...) { + has_wlevels <- cond_indirect_effects_has_wlevels(object) + has_groups <- cond_indirect_effects_has_groups(object) wlevels <- attr(object, "wlevels") if ("std" %in% colnames(object)) { out <- object$std } else { out <- object$ind } - if (!is.null(wlevels)) { + if (has_wlevels && !has_groups) { names(out) <- rownames(wlevels) } + if (!has_wlevels && has_groups) { + tmp <- paste0(object$Group, " [", object$Group_ID, "]") + names(out) <- tmp + } + if (has_wlevels && has_groups) { + # TODO: + # - Support objects with both wlevels and groups + } out } diff --git a/tests/testthat/test_mg_boot.R b/tests/testthat/test_mg_boot.R index 2c3fb521..3efecc2e 100644 --- a/tests/testthat/test_mg_boot.R +++ b/tests/testthat/test_mg_boot.R @@ -646,14 +646,14 @@ tmp3 <- cond_indirect_effects(x = "x", groups = c("gp1", "gp3")) test_that("cond_indirect_effects for multiple group", { - expect_equal(coef(tmp1), + expect_equal(unname(coef(tmp1)), unname(c(coef(tmp1_chk1), coef(tmp1_chk2), coef(tmp1_chk3)))) - expect_equal(coef(tmp2), + expect_equal(unname(coef(tmp2)), unname(c(coef(tmp1_chk2), coef(tmp1_chk1)))) - expect_equal(coef(tmp3), + expect_equal(unname(coef(tmp3)), unname(c(coef(tmp1_chk2), coef(tmp1_chk1)))) expect_error(tmp2 <- cond_indirect_effects(x = "x", @@ -700,6 +700,30 @@ test_that("print.cond_indirect_effects: Multiple groups", { }) +# coef.cond_indirect_effects + +fit_med <- sem(mod_med, dat, meanstructure = TRUE, fixed.x = FALSE, + group = "gp", + group.label = c("gp3", "gp1", "gp2")) + +tmp1 <- cond_indirect_effects(x = "x", + y = "y", + m = c("m1", "m2"), + fit = fit_med) +tmp1_3 <- indirect_effect(x = "x", + y = "y", + m = c("m1", "m2"), + fit = fit_med, + group = 3) + +coef(tmp1) + +test_that("coef.cond_indirect_effects with multiple groups", { + expect_equal(unname(coef(tmp1)[3]), + unname(coef(tmp1_3))) + }) + + skip("Long tests: Test in interactive sections") # Indirect with bootstrap @@ -906,3 +930,4 @@ test_that("confint.cond_indirect_effects with multiple groups", { expect_equal(unname(unlist(tmp1_boot_ci[3, ])), unname(as.vector(confint(tmp1_2)))) }) + From 72fd365c83cbd14efee18ea907233347318a74de Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Sat, 30 Mar 2024 15:36:19 +0800 Subject: [PATCH 44/70] Update [.cond_indirect_effects for ngroups > 1 Tests passed. --- R/cond_indirect_effects_subset.R | 12 +++++++++--- tests/testthat/test_mg_boot.R | 18 ++++++++++++++++-- 2 files changed, 25 insertions(+), 5 deletions(-) diff --git a/R/cond_indirect_effects_subset.R b/R/cond_indirect_effects_subset.R index 3b107e8f..2cac78f9 100644 --- a/R/cond_indirect_effects_subset.R +++ b/R/cond_indirect_effects_subset.R @@ -71,6 +71,10 @@ NULL `[.cond_indirect_effects` <- function(x, i, j, drop = if (missing(i)) TRUE else length(j) == 1) { + # TODO: + # - Support object with both wlevels and groups + has_wlevels <- cond_indirect_effects_has_wlevels(x) + has_groups <- cond_indirect_effects_has_groups(x) out <- NextMethod() if (is.null(dim(out))) { if (!missing(j)) { @@ -87,9 +91,11 @@ NULL } else { fo <- attr(x, "full_output")[i] attr(out, "full_output") <- fo - wl <- attr(x, "wlevels")[i, , drop = FALSE] - attr(wl, "wlevels") <- attr(wl, "wlevels")[i, , drop = FALSE] - attr(out, "wlevels") <- wl + if (has_wlevels) { + wl <- attr(x, "wlevels")[i, , drop = FALSE] + attr(wl, "wlevels") <- attr(wl, "wlevels")[i, , drop = FALSE] + attr(out, "wlevels") <- wl + } return(out) } } \ No newline at end of file diff --git a/tests/testthat/test_mg_boot.R b/tests/testthat/test_mg_boot.R index 3efecc2e..63e057a3 100644 --- a/tests/testthat/test_mg_boot.R +++ b/tests/testthat/test_mg_boot.R @@ -716,13 +716,27 @@ tmp1_3 <- indirect_effect(x = "x", fit = fit_med, group = 3) -coef(tmp1) - test_that("coef.cond_indirect_effects with multiple groups", { expect_equal(unname(coef(tmp1)[3]), unname(coef(tmp1_3))) }) +# [.cond_indirect_effects + +fit_med <- sem(mod_med, dat, meanstructure = TRUE, fixed.x = FALSE, + group = "gp", + group.label = c("gp3", "gp1", "gp2")) + +tmp1 <- cond_indirect_effects(x = "x", + y = "y", + m = c("m1", "m2"), + fit = fit_med) + +test_that("[.cond_indirect_effects: Multiple groups", { + expect_equal(unname(coef(tmp1[c(1, 3), ])), + as.data.frame(tmp1)[c(1, 3), "ind"]) + }) + skip("Long tests: Test in interactive sections") From 13be3527750d196307e801b134ac0a368ffd237a Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Sat, 30 Mar 2024 15:56:01 +0800 Subject: [PATCH 45/70] Add \n to the end --- R/print_indirect.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/print_indirect.R b/R/print_indirect.R index cf09c0c7..51a86d76 100644 --- a/R/print_indirect.R +++ b/R/print_indirect.R @@ -402,5 +402,6 @@ print.indirect <- function(x, cat("\nNOTE:\n") cat(note_str, sep = "\n") } + cat("\n") invisible(x) } From ad2ee4ec3969fc2bf45a92fb0b7448353b646045 Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Sat, 30 Mar 2024 16:13:02 +0800 Subject: [PATCH 46/70] Update cond_indirect_diff for ngroups > 1 Tests passed. --- R/cond_indirect_diff.R | 50 ++++++++++++++++++++++++++++++----- tests/testthat/test_mg_boot.R | 33 +++++++++++++++++++++++ 2 files changed, 77 insertions(+), 6 deletions(-) diff --git a/R/cond_indirect_diff.R b/R/cond_indirect_diff.R index 123fb18d..1741c25f 100644 --- a/R/cond_indirect_diff.R +++ b/R/cond_indirect_diff.R @@ -158,6 +158,11 @@ cond_indirect_diff <- function(output, from = NULL, to = NULL, level = .95) { + has_wlevels <- cond_indirect_effects_has_wlevels(output) + has_groups <- cond_indirect_effects_has_groups(output) + if (has_wlevels && has_groups) { + stop("Objects with both wlevels and groups not yet supported") + } if (missing(output)) { stop("'output' is missing.") } @@ -229,9 +234,29 @@ cond_indirect_diff <- function(output, boot_diff_p <- NA boot_diff_se <- NA } - wlevels <- attr(output, "wlevels") - wlevels_from <- wlevels[from, , drop = FALSE] - wlevels_to <- wlevels[to, , drop = FALSE] + if (has_wlevels && !has_groups) { + wlevels <- attr(output, "wlevels") + wlevels_from <- wlevels[from, , drop = FALSE] + wlevels_to <- wlevels[to, , drop = FALSE] + final_from <- wlevels_from + final_to <- wlevels_to + } + if (!has_wlevels && has_groups) { + group_labels <- output$Group + group_numbers <- output$Group_ID + group_from <- paste0(group_labels[from], " [", + group_numbers[from], "]") + group_to <- paste0(group_labels[to], " [", + group_numbers[to], "]") + names(group_from) <- "Group" + names(group_to) <- "Group" + final_from <- group_from + final_to <- group_to + } + if (has_wlevels && has_groups) { + # TODO: + # - Add support for objects with both wlevels and groups. + } out_diff_ci <- c(NA, NA) out_diff_se <- NA if (has_mc) out_diff_ci <- mc_diff_ci @@ -243,11 +268,13 @@ cond_indirect_diff <- function(output, pvalue = boot_diff_p, se = out_diff_se, level = level, - from = wlevels_from, - to = wlevels_to, + from = final_from, + to = final_to, output = output[c(to, from), ], boot_diff = boot_diff, - mc_diff = mc_diff) + mc_diff = mc_diff, + has_groups = has_groups, + has_wlevels = has_wlevels) class(out) <- c("cond_indirect_diff", class(out)) out } @@ -328,6 +355,8 @@ print.cond_indirect_diff <- function(x, se = FALSE, ...) { full_output_attr <- attr(x$output, "full_output")[[1]] + has_groups <- is.numeric(full_output_attr$group_number) + has_wlevels <- !is.null(full_output_attr$wvalues) print(x$output, digits = digits, annotation = FALSE, ...) x_type <- x$type if (!is.null(x_type)) { @@ -368,6 +397,15 @@ print.cond_indirect_diff <- function(x, } else { cat("\nLevels: \n") print(tofrom, quote = FALSE) + if (!has_wlevels && has_groups) { + tmp <- paste0("Levels compared: ", + xto0, + " - ", + xfrom0) + } else { + tmp <- "Levels compared: Row 1 - Row 2" + } + cat("\n", tmp, "\n", sep = "") } index_df <- data.frame(x = full_output_attr$x, y = full_output_attr$y, diff --git a/tests/testthat/test_mg_boot.R b/tests/testthat/test_mg_boot.R index 63e057a3..0d7da111 100644 --- a/tests/testthat/test_mg_boot.R +++ b/tests/testthat/test_mg_boot.R @@ -737,6 +737,39 @@ test_that("[.cond_indirect_effects: Multiple groups", { as.data.frame(tmp1)[c(1, 3), "ind"]) }) +# cond_indirect_diff + +fit_med <- sem(mod_med, dat, meanstructure = TRUE, fixed.x = FALSE, + group = "gp", + group.label = c("gp3", "gp1", "gp2")) + +tmp1 <- cond_indirect_effects(x = "x", + y = "y", + m = c("m1", "m2"), + fit = fit_med) + +tmp1_diff <- cond_indirect_diff(tmp1, + from = 3, + to = 1) + +tmp1_1 <- indirect_effect(x = "x", + y = "y", + m = c("m1", "m2"), + fit = fit_med, + group = 1) +tmp1_3 <- indirect_effect(x = "x", + y = "y", + m = c("m1", "m2"), + fit = fit_med, + group = 3) + +test_that("cond_indirect_diff: Multiple groups", { + expect_equal(unname(coef(tmp1_diff)), + unname(coef(tmp1_1) - coef(tmp1_3))) + }) + + + skip("Long tests: Test in interactive sections") From 4c43bdf69c5fc62a1bc7bab5bfe6b06dcca5b0f7 Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Sat, 30 Mar 2024 16:47:11 +0800 Subject: [PATCH 47/70] Update lm_from_lavaan_list for ngroups > 1 Tests passed --- R/lavaan2lm_list.R | 35 ++++++++++++++++++++++++++++++++++- 1 file changed, 34 insertions(+), 1 deletion(-) diff --git a/R/lavaan2lm_list.R b/R/lavaan2lm_list.R index 8bea1a89..c3cf5f08 100644 --- a/R/lavaan2lm_list.R +++ b/R/lavaan2lm_list.R @@ -46,9 +46,42 @@ #' #' @export - lm_from_lavaan_list <- function(fit) { + ngroups <- lavaan::lavTech(fit, "ngroups") + if (ngroups > 1) { + group_numbers <- seq_len(ngroups) + group_labels <- lavaan::lavTech(fit, "group.label") + out <- lapply(group_numbers, + function(x) { + lm_from_lavaan_list_i(fit = fit, + group_number = x) + }) + class(out) <- c("lm_from_lavaan_list", class(out)) + } else { + out <- lm_from_lavaan_list_i(fit = fit) + } + out + } + +#' @noRd + +lm_from_lavaan_list_i <- function(fit, + group_number = NULL) { ptable <- lav_ptable(fit) + if ("group" %in% colnames(ptable)) { + tmp <- unique(ptable$group) + if (length(tmp) > 1) { + if (is.null(group_number)) { + stop("The model has more than one groups but group_number not set.") + } + if (!(group_number %in% tmp)) { + stop("group_number is", group_number, + "but group numbers in the model are", + paste0(tmp, collapse = ", ")) + } + ptable <- ptable[ptable$group == group_number, ] + } + } # Get all dvs (ov.nox, lv.ox) dvs <- lavaan_get_dvs(ptable) dat <- lav_data_used(fit) From c3c8f50f5cf5995bee85cc48ec7fd39568e09085 Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Sat, 30 Mar 2024 16:49:10 +0800 Subject: [PATCH 48/70] Add labels in lm_from_lavaan_list --- R/lavaan2lm_list.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/lavaan2lm_list.R b/R/lavaan2lm_list.R index c3cf5f08..bf918a49 100644 --- a/R/lavaan2lm_list.R +++ b/R/lavaan2lm_list.R @@ -56,6 +56,7 @@ lm_from_lavaan_list <- function(fit) { lm_from_lavaan_list_i(fit = fit, group_number = x) }) + names(out) <- group_labels class(out) <- c("lm_from_lavaan_list", class(out)) } else { out <- lm_from_lavaan_list_i(fit = fit) From 95d615f0b5df2fec632c0d0a33ffdf178fe6356c Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Sat, 30 Mar 2024 16:57:35 +0800 Subject: [PATCH 49/70] Add a helper to get labels and numbers --- R/lavaan_helpers.R | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/R/lavaan_helpers.R b/R/lavaan_helpers.R index 16510f6b..1ab86609 100644 --- a/R/lavaan_helpers.R +++ b/R/lavaan_helpers.R @@ -246,6 +246,20 @@ group_labels_and_numbers <- function(groups = NULL, number = group_numbers) } +#' @noRd + +group_labels_and_numbers_cond <- function(object, + group_label_name = "Group", + group_number_name = "Group_ID") { + if (!inherits(object, "cond_indirect_effects")) { + stop("Object must be a cond_indirect_effects-class object.") + } + group_labels <- unique(object[, group_label_name, drop = TRUE]) + group_numbers <- unique(object[, group_number_name, drop = TRUE]) + list(label = group_labels, + number = group_numbers) + } + #' @noRd # Check if a cond_indirect_effects-class object has wlevels. From 18b37a3a56a0369800f7832bbe690b12e38924e2 Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Sat, 30 Mar 2024 18:22:14 +0800 Subject: [PATCH 50/70] Update plot.cond_indirect_effects for ngroups > 1 Tests, checks, build_site() passed. --- R/plotmod.R | 176 +++++++++++++++++++++++++++------- tests/testthat/test_mg_boot.R | 17 ++++ 2 files changed, 160 insertions(+), 33 deletions(-) diff --git a/R/plotmod.R b/R/plotmod.R index e9b1ba1c..d97e57bf 100644 --- a/R/plotmod.R +++ b/R/plotmod.R @@ -194,11 +194,32 @@ plot.cond_indirect_effects <- function( graph_type = c("default", "tumble"), ... ) { + has_groups <- cond_indirect_effects_has_groups(x) + has_wlevels <- cond_indirect_effects_has_wlevels(x) + if (has_wlevels && has_groups) { + stop("Objects with both wlevels and groups not yet supported") + } output <- x + if (has_groups) { + tmp <- group_labels_and_numbers_cond(output) + group_labels <- tmp$label + group_numbers <- tmp$number + w_label <- ifelse(w_label == "Moderator(s)", + "Group", + w_label) + } else { + group_labels <- NULL + group_numbers <- NULL + } fit <- attr(output, "fit") fit_type <- cond_indirect_check_fit(fit) x_method <- match.arg(x_method) graph_type <- match.arg(graph_type) + if (has_groups && graph_type == "default") { + # warning("Only tumble graph is supported for multiple group models. ", + # "Changed graph_type to 'tumble'.") + graph_type <- "tumble" + } full_output <- attr(output, "full_output") full_output_1 <- full_output[[1]] x <- full_output_1$x @@ -207,12 +228,14 @@ plot.cond_indirect_effects <- function( if (!is.null(m)) { stop("The plot method does not support indirect effects.") } - wlevels <- attr(output, "wlevels") - if (fit_type == "lm") { - wlevels <- ind_to_cat(wlevels) + if (has_wlevels) { + wlevels <- attr(output, "wlevels") + if (fit_type == "lm") { + wlevels <- ind_to_cat(wlevels) + } + w_names <- colnames(wlevels) } - - w_names <- colnames(wlevels) + # mf0 is a list of datasets for multiple group models mf0 <- switch(fit_type, lavaan = lavaan::lavInspect(fit, "data"), lavaan.mi = lav_data_used(fit, drop_colon = FALSE), @@ -243,9 +266,20 @@ plot.cond_indirect_effects <- function( x_levels_list <- replicate(nrow(wlevels), x_levels, simplify = FALSE) } if (graph_type == "tumble") { - x_subsets <- lapply(split(wlevels, seq_len(nrow(wlevels))), - x_for_wlevels, - mf = mf0, x = x) + if (has_wlevels && !has_groups) { + x_subsets <- lapply(split(wlevels, seq_len(nrow(wlevels))), + x_for_wlevels, + mf = mf0, x = x) + } + if (!has_wlevels && has_groups) { + x_subsets <- lapply(mf0, function(xx) { + xx[, x, drop = TRUE] + }) + } + if (has_wlevels && has_groups) { + # TODO + # - Support objects with both wlevels and groups. + } x_levels_list <- lapply(x_subsets, gen_levels, method = x_method, @@ -258,19 +292,56 @@ plot.cond_indirect_effects <- function( x_levels_m <- do.call(rbind, x_levels_list) plot_df_xstart <- data.frame(x = x_levels_m[, 1]) plot_df_xend <- data.frame(x = x_levels_m[, 2]) - mf2 <- data.frame(lapply(as.data.frame(dat0), sum_col), - check.names = FALSE) - mf2 <- mf2[, -(which(colnames(mf2) %in% c(x, w_names)))] - plot_df_xstart <- cbind(plot_df_xstart, wlevels, mf2) - plot_df_xend <- cbind(plot_df_xend, wlevels, mf2) + if (has_groups) { + # mf2 has rows equal to ngroups + mf2 <- lapply(dat0, function(xx) { + data.frame(lapply(as.data.frame(xx), sum_col), + check.names = FALSE) + }) + mf2 <- lapply(mf2, function(xx) { + xx[, -(which(colnames(xx) %in% c(x)))] + }) + mf2 <- do.call(rbind, mf2) + } else { + # mf2 has one single row + # TO-THINK: + # - Maybe we can use different values of other variables + mf2 <- data.frame(lapply(as.data.frame(dat0), sum_col), + check.names = FALSE) + mf2 <- mf2[, -(which(colnames(mf2) %in% c(x, w_names)))] + } + if (has_groups) { + plot_df_xstart <- cbind(plot_df_xstart, mf2) + plot_df_xend <- cbind(plot_df_xend, mf2) + } else { + plot_df_xstart <- cbind(plot_df_xstart, wlevels, mf2) + plot_df_xend <- cbind(plot_df_xend, wlevels, mf2) + } colnames(plot_df_xstart)[1] <- x colnames(plot_df_xend)[1] <- x - plot_df_xstart[, y] <- stats::predict(fit_list, - x = x, y = y, m = m, - newdata = plot_df_xstart) - plot_df_xend[, y] <- stats::predict(fit_list, - x = x, y = y, m = m, - newdata = plot_df_xend) + if (has_groups) { + plot_df_xstart_i <- split(plot_df_xstart, + seq_len(nrow(plot_df_xstart)), + drop = FALSE) + plot_df_xend_i <- split(plot_df_xend, + seq_len(nrow(plot_df_xend)), + drop = FALSE) + plot_df_xstart[, y] <- mapply(stats::predict, + object = fit_list, + newdata = plot_df_xstart_i, + MoreArgs = list(x = x, y = y, m = m)) + plot_df_xend[, y] <- mapply(stats::predict, + object = fit_list, + newdata = plot_df_xend_i, + MoreArgs = list(x = x, y = y, m = m)) + } else { + plot_df_xstart[, y] <- stats::predict(fit_list, + x = x, y = y, m = m, + newdata = plot_df_xstart) + plot_df_xend[, y] <- stats::predict(fit_list, + x = x, y = y, m = m, + newdata = plot_df_xend) + } if (missing(x_label)) x_label <- x if (missing(y_label)) y_label <- y @@ -285,16 +356,44 @@ plot.cond_indirect_effects <- function( lm = lm2ptable(fit)$implied_stats) } if (x_standardized) { - x_sd <- sqrt(implied_stats$cov[x, x]) - x_mean <- implied_stats$mean[x] - if (is.null(x_mean)) x_mean <- 0 + if (has_groups) { + # x_sd and x_mean are vectors if ngroups > 1 + group_labels <- names(fit_list) + implied_stats <- implied_stats[group_labels] + x_sd <- sapply(implied_stats, function(xx) { + xx$cov[x, x] + }) + x_mean <- sapply(implied_stats, function(xx) { + out <- xx$mean[x] + out <- ifelse(is.null(out), 0, out) + out + }) + } else { + x_sd <- sqrt(implied_stats$cov[x, x]) + x_mean <- implied_stats$mean[x] + if (is.null(x_mean)) x_mean <- 0 + } plot_df_xstart[, x] <- (plot_df_xstart[, x] - x_mean) / x_sd plot_df_xend[, x] <- (plot_df_xend[, x] - x_mean) / x_sd } if (y_standardized) { - y_sd <- sqrt(implied_stats$cov[y, y]) - y_mean <- implied_stats$mean[y] - if (is.null(y_mean)) y_mean <- 0 + if (has_groups) { + # y_sd and y_mean are vectors if ngroups > 1 + group_labels <- names(fit_list) + implied_stats <- implied_stats[group_labels] + y_sd <- sapply(implied_stats, function(xx) { + xx$cov[y, y] + }) + y_mean <- sapply(implied_stats, function(xx) { + out <- xx$mean[y] + out <- ifelse(is.null(out), 0, out) + out + }) + } else { + y_sd <- sqrt(implied_stats$cov[y, y]) + y_mean <- implied_stats$mean[y] + if (is.null(y_mean)) y_mean <- 0 + } plot_df_xstart[, y] <- (plot_df_xstart[, y] - y_mean) / y_sd plot_df_xend[, y] <- (plot_df_xend[, y] - y_mean) / y_sd } @@ -326,15 +425,18 @@ plot.cond_indirect_effects <- function( title <- "Conditional Effects" } } - - plot_df_xstart$wlevels <- rownames(wlevels) - plot_df_xend$wlevels <- rownames(wlevels) + if (has_groups) { + plot_df_xstart$wlevels <- group_labels + plot_df_xend$wlevels <- group_labels + } else { + plot_df_xstart$wlevels <- rownames(wlevels) + plot_df_xend$wlevels <- rownames(wlevels) + } plot_df <- rbind(plot_df_xstart, plot_df_xend) - p <- ggplot2::ggplot() + - ggplot2::geom_point(ggplot2::aes_string(x = x, - y = y, - colour = "wlevels"), + ggplot2::geom_point(ggplot2::aes(x = .data[[x]], + y = .data[[y]], + colour = .data[["wlevels"]]), data = plot_df, size = point_size) + ggplot2::geom_segment(ggplot2::aes( @@ -343,7 +445,7 @@ plot.cond_indirect_effects <- function( y = plot_df_xstart[, y], yend = plot_df_xend[, y], colour = plot_df_xstart$wlevels - ), size = line_width) + ), linewidth = line_width) if (note_standardized & !is.null(cap_std)) { if (!is.null(cap_txt)) { @@ -352,6 +454,11 @@ plot.cond_indirect_effects <- function( cap_txt <- cap_std } } + if (has_groups && graph_type == "default") { + cap_txt <- paste0(cap_txt, + "\n", + "Graph type is set to tumble for multiple group models.") + } out <- p + ggplot2::labs(title = title, caption = cap_txt) + @@ -369,3 +476,6 @@ plot.cond_indirect_effects <- function( } out } + +utils::globalVariables(".data") + diff --git a/tests/testthat/test_mg_boot.R b/tests/testthat/test_mg_boot.R index 0d7da111..2311187f 100644 --- a/tests/testthat/test_mg_boot.R +++ b/tests/testthat/test_mg_boot.R @@ -768,6 +768,23 @@ test_that("cond_indirect_diff: Multiple groups", { unname(coef(tmp1_1) - coef(tmp1_3))) }) +# plot.cond_indirect_effects + +fit_med <- sem(mod_med, dat, meanstructure = TRUE, fixed.x = FALSE, + group = "gp", + group.label = c("gp3", "gp1", "gp2")) + +tmp1 <- cond_indirect_effects(x = "m2", + y = "y", + fit = fit_med) + +test_that("plot.cond_indirect_effects: multiple groups", { + expect_no_error(p <- plot(tmp1)) + expect_true(setequal(unique(p$layers[[1]]$data$wlevels), + unique(tmp1$Group))) + }) + + From f32d45d449b22fe129e261aba147852c713fae4a Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Sat, 30 Mar 2024 18:45:53 +0800 Subject: [PATCH 51/70] 0.1.14.2: Initial support for multigroup models Tests and checks passed. --- DESCRIPTION | 2 +- NEWS.md | 42 +++++++++++++++++++++++++++++++++++++++++- README.md | 4 +--- 3 files changed, 43 insertions(+), 5 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 964db3fb..861e69f5 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: manymome Title: Mediation, Moderation and Moderated-Mediation After Model Fitting -Version: 0.1.14.1 +Version: 0.1.14.2 Authors@R: c(person(given = "Shu Fai", family = "Cheung", diff --git a/NEWS.md b/NEWS.md index d8ad7a8d..2a9b43bb 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,44 @@ -# manymome 0.1.14.1 +# manymome 0.1.14.2 + +## New Features + +- Many functions have been updated to + work for multiple-group models fitted + by `lavaan`. Most common tasks are + supported. There likely are functions + that may not yet work on + multiple-group models. Checks will be + added to them to alert users. + Documentation and vignetted to be + added or updated. For now, only some + functions (e.g., + `cond_indirect_effect()`) supports + multiple-group models which have + one or more moderators within each + group, but these models are rare. + (0.1.14.2) + +- Relaxed the requirement that only + different paths can be used in `+` + and `-`. They can now be used in + these operations, as they may be + paths in different groups in + multiple-group models. (0.1.14.2) + +- The `plot`-method of + `cond_indirect_effects`-class objects + will be forced to be a tumble graph + if the lines for different groups + are to be plotted. In these cases, + the data within each group will be used, + including standardization. This + approach, though leading to results + different from those in single-group + model using the group as a moderator, + makes more sense for multiple-group + models, in which the distribution of + variables are allowed to be different + between groups. (0.1.14.2) ## Miscellaneous diff --git a/README.md b/README.md index 16be47c7..e2e7fd74 100644 --- a/README.md +++ b/README.md @@ -9,7 +9,7 @@ [![R-CMD-check](https://github.com/sfcheung/manymome/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/sfcheung/manymome/actions/workflows/R-CMD-check.yaml) -(Version 0.1.14.1, updated on 2024-03-24, [release history](https://sfcheung.github.io/manymome/news/index.html)) +(Version 0.1.14.2, updated on 2024-03-30, [release history](https://sfcheung.github.io/manymome/news/index.html)) # manymome @@ -110,8 +110,6 @@ Despite the aforementioned advantages, the current version of - Does not (officially) support categorical predictors. -- Does not support multisample models (although `lavaan` does). - - Does not support multilevel models (although `lavaan` does). - For bootstrapping, only supports nonparametric bootstrapping and percentile From 2d68cf690f8668dd72c99722c809f18dabc1099e Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Sat, 30 Mar 2024 19:55:54 +0800 Subject: [PATCH 52/70] Test for indirect_effects_from_list --- tests/testthat/test_mg_boot.R | 25 ++++++++++++++++++++++++- 1 file changed, 24 insertions(+), 1 deletion(-) diff --git a/tests/testthat/test_mg_boot.R b/tests/testthat/test_mg_boot.R index 2311187f..6059da68 100644 --- a/tests/testthat/test_mg_boot.R +++ b/tests/testthat/test_mg_boot.R @@ -607,6 +607,16 @@ test_that("many_indirect: multiple group", { coef(ind_chk)) }) +# indirect_effects_from_list + +test_that("indirect_effects_from_list: multiple group", { + expect_equal(unname(indirect_effects_from_list(all_ind)$ind), + unname(coef(all_ind))) + }) + + + + # Mediation only fit_med <- sem(mod_med, dat, meanstructure = TRUE, fixed.x = FALSE, @@ -664,7 +674,6 @@ test_that("cond_indirect_effects for multiple group", { }) - # Group labels helpers chk1 <- lavTech(fit2, "group.label") @@ -995,3 +1004,17 @@ test_that("confint.cond_indirect_effects with multiple groups", { unname(as.vector(confint(tmp1_2)))) }) +# indirect_effects_from_list + +all_tmp <- all_indirect_paths(fit_med) +all_ind <- many_indirect_effects(all_tmp, + fit = fit_med, + boot_ci = TRUE, + boot_out = fit_med_boot_out) + +test_that("indirect_effects_from_list: multiple group", { + expect_equal(unname(indirect_effects_from_list(all_ind)$ind), + unname(coef(all_ind))) + expect_equal(unname(indirect_effects_from_list(all_ind)$`CI.lo`), + unname(confint(all_ind)[, 1])) + }) From 195e6eb681be04b02797a3be93c3649d61da82fe Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Sat, 30 Mar 2024 22:13:50 +0800 Subject: [PATCH 53/70] Update total_indirect_effect for ngroups > 1 Tests passed --- R/lavaan_helpers.R | 43 ++++++++++++++++++++++++++++++- R/total_indirect_effect_list.R | 46 ++++++++++++++++++++++++++++++++-- tests/testthat/test_mg_boot.R | 26 ++++++++++++++++++- 3 files changed, 111 insertions(+), 4 deletions(-) diff --git a/R/lavaan_helpers.R b/R/lavaan_helpers.R index 1ab86609..0be1b6fd 100644 --- a/R/lavaan_helpers.R +++ b/R/lavaan_helpers.R @@ -280,4 +280,45 @@ cond_indirect_effects_has_groups <- function(object) { } else { return(FALSE) } - } \ No newline at end of file + } + +#' @noRd +# Check if a cond_indirect_effects-class object has groups. + +indirect_list_has_groups <- function(object) { + if (!is.list(object)) { + stop("Object must be a list or an indirect_list.") + } + tmp <- sapply(object, indirect_has_groups) + if (!(!all(tmp) || all(tmp))) { + stop("Some effects are group-specific but some are not.") + } + if (all(tmp)) { + return(TRUE) + } else { + return(FALSE) + } + } + +#' @noRd +# Check if an indirect-class object has groups. + +indirect_has_groups <- function(object) { + if (isTRUE(is.numeric(object$group_number))) { + return(TRUE) + } else { + return(FALSE) + } + } + +#' @noRd + +group_labels_and_numbers_list <- function(object) { + if (!is.list(object)) { + stop("Object must be a list or an indirect_list.") + } + group_labels <- unique(sapply(object, function(xx) xx$group_label)) + group_numbers <- unique(sapply(object, function(xx) xx$group_number)) + list(label = group_labels, + number = group_numbers) + } diff --git a/R/total_indirect_effect_list.R b/R/total_indirect_effect_list.R index 75ebc247..22457563 100644 --- a/R/total_indirect_effect_list.R +++ b/R/total_indirect_effect_list.R @@ -70,13 +70,55 @@ total_indirect_effect <- function(object, if (!is.list(object)) { stop("object is not a list") } + has_groups <- indirect_list_has_groups(object) + if (has_groups) { + tmp <- group_labels_and_numbers_list(object) + group_labels <- tmp$label + group_numbers <- tmp$number + i1 <- sapply(object, function(xx) xx$group_label) + i2 <- split(seq_along(object), i1) + out0 <- lapply(i2, function(xx) { + object_i <- object[xx] + total_indirect_effect_i(object_i, + x = x, + y = y) + }) + out0 <- out0[group_labels] + tmp <- sapply(out0, function(xx) !identical(xx, NA)) + if (!any(tmp)) { + stop("In all groups, no paths from ", x, " to ", y, ".") + } + out0 <- out0[tmp] + } else { + # ix <- sapply(object, function(z) z$x) + # iy <- sapply(object, function(z) z$y) + # i0 <- (ix %in% x) & (iy %in% y) + # if (isFALSE(any(i0))) { + # return(NA) + # } + # p1 <- object[i0] + out0 <- total_indirect_effect_i(object = object, + x = x, + y = y) + if (identical(out0, NA)) { + stop("No paths from ", x, " to ", y, ".") + } + } + out0 + } + +#' @noRd + +total_indirect_effect_i <- function(object, + x, + y) { ix <- sapply(object, function(z) z$x) iy <- sapply(object, function(z) z$y) i0 <- (ix %in% x) & (iy %in% y) if (isFALSE(any(i0))) { - stop("No valid path was found.") + return(NA) } p1 <- object[i0] out <- Reduce(`+`, p1) out - } + } \ No newline at end of file diff --git a/tests/testthat/test_mg_boot.R b/tests/testthat/test_mg_boot.R index 6059da68..163371b4 100644 --- a/tests/testthat/test_mg_boot.R +++ b/tests/testthat/test_mg_boot.R @@ -588,10 +588,28 @@ m2 ~ c(0, 0, NA)*m1 + c(NA, NA, 0)*x w3 ~ c(NA, 0, 0)*m2 y ~ c(NA, 0, NA)*m3 + w3 " +mod_tmp_2 <- +" +m3 ~ c(NA, 0, NA)*m1 + c(NA, NA, 0)*x +m2 ~ c(NA, NA, NA)*m1 + c(NA, NA, NA)*x +w3 ~ c(NA, NA, NA)*m2 +y ~ c(0, NA, NA)*m3 + c(NA, NA, 0)*w3 +" +mod_tmp_ng <- +" +m3 ~ m1 + x +m2 ~ m1 + x +w3 ~ m2 +y ~ m3 + w3 +" fit_tmp <- sem(mod_tmp, dat, meanstructure = TRUE, fixed.x = FALSE, group = "gp", group.label = c("gp3", "gp1", "gp2")) +fit_tmp_2 <- sem(mod_tmp_2, dat, meanstructure = TRUE, fixed.x = FALSE, + group = "gp", + group.label = c("gp3", "gp1", "gp2")) +fit_tmp_ng <- sem(mod_tmp_ng, dat, meanstructure = TRUE, fixed.x = FALSE) all_tmp <- all_indirect_paths(fit_tmp) all_paths <- all_paths_to_df(all_tmp) @@ -601,6 +619,8 @@ ind_chk <- indirect_effect(x = "x", m = "m2", fit = fit_tmp, group = "gp3") +all_ind_2 <- many_indirect_effects(all_indirect_paths(fit_tmp_2), fit = fit_tmp_2) +all_ind_ng <- many_indirect_effects(all_indirect_paths(fit_tmp_ng), fit = fit_tmp_ng) test_that("many_indirect: multiple group", { expect_equal(coef(all_ind[[3]]), @@ -614,8 +634,12 @@ test_that("indirect_effects_from_list: multiple group", { unname(coef(all_ind))) }) +# total_indirect_effect - +test_that("total_indirect_effect: multiple group", { + expect_equal(length(total_indirect_effect(all_ind_2, x = "x", y = "y")), 2) + expect_error(total_indirect_effect(all_ind_2, x = "m3", y = "w3")) + }) # Mediation only From f0a11eb47d0536a7966986b4eb01b37836943786 Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Sat, 30 Mar 2024 22:23:03 +0800 Subject: [PATCH 54/70] Alert mod_levels not yet supports ngroups > 1 Tests passed. --- R/mod_levels.R | 5 +++++ tests/testthat/test_mg_boot.R | 6 ++++++ 2 files changed, 11 insertions(+) diff --git a/R/mod_levels.R b/R/mod_levels.R index 5e717c40..a372bfa9 100644 --- a/R/mod_levels.R +++ b/R/mod_levels.R @@ -227,6 +227,11 @@ mod_levels <- function(w, reference_group_label = NULL, descending = TRUE) { fit_type <- cond_indirect_check_fit(fit) + if (fit_type == "lavaan") { + if (lavaan::lavTech(fit, "ngroups") > 1) { + stop("Multigroup models not yet supported.") + } + } w_type <- match.arg(w_type) if (w_type == "auto") { w_type <- find_w_type(w, fit) diff --git a/tests/testthat/test_mg_boot.R b/tests/testthat/test_mg_boot.R index 163371b4..acc7f3c2 100644 --- a/tests/testthat/test_mg_boot.R +++ b/tests/testthat/test_mg_boot.R @@ -176,6 +176,12 @@ test_that("indirect_effect and multigrop", { 0) }) +# mod_levels + +test_that("mod_levels: multigroup", { + expect_error(mod_levels(fit2, w = "w3", w_method = "percentile")) + }) + # cond_indirect suppressWarnings(tmp2 <- cond_indirect(x = "x", From 2d9d0ed99ce82857721ee1c8d966243a81aa0f58 Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Sat, 30 Mar 2024 22:25:31 +0800 Subject: [PATCH 55/70] Alert mod_levels_list not yet supports ngroups > 1 --- tests/testthat/test_mg_boot.R | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/tests/testthat/test_mg_boot.R b/tests/testthat/test_mg_boot.R index acc7f3c2..781ac363 100644 --- a/tests/testthat/test_mg_boot.R +++ b/tests/testthat/test_mg_boot.R @@ -177,11 +177,15 @@ test_that("indirect_effect and multigrop", { }) # mod_levels +# mod_levels_list test_that("mod_levels: multigroup", { expect_error(mod_levels(fit2, w = "w3", w_method = "percentile")) + expect_error(mod_levels_list("w3", "w4", fit = fit2)) }) + + # cond_indirect suppressWarnings(tmp2 <- cond_indirect(x = "x", From 1e1c27ae2acda0e61b81bfe8ab942fbc73fe8d34 Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Sat, 30 Mar 2024 22:31:31 +0800 Subject: [PATCH 56/70] 0.1.14.3: Mark functions which do not yet support multigroup models Tests, checks, and build_site() passed. --- DESCRIPTION | 2 +- NEWS.md | 8 ++++++-- README.md | 2 +- 3 files changed, 8 insertions(+), 4 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 861e69f5..1f0bf72d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: manymome Title: Mediation, Moderation and Moderated-Mediation After Model Fitting -Version: 0.1.14.2 +Version: 0.1.14.3 Authors@R: c(person(given = "Shu Fai", family = "Cheung", diff --git a/NEWS.md b/NEWS.md index 2a9b43bb..c8747b6a 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# manymome 0.1.14.2 +# manymome 0.1.14.3 ## New Features @@ -16,7 +16,11 @@ multiple-group models which have one or more moderators within each group, but these models are rare. - (0.1.14.2) + Functions that do not yet support + multigroup models (e.g, + `mod_levels()`) will raise an error + if used on a multigroup model. + (0.1.14.2, 0.1.14.3) - Relaxed the requirement that only different paths can be used in `+` diff --git a/README.md b/README.md index e2e7fd74..8126556f 100644 --- a/README.md +++ b/README.md @@ -9,7 +9,7 @@ [![R-CMD-check](https://github.com/sfcheung/manymome/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/sfcheung/manymome/actions/workflows/R-CMD-check.yaml) -(Version 0.1.14.2, updated on 2024-03-30, [release history](https://sfcheung.github.io/manymome/news/index.html)) +(Version 0.1.14.3, updated on 2024-03-30, [release history](https://sfcheung.github.io/manymome/news/index.html)) # manymome From 7c3a21ab044efdee7a7d662bbcd34016e9cb2c48 Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Sun, 31 Mar 2024 09:01:41 +0800 Subject: [PATCH 57/70] Add a test dataset for multigroup examples Check passed. --- R/dat_5_mg.R | 37 ++++++++++++++++++++++++ data-raw/test_data_med_mg.R | 41 +++++++++++++++++++++++++++ data/data_med_complicated_mg.rda | Bin 0 -> 14681 bytes man/data_med_complicated_mg.Rd | 47 +++++++++++++++++++++++++++++++ 4 files changed, 125 insertions(+) create mode 100644 R/dat_5_mg.R create mode 100644 data-raw/test_data_med_mg.R create mode 100644 data/data_med_complicated_mg.rda create mode 100644 man/data_med_complicated_mg.Rd diff --git a/R/dat_5_mg.R b/R/dat_5_mg.R new file mode 100644 index 00000000..6057029b --- /dev/null +++ b/R/dat_5_mg.R @@ -0,0 +1,37 @@ +#' @title Sample Dataset: A Complicated +#' Mediation Model With Two Groups +#' +#' @description A mediation model with +#' two predictors, two pathways, and +#' two groups. +#' +#' @format A data frame with 300 rows +#' and 5 variables: +#' \describe{ +#' \item{x1}{Predictor 1. Numeric.} +#' \item{x2}{Predictor 2. Numeric.} +#' \item{m11}{Mediator 1 in Path 1. Numeric.} +#' \item{m12}{Mediator 2 in Path 1. Numeric.} +#' \item{m2}{Mediator in Path 2. Numeric.} +#' \item{y1}{Outcome variable 1. Numeric.} +#' \item{y2}{Outcome variable 2. Numeric.} +#' \item{c1}{Control variable. Numeric.} +#' \item{c2}{Control variable. Numeric.} +#' \item{group}{Group variable. Character. 'Group A' or 'Group B'} +#' } +#' +#' @examples +#' library(lavaan) +#' data(data_med_complicated_mg) +#' dat <- data_med_complicated_mg +#' mod <- +#' " +#' m11 ~ x1 + x2 + c1 + c2 +#' m12 ~ m11 + c1 + c2 +#' m2 ~ x1 + x2 + c1 + c2 +#' y1 ~ m11 + m12 + x1 + x2 + c1 + c2 +#' y2 ~ m2 + x1 + x2 + c1 + c2 +#' " +#' fit <- sem(mod, dat, group = "group") +#' summary(fit) +"data_med_complicated_mg" diff --git a/data-raw/test_data_med_mg.R b/data-raw/test_data_med_mg.R new file mode 100644 index 00000000..11bed522 --- /dev/null +++ b/data-raw/test_data_med_mg.R @@ -0,0 +1,41 @@ +# Generate data +library(lavaan) +n1 <- 100 +n2 <- 100 +mod1 <- +" +m11 ~ .4*x1 + .0*x2 + .3*c1 + .1*c2 +m12 ~ .5*m11 + .0*x1 + .0*x2 + .0*c1 + .0*c2 +m2 ~ .0*x1 + .4*x2 + .1*c1 + .1*c2 +y1 ~ .1*m11 + .4*m12 + .0*m2 + .1*x1 + .0*x2 + .0*c1 + .0*c2 +y2 ~ .0*m11 + .0*m12 + .4*m2 + .0*x1 + .2*x2 + .0*c1 + .0*c2 +" +mod2 <- +" +m11 ~ .2*x1 + .0*x2 + .3*c1 + .1*c2 +m12 ~ .5*m11 + .0*x1 + .0*x2 + .0*c1 + .0*c2 +m2 ~ .0*x1 + .4*x2 + .1*c1 + .1*c2 +y1 ~ .1*m11 + .2*m12 + .0*m2 + .1*x1 + .0*x2 + .0*c1 + .0*c2 +y2 ~ .0*m11 + .0*m12 + .4*m2 + .0*x1 + .2*x2 + .0*c1 + .0*c2 +" +dat1 <- simulateData(model = mod1, sample.nobs = n1, seed = 1234) +dat2 <- simulateData(model = mod2, sample.nobs = n2, seed = 5678) +head(dat1) +dat1 <- as.data.frame(scale(dat, + center = c(-10, -5, -5, -5, -8, -5, -10, -5, -10), scale = FALSE)) +dat1 <- as.data.frame(scale(dat, + center = c(-10, -5, -5, -5, -8, -7, -12, -5, -10), scale = FALSE)) +mod <- +" +m11 ~ x1 + x2 + c1 + c2 +m12 ~ m11 + c1 + c2 +m2 ~ x1 + x2 + c1 + c2 +y1 ~ m11 + m12 + x1 + x2 + c1 + c2 +y2 ~ m2 + x1 + x2 + c1 + c2 +" +dat <- rbind(dat1, dat2) +dat$group <- rep(c("Group A", "Group B"), times = c(n1, n2)) +fit <- sem(mod, dat, group = "group") +summary(fit, rsquare = TRUE) +data_med_complicated_mg <- dat +usethis::use_data(data_med_complicated_mg, overwrite = TRUE) diff --git a/data/data_med_complicated_mg.rda b/data/data_med_complicated_mg.rda new file mode 100644 index 0000000000000000000000000000000000000000..ce652a6473d497d095079c959230b498a24e86f0 GIT binary patch literal 14681 zcmV-fIi|)!T4*^jL0KkKSqLYzfdCE8fB*mg|NsC0|NsC0|NsC0|NsC0|NsC0|NsC0 z|NsC0|Nr15-xPg&YggODd^+!2efQnxN7l9O_j$YB=e+l`)!y${tGxGnx2?B(-t*q~ zp1q#1?%l7u%f8$0vu}FyXT9$pjnee)WqaQ3+nVj~cfH--^4-h3q>r8NZY9pZ00000 z00000>UlH-$+Vb^XwVbX!fg|2Q}8C5VlWi_DdkVXFaarRCOiAD-2Bv69>823P zOidV!m|nKA=O=uFh~4GMTBCZ2*c(t2Pf0MG<5 z08EWE!fAj^nokoVY#M0OKu=9HGHEu9hK55@c`{%oDd=cvfiX1GQ)!h9pu|n4h{ID8 z6VR#nj0$>UU=tHe00hArGM<=dFqu=@GHHpXn3`zR^kgZq7@A@x+D#f5CYn!7BU95P z^*uDgO!Q4AVqlFKF(`#k#9%aNWB@b%Ko{-Zfm`yaH6Cwlz6GlT5CXAD5lL*sBh9JaGOjE=slRz{lh-B3C6A6)n zO%utWnqa5s$O*MQ8WUt?Fw;SkB5e%~Gy_S5#(+Zw2+ab$d5p+GK>#s;4Az-TnedL( zU<`-LK*S7bAq(6jxy%3nV?qgy>Z7;4wl90rP1=_jz}bBe5fw(*ajJ(gfB?-#FaQ`% zWdIwx00RIT++!FF1`rKkreF?DsOIVqjOfLQ&yRvf=x3mP(&DvC5Dum+z)YYx zXR!a3yloTORx^iPJm5eY;kK1w2$xQ%&<>^poB#`(9zdU3Kl{*+5EnrXGv?n@v&NSO3s&GCNd&0ATl4XWu{s+@Wm>5#p@dZ7dKpiAP4-&7 zkC|jZ2usQ+`pRBn822rG==7v>-gX>2z6A05uc+|$lNbzOHRN5anaO(D1&#`!ly^UB>D%z^lO|2SJkBD%M6R%iA1ZN6 z*U&o7e>s~Q$hqd$ravr+)BCdzML8U8(&>LzS-vBr1^kOX?R~MpJ*ir&*CqGqJ(lv{ zrpH~9gF5o1QK8?C@q8%^IL66Dw?sEr#jzA2|I-;_(=Lu%1EI3|wxCbywr)l&5V-F8 zZya)O_t!cE-rIA0o3Mo>vH&Ym?4-@9sF=*`Xt7knK3sHsyaUr7)y}cF@1Kigu>tkI zc=j{H*KbN2#&h;#Fyl!`$|Eg-_2fyqvH%17uy_#}5{$U{*gk9NNhfPJsO0?x{tQpE zi8w7M89==rWIU}oSUHwXI0sw@9&Rk3XJYu)u~c*a?;kAPQ#G%(hznO|v$M&%x-J9~ zghYg{jw73uwAj2Qj+$*!Ast3z&UB6lQg{SC&@ueX`R*2w@m19rr(cPK(|NELO|rRM z-@#_456kSU3r{K|(l4!pZGPLa3Ul3i*VZD{9e?*_QDV8(N)>aM`QD5}KZ(O1S~f)DY(s{K=QrpkO6_~y zpxiLOq8Rq0WVuR0k=pNdEXYU6GDyh?N**%qic?-jIgvWYe&OOlYmQ6@YlK(Amr;g^ z>;TsI1NNqL=dw|=&NdF4r~q}=){2|K=1(Iv0H9z+f-gzbvGidf)u;#O5))?JOj=V5 zZ#tg1&POn!R0e}QoJAUvKpWKmNc$JF`>B!YQ_6P=tVnWa^tR`*3ve@+TSYMud{a5BO|6MN9{y&)niD90 zxen@Y)l(PYmNRAXu$;hKnr~&zg66I${v91<5_YMuPF=LRfnpqa(pUv6C*=n$`tpg= zK4^Ggd(6175aS%7aX8ivoO*5Zy7%xpX}S1XH{X_UAvhuS4tc!lb3u28_3qe0I6V$e zrldWV?**^lWq&%f=oB|{R4xQllZeID!V=2$?8M-?3)f%u6}n-?jou=PuCb}*w7d4% zRBqci*d?lEj_{;Rq#i@G@t3T=xw_J(It2GAGh4O=F~l-!f(KS8d^8BZI)f@KLzIT|6-+{12H?BqB5_lpLb*;Qz@ymAZt z3gE^OdR`Bb5etR(|Mt<~EKZjgf9a5c@77yj?LqYr=Ix&S{ZlS%OW=40GX|yT#4uXk zOap3$SKKqT*MmNi_fDeS>f?1<{8EBEs zJkGZ>`7;M;g0oLEE$V+_+L&o$WS;_Td``1`I>Lo=%XEdSm@s|}i`N3{spZlgvDwgM z1bktXX>+xsVFEW*%d;cvZy+ZGt>}e*FK{#^XXd)P4HBxO|68ZM;T|(g0V@%6-Be+R zT&$n7wcFP3VJ5ZdZ!EDhIrnqOa@qb*)Z`!8>e3bx@EJ&F!m6#g3JF1;^^fp*6~}QH zXtoOvYjQemG{-a2=0hg8ENX}ADLE7VLbAbc+K!T|D+k0_?FV8m3Et9*LV))aHmN9e z#_JQ+kAWX?dQ`UR+1eQG_M40`HTjSs%1S{)TP6@eyNjMi_x}`tQ(Bg#eW~LcH;mbY zJ3|U#(7)Db@YCSQpHw(x#Iyjcn{Ja3pWSIS_i;tudSV-WoUwXMSCKs5IY%9dNpQr~ zz__P#c8Q$8H(uaSFpgag6%yR0I(}90X~VzgrRs7xNH{|szqaktp4OOZQt+a8WU{;Y)D)Q6idD&q;|!eP>x}J&slDn@ zaO>k4&b5;Re(7m3{Eo(N7#YDeW<2~14xWO!rLDD#lvc~Z#5~~N2*LeWtnfdZz!`F? zkxJB85d_(8JrQ}yBHGBsVnJC{_$CxF;fT7T2~$o3UBCD0RB|HW97etiyvErTZ-6&H zDi~SZ+C|Qg-LftYJ9B+;Z8UYgb^OIXdvrUJ?(jVkRlwfp+`+uJR8RZZ;nN>2zC8VH z;t)PAmMV1ca(=vbE$*lFOTj13#Z~5;F*s*2BtVG9c{8(5B@-o>w4UIwv-E6HMxX0I zWER+7o|SLAkl)jki7=Rz^+g)qKD{ny)&Q|r7O2(3j!ePg^l5{K_Ti{Q@F;d!k z)SdhO840!H!S#W%KRMUDlULFE{fW>?q27^t*>vUDK9tKJKfz*Z=Qgg7{t63k*DM{+ z96@0BJ0W^l$2-=!Jic&Fr$v=ax)QT6r!*^=24`Wx<8xTY!MmfYAErKMZsDO}p`^^0 z_rn96!oEhw&G3Vq+Xho!@~UK`4q1a&7k{GbX%+NddVd@p{-R}aHAeLda{YU|3<4Qv64EUOA)w9`WL>#VhHS+9RH___W5}Fj zN36i~B>5PI7qN2>H@3mRnUQzNs!8kR&XA4BD;Md`ag_~!(iIv?X`?E4YwuEuQg zPlX<%!ICuodq7Tp)${6QI}StBqV#jLhJ>kFA+izI+s-WN+0M*H{Wlv7Cl1EB^lwkp5suH_*{wz>b6w~)c7K{n;*E|$7yeDvsKj>Qf-PBV zL}fl%$^cwp%tzAEf_zv|_dXJBRq0Y7OmWggm}j*)d<{pN@nLW!94bXqD$f}&=LrLO zx<9JiF{Tgcqs&fdVawjdia5E)AaZCz1lKG!yg|qmaqV8%pSLgdAD9)6&@j3vyeE5y zo&;qSLb&=OZeUx5t&0C|36_m2mp*GTDgo+Rg6#P2@lb)&@^(l*Ylv`s7sO9lxJHDK zxt&oJW+U=dj`5(z!7K;)-y^?v`Y`b9d(4q5v=x1Su8 zex)gb+}5!6hMD9ptbW}8q*qq`7&7pjc`ez|=5@t*1bW=^-|Hpq6-ZPNkNksB@b@j) za)NhZ?%@rS9cShR&o&-;;4e%&icopGz1O_OPDh3fHZQV-Y_-Gd^2Ek3sQdCwitnFk z=on52Bc^WtWHla=(%1CIu4Wl!+?2&TZ&>a|Z$-iTYaTF9m@z#T_{=s%&+VI9%4J&oCDTmod-Q8yHpxq{J9qeS}5a0RRK37^&oDss&E{n5u8u!(+cG$tt}#vfiY-n$1n)L&_eFel0sp2m`tRK)MPPV%g?8$kRmKZF z=5#$?fuI0L00fKj(o9yUPaS^02u%QkW=P1E>Dx;m4fws z@!VY+2zfyfvwBIxf4nx_Qx#}(`^oQS4IpdsR?dI67=->iiBw71`bQ6aZ_V-%T;zl6+DI*7#aAd$J8PXNgHE#vng zj6j~n2Aa&}-tGywYPAWbM#{R=X=glBq_w4CoyqE76%hVnkD)oY=X{96Z@E>t_Wqzl z47BdyQrLtg)9;0SwQ@GH7xg8;ET0Bgdp`0<`^&)Ss@l}zfB+1D0Lh#I%`>}r2#tGk zm|riQon*WMyu#@5{CjQTrpoMGkEHw#7HNJ1@Qm1)askS0#)VdAq4(btGo~IyMCt-1 z@8Ac!I%{Q^zh8J_`XWwNhvDnO3*CmKqnK9Yeh*&=@AW^82(~EFR~XvE+;4-Grpt(~ zr=PV>{lmdEVH}eBx+HVd!jgaCroLk`Oqq0yQY zG?7RwJddF=vt+H#@9IqLJa_^p(`^l``-D$5byhXI=)OH$f$dxvf87atr}71Rqm6WeT^U*t^_7xCDbE3(n_zcWT&%zgCPw0ZhbPfA#HRy9B50j+ax ztC!qN#z$4W`~^H9W>k_6vOn{Zee7Fsq^5~PUvKvr;T>`&%pb_*hnOs5RsKTJ)sTD(qFjWqep@ z6m_i zZFb`qN8mQw5swZ68o^(-7nv*ilT}{gX(#xJ`Vlii1iSkHh5S2p07TN$GebB?S6}oG z`kG@Ow2*q;suhVyXrH^im+?`&NnG(uWEFP)?>9GmuP^W9lCbug%xI+}+G9zKoMV#O z-b;VtK*_sfU)@bn?hn;XGZ;DTJ7S=7MpXaDSJ~wmfgT6^x+5KAbXI8=pOVzs-!si3 zqEEAbVlr7xieJ}E=2(f3O}*p;rkrq55zSnE1=6Yz9~Q>SA#kzmpSfM84*$0jU*yKm`x@E8UBu~wb+NZi= zO-Q5Z&#MIpbVb!}p7wDVU)Jrze%n9nxcVXt0AK?~jFdZWX7hT6!yo0@s+F|2ej6Cn zx7~#w+8t?Q`jatx1AqYM00GX1O4LVZ-Z}K_4IkXPtoJ}^L1Nef;pFzq10G!H>Cq^^X++DoS18skfvJOxCbM?u&LE< zsJBV(R{QLQ1A64_$NJ4#$a6@KK2!hzNB{(agAh`7WE!-WA@HA+-(n?bACGx9HNE=j zIu)=>XNI){@*-Bx_cE7m;F3^qSzHzLaZdi@X@MEh#zp;0Tf*z;;JoJPvt9?whV!rr z?v<4`tzfT^tN)8z+p9JUd zy5^fb>lpw6kN_DbUgGLL6mkbMc*F4`MZ4`v&0i#L$WaCO6fDYj?w=V4?Mq!vTding z7%c{yCA%)~;l%k4iD#~}WH7+z*EJKcvLxs%+e8t41jI%`w%I?%xf$;fh9fKLd5ho@ zCo4qnYPngKlZ+9z2|#yVItxqli0(A&-zRpTp6|JsfzKvSZl#(OGo~iJs?Z=_0k)_A zwtr99u#SlYExUf8bHlONSDwSgYY}vZevKLJQu*#ZREz-mOX4ziK(zF4W(c(sR z-$KK>XqDYK^FpU8zU)PSxhIQ--fdOWg2sO=ksh1SAU~CPbbg2_JEXb1 zOp-y{UCmDB&%I!aB!dHU9)|0Yt;IpdVv?&M31S8oN8Naj05(Bb6|rXHeOuL)ai7zw z0KW$V$8~gOgt8xhm#mD~B~450*LC}ej^(lSeMHQydSdSXI12tMX^d?Q^^elTs_k%z zpBie-<6jX8oH5bx8z?jzI8tuR+}G@uG#8y}e|l1O%ZkkBW!?4Uft)R+C|s7lFN|5e z(@VDV(h|gw|Er-&%4qM>NQ(-!EphJF_zi~kN{w3C(?(Wp$hWx9C-=mjwEq%LqQbaZ zu83?wA8K0v7*t5I>tQeiNi|D$-f zB6=nN$pZ_~h*=EDKyOUo$wI?u_3s@ck9q~p+HmOCHP}(>8NiSRP;s-lmy6ST=$rA# zq2POzQ5$XEW{cp#-qgUi9R-KGrXD4Mg=I>5;^x`~zoM3ZD5ToQs5XBE2&$*O#$oxC zGif&!{QI)O{9k0qzsqGYq{|qO4@H=QXDa$_8RDT}5eUi!MITY;q@;ajcmV~A6q@lY zZOZWOX<^&<2$~)RGWn%Y*?YUNIKvI0xOSm0qdo2WRk1MTebe}aNXB)KT;KW=usZc= z&`(}qTR=QsnA2f9<6s>-J^hq@h`J`!Tan4(3YP04K-a$Ia|_2#=ajVcK_@RiY-v;L zem#E6hQb_%_wx!7hG|xMZ>d%kkF$uH+U{ZFsXI*FFExhLEOSqaRp(jFcy|EVZSR6h zRshvS`5?>EU$_49jMLkSZ)y%t?j<t5mc7E=gsZ zw3D6b{#u=5z^K(SdlRGxj*O3?m)6}=5md|BBegve(7}*mTWu&Os|I|{FxP+7-}6@< zB$=!j&qVdZrAWCa422mU8Q{&#jhv>2L9PMr)9l%^0OI zx+Px&i{1XoD2grC9>@8D{r?Ha+O;^#^>T9o>-TlY_7O_;68sm4;{kx`?=GHza7OvO zVJs##JAbnG!OCOXq&U#&Isgb^lZ(#+^>jS^J=!PtcLNc z{#ZEJL%E&L7u=6I#PaFU;03n7<`j;fEv@%0ZCQUHcyknVzYR>;;-0>5MD%vf_3R=H zPOI%kMHwa|RW#LZRG8b;qf%SEOKaA3&m z<)oO~0{#lg-9e`3CabD5nBAA--&;H;)Y#1!eki{{egiZRUV7ai|Hl#ss-R*U18AaN zWa<;ea^qhkvv*eW;dqh3&+ju6g&H-r)Ou8^;2pkYiyco}v&gr@p~}H{uWORU_-tL(L#VD>bSr6yuU!`yi*ADj`hg^L&IsAM(m;&A%j|%V2*eOip93rpT zT`gU?33p^|F3Ia0)vPv5p?rNilVoan1~lr8donk547YfYWpu09OlzFc;My{;v<3Oh zaf%(?ToI+f;z)ZtcviRwn+Lbg&T*E-F&c~-xQzLt$FVUPvM}Wo`9ZV>0>9-}65SN7 zZcT{4Gs8(QY}y`FOjmD6|6BQcRR1n(i3?j|GVgYItw;l*XED*1?1|6;?|AccbNq+{ zmOn#LK<9lX_P8=qtZusMF)xkVDRo^~BV4(BPo|V6^q_nzOVhe3R3Acv(&*Xm-DNCF zE-sK!gjJa;;oK_ae#e&IgGcZ8PTl5A1IZX%hU++aPU^|RH!R%6E`Fg7FG!l}PPb*u z4WRI3eR6)`r1K-!TuHO+_DQUAVeVW;X$F>zCypB*urCu;4bcbw^5@Z+&xgFPuC&Ms zC$xVjAcd2~f>k+{Vx>bJc4r!`>*9N1%Gqdzj=xT8_Lt8mIX^h@@R+X0puHa6;mNbodnPIcQzGS#eF!|h_E^YqW8p1!>QX2 zN{Sj?$Y&w)12D(Jvso;+lM{!{D{uZKY7g7YzzuYPL#=gKn`$DI#&0kiV_ovz?p#Dbo zyLqyl{OH!al2qje>e(f^IV6A8iX#%T%Qg=8Z(**dsKA;!Hg=1B#arXqzg=e@vQ0=x z)wLRXe4yA{00Wo@jFbGKX2Twduoefp^n4n@CV^RZbh0 zrDPJ_?U{P%J%P60%+F{bXjQVi2HD5lGvM>sq}h7%&zLR|^?TA%A# zlJhU#twx3~ig=Gt*_V%F7aoC&>&!>GLV3R>)tJr z7$OM}_I2u(vO^IH@a1$|Kw!ILSeYp8gT9P_dUphD!E4{TSBe#ua>6I4K)yxjO5)i< zOyS~vn3^5W!q;LacO52j?ka4U9fp^96cL@VfK|{MsmphVf}p!2%@;(|c*}dOAa|N9 zVH`yr7(o$rEZtbs@rOV%sNV8)&>WG{X`L2@+@6Jxq?QZMwgaY-XN;Q&g*w+zobpcC zMO=*Q0(g43r_B`Qx!PEG7nO)LnktaJ?txW_Lk&@8TM3 z*iCui)2ZuR>3-XXKLGk%dgab7b1(Bt2#80gF3ru zE{eyM75)!+)B4`<$b3H~J28xS>K$NE?cI4#Te3kz?1w>C-bnJ?cnWkdTvo6K8x%+% z!|yCAGzH6yEHtKV6k*x^Z}SnyrO!UAW6I5@_Tum)^cr$LzOyWE%X?FyrjaQIxJ*i< zcf0tjO>b6E^sTO5QMQz@(JwjEq4W1rZmda2CL8@^`(4EZ*Hxf?Y7bEY(WGX}KUWaD zPo600;a3OQ{imoK6Av|tJ|Sf0n#i`VOI*4?uCgjG-R#n4;?UN&hJ2Eoq{aJ-6kj_Pg!x_~>CohB1U$tV{Csd0pg}aY-tYJ@e^Km-rQbWjH0}%k zdQRL_ZbXIQFCYmxfBh+U!ig2u&n84p;MVJxR)GzHgW**`56b|JEz^;cMZ)k{!F0Il zW4)MLKRdvU-A>gUwT%;WTTEU?YT_!3_gl}HwlOZcv1vg68f;YYDLg3k9D&OLN-o>Trk_Jai@nn37MB5AGxOC{88n{E3rNj5hzz zm%fkS-!j4)Bgmo2I9%LV!Fshh-D?*$tvB2~<+sw2eI$j%$HHIbRxUKQX<3gtbS4#* zEb%$kA50GrI^5%^IB#pKLJ3d&TVX9U@_)>GSl8_*s{1`|#%EDfNL8AmPDhUkuabd? zRLY=yPAnyp7Ie=FGR(UHeKwj8EIEN4f7Wo{Yz+jUn1OnHq%rRV@VR2huK_h=D+llL zOvJ9zAX2J!;@xhmJFYm(uH?}xw0!n3yP+36315=be-F{{ZC_h|s!;32Wu4(EQsh=g zZ+YzcxPQTVAZ18T*m`WA<%ppLy@-yfJ=+$t!{OLlD%+@Mhvq#2E4u&MvPEvp-bukO|Riw~4kY!yX)N)5Zfxu&= zvhVG07enC5f9^!mFrL1)GU1j@XBE|Y7L77)%D#Miwd=AxNo83F1e+(5uR489;-BNG zR%=N}Kk1%zzs=`MZ#KIj1*@3)V&e7j9Xm%NK%{Qc=)N2y71@qW;KiXiY1Qcea%in^ z$0?S*o@5FTw8cKyn42I}Ln;*84Wk#qa)P_!P&{$o(t7Nj@3c!+P%>@q3P*K>q3TgM z65i18-09b5k4+FX0-r-V^uchS*7$rX_T1o%u5PAz2)=VFz$Ng7M@j24>F0CzCR2eP zr%Q28vZsbPNl`cXO8RJNON7RY)9(Uoe?&+^2Fm1}+-^CTP-K<(Bx9p_E7l67)ZfLA zZAu@eS`X%ymW_lAZmjKbW{|Z@( z0(Dl}N`#F&mi2d(T%DkEh^k}`vJ^Fnze|$G5dJim%}RPy<$Ty|<{e5^rR(bNxFtBf zZBL6HhL02q)G#C#Rsx`z+*t2jC68tKEDZm(G>MZpNTH1|7?u5i6w!iv^n-0Z0lS#f za1`qxs1wo0XNOa4s!l{Hp1;J?ss_quHCC~*YCZ=9dxm&X|I(IS-L$Vd1zeVoj#Ns9 z^=dM*ySuDzGE)(iQu&&-v#z&Ls??C&_@!0x=ig#mq1X6$EL>Vebr&_B8joR?gJ3Nh z!mP@q!O;lSGO8+clZwF22oO=FtY{1b&?=BoEMvJ=K|~_*x+FO6sMUKiI0zL6XuZ*& z4^aRGJTUr+!vzet&<+-LdgP)iKXCwEZ-Rlz(;EnqFiT}rz^>8QQ;v4}x7-k5Ddd4s zUr41f7!Y7N{r}SR98?C2Mic6A*6<*KOB3M9`mws3YK-LK6WM zv`{>-mh9#mxV=l!K<5>KPGarM=&fV;PWP!-J@+lLt#%K0wm`6mb~-22p~~kA;D*x3 zD6rGQm*OCbA=?SVujD^hStVP&pltjh*ak6tDwd1IT2aDguXXOB66|QSTe+=bpX<%3 zZ&%tt7YFk2TwnDpBQq+0Yg{z_3=F&~uR`S;hvaNGJp7h5YZ0`Fx7`29gr4V=&59jm zRqon#5lz_!9X1b8wl#>Z9(dGx2t7MKKf5VBo8zqqlPJJb2ODUGE+Q=96Y(mgb6wdp z)nIz{jg)O{B5Ap->iX8+8n-%ni@mm^ZC?z81N z@BS0W9zq}^9dw)OagrBlgWT_}1HY013M5Ga4GJ0D~=FRo@rSN9^OvL!h9F+0` zhw{T&BmY`tn0WKa92&GNvAk5A^XFl);ZW7!uF}69+Z#?FOZglv(_n9E;LGkXdiFp@kCCLF<^TeIEs=eT~HMDtwsk4bFja8trx%IAM0Vuk>Eb_CV&{rzd$J8nAVirq{1$#P%R$_c9D zA6+^ykPPhB3Z7TibiHrR$IHaV_`VCkyZYJeWzkLE)`#i&S0{(t#pgTs8#*kMM_tY_W+(FqP6#VzCQq`Pe(2vuk*xU+lD0MBAA~OnjTdz8tTj z{fYLj2+<2q-3Is9uxL?sEsZV)Ea{I|D50zfFsB3`!f>1Y2tN1PN7Z8*)NHs<$EX`b$U54yoClylL%|?)8L>qv z1Gg{fo(7wOW(7ojRBci)`1_0B{ID)C^6^*PIy(1t4j?P(pOB6i&~T7`aXg9atx>cM ziMA+KWLD7vaVX{0sUQZE+qFL_FXH@0wXXOdMmR^Wl`n-L`-h>_?`78|f$mx$(RcSC z#}^VI3hh@t?rSihcooThqzI1{25}l!Vn#@`f7KH-{ArihohYZeSo~r^Jh2FMh@(l; z>QadTd2IfVTlY_h@UUiAI2;I5xJILDA(X4js~?Oc+bd3S2|AkV6q2G69EgwzQx1f` zx>RxT(7n_IFUWzlfoX5@sB=ocg&=%yR~B*=eyIPg=S9lks2Fi;UiiZil;`t(DH}{I zuF+z_3{1>QkV%y}&LBMjp5;Ftgh4oW$m?=D!#<MW7!Y;{HD@*BgiaX(pu%d8)~|2OATeX>@$RF36m1x)t$nI}gCmuN$mbqt zfL!bld@#S90DyEY2gO%jlL!B2;Q#!&aMWK$L=e(vKN{3W#}>9wkOS-zT>#c}eS!oR zS=WJb;6f&+^jD+v^Jokcx8j+QHRJ>WFQnjqdapa4!inNbYuDbKCQ~fv3{AAJA`sPt z0HLnL8g`@v)>Z=^t-Cba9Kbtv97Zm3c@ywoqT3L>AIkUkATH?M>PZ}F!=G>^q#N1s zxehL-$uCN;2kP_NK1kiD3Y>s!`}&=a9W1bdgM1zW8Z>?`W)4#%g{W6WosLjzVi9)4 zk%1v@{~_XM(+X$(^4bwd2Ceghr*M;hP!$Z-DRGe|Ig7ahP6f^M_?us%6V?AKkH8%P z$R*~OoflH|oYzN09+HnzdCtjksS8S*l?0AY>t%qKpiK+mHpkcsCrE%t%3Z3B&5W|w zz7;3V;frr(46|d}6Ya-Na4o$lV0MHFOm`4}ZQISfR5o4DZR2G(vSEMLmUjhA#Tj4p z`;7P8n}D;d>2rArAFh@a3;<>b83+ew9*_?G2MOUZIcbvPQ_`lO4j8faH53*qCK3eI z4}Lf#A(!?P!T_TcJ*aX%H&=L+moDbX-%^Hodi|A2%alg}0cKN6p6Hma6}gA-T~49(F~FA$;liN5irYoHi+y_@jdFU9;~4n<{?zlK)fIw zcV~-A!hDc1gU>s+x~(iuP>dLn+Y7$h*nLMu=4+DCc2VzyhrvUI`&NIJpp5pRKnM_X z2#xR}5TVjo-cXP*nVtEdIo&Ub=B$@IG+7_Z+92JE-5H$f0UxPahomOirF=PUh#h$) z6d_Nkqe&OJm-X(#5ThcVx;1X%WN4;DahVbkxz!QF5lD0U1h5V{eKv!mIID~lzQKSb z1J@9rJlWVxk|l-AL*oKj^vA4o?y9o(e^O=*l9*1fu;~DU(HC4mF%2Y$ye;OjB!pT7 zDt>Jg>GTr0#WML-h;1Ww{&IVQCWMVu*?#DSw_ z0(Tf53HFpr@0>0B&y^upbuqGYn}Fmj4(n?Ed8D|hIb%?85x!+lzT2b}@z^bNQmL3n zv^NNR1h1aUZG`#du8(xpO&&ply)_@Y&%A&`mi*@t;0t-`{@wyXbsP}Fw-KcWp`{>x zVH?ZRmm(!d{>d9d>DHcMfug>;!<%)>fvZ_8A`W^2&~4Cpp5f!sTs&O7T&fHrq}#qy zBddW;wvA;51YqH2yjmoH7cMFRKC5JZOt-N*=Xe_06~8a!u*(5RJb9>*3?L1P2mOt$ zOI|)+*pnxm+t#7`yQo*-IF^z$L4J9!&FF9T`%fKkG5d+q3M0^rH)WaZ21TzAvGB^L zVY^at=vP7e1xu9sGokccWXL-#9n?3#KJ>>lgVOB!I9*anxo0*V<;ew|Q$|9<**)T@ z_^xR4OO*;EBGIeSB~l>YoZsEE`TNb6Ck>EP_f{5rIk-=gWjpqnWO;a7(}Rx3{Zog( z&k^obQ}A16z7KIflBSXfUlzP2ear6^X zEEv$X=zmOf5|3KNkM(be$|L*C1+z4O&Rh4?&_8d%jp=E)D{21`n!@}!p2VHq3!toF z!Qetoq=%ODP|*dF7;k&I^mmQCZ>_h#%adx9UKg$|c`o?((OUGc@8pK2|Cd}RZihK6 z7V)EN>@*@-*|u4pKXf?-diN^RhJa!l0wuYMRynF($L}HdE`7VPf?!j&ByiYBuC{y9 zOy7TRO^)P3{r=^a3C*j)>n`pJdD;_d7?i)E;#Q>JIN9_lL+zGQ0i86CZ>LhHJ91FW bOMMJ}0J~zi>NoaWKlrCeV literal 0 HcmV?d00001 diff --git a/man/data_med_complicated_mg.Rd b/man/data_med_complicated_mg.Rd new file mode 100644 index 00000000..c08ca082 --- /dev/null +++ b/man/data_med_complicated_mg.Rd @@ -0,0 +1,47 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/dat_5_mg.R +\docType{data} +\name{data_med_complicated_mg} +\alias{data_med_complicated_mg} +\title{Sample Dataset: A Complicated +Mediation Model With Two Groups} +\format{ +A data frame with 300 rows +and 5 variables: +\describe{ +\item{x1}{Predictor 1. Numeric.} +\item{x2}{Predictor 2. Numeric.} +\item{m11}{Mediator 1 in Path 1. Numeric.} +\item{m12}{Mediator 2 in Path 1. Numeric.} +\item{m2}{Mediator in Path 2. Numeric.} +\item{y1}{Outcome variable 1. Numeric.} +\item{y2}{Outcome variable 2. Numeric.} +\item{c1}{Control variable. Numeric.} +\item{c2}{Control variable. Numeric.} +\item{group}{Group variable. Character. 'Group A' or 'Group B'} +} +} +\usage{ +data_med_complicated_mg +} +\description{ +A mediation model with +two predictors, two pathways, and +two groups. +} +\examples{ +library(lavaan) +data(data_med_complicated_mg) +dat <- data_med_complicated_mg +mod <- +" +m11 ~ x1 + x2 + c1 + c2 +m12 ~ m11 + c1 + c2 +m2 ~ x1 + x2 + c1 + c2 +y1 ~ m11 + m12 + x1 + x2 + c1 + c2 +y2 ~ m2 + x1 + x2 + c1 + c2 +" +fit <- sem(mod, dat, group = "group") +summary(fit) +} +\keyword{datasets} From 9648342b28993652ced83448680997a1b101b1ee Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Sun, 31 Mar 2024 09:55:32 +0800 Subject: [PATCH 58/70] Add data_med_mg --- R/dat_2_med_mg.R | 32 ++++++++++++++++++++++ data-raw/test_data_2_med_mg.R | 49 ++++++++++++++++++++++++++++++++++ data/data_med_mg.rda | Bin 0 -> 10153 bytes man/data_med_mg.Rd | 42 +++++++++++++++++++++++++++++ 4 files changed, 123 insertions(+) create mode 100644 R/dat_2_med_mg.R create mode 100644 data-raw/test_data_2_med_mg.R create mode 100644 data/data_med_mg.rda create mode 100644 man/data_med_mg.Rd diff --git a/R/dat_2_med_mg.R b/R/dat_2_med_mg.R new file mode 100644 index 00000000..df121ad1 --- /dev/null +++ b/R/dat_2_med_mg.R @@ -0,0 +1,32 @@ +#' @title Sample Dataset: Simple +#' Mediation With Two Groups +#' +#' @description A simple mediation +#' model with two groups. +#' +#' @format A data frame with 100 rows +#' and 5 variables: +#' \describe{ +#' \item{x}{Predictor. Numeric.} +#' \item{m}{Mediator. Numeric.} +#' \item{y}{Outcome variable. Numeric.} +#' \item{c1}{Control variable. Numeric.} +#' \item{c2}{Control variable. Numeric.} +#' \item{group}{Group variable. Character. "Group A" or "Group B"} +#' } +#' +#' @examples +#' library(lavaan) +#' data(data_med_mg) +#' mod <- +#' " +#' m ~ c(a1, a2) * x + c1 + c2 +#' y ~ c(b1, b2) * m + x + c1 + c2 +#' a1b1 := a1 * b1 +#' a2b2 := a2 * b2 +#' abdiff := a2b2 - a1b1 +#' " +#' fit <- sem(mod, data_med_mg, fixed.x = FALSE, +#' group = "group") +#' parameterEstimates(fit) +"data_med_mg" diff --git a/data-raw/test_data_2_med_mg.R b/data-raw/test_data_2_med_mg.R new file mode 100644 index 00000000..cc3a7b96 --- /dev/null +++ b/data-raw/test_data_2_med_mg.R @@ -0,0 +1,49 @@ +# Generate data +library(lavaan) +set.seed(3143214) +n <- 100 +ivs <- MASS::mvrnorm(n, c(10, 2, 5), diag(3)) +x <- ivs[, 1] +c1 <- ivs[, 2] +c2 <- ivs[, 3] +m <- 10 + .9 * x + .2 * c1 - .2 * c2 + rnorm(n, 0, 1) +y <- 5 + .6 * m + .2 * x + .1 * c1 - .1 * c2 + rnorm(n, 0, 2) +dat <- data.frame(x, m, y, c1, c2) +head(dat) +colMeans(dat) +summary(lm_m <- lm(m ~ x + c1 + c2, dat)) +summary(lm_y <- lm(y ~ m + x + c1 + c2, dat)) +dat1 <- dat +n <- 150 +ivs <- MASS::mvrnorm(n, c(10, 2, 5), diag(3)) +x <- ivs[, 1] +c1 <- ivs[, 2] +c2 <- ivs[, 3] +m <- 10 + .4 * x + .2 * c1 - .2 * c2 + rnorm(n, 0, 1) +y <- 5 + .9 * m + .2 * x + .1 * c1 - .1 * c2 + rnorm(n, 0, 2) +dat <- data.frame(x, m, y, c1, c2) +head(dat) +colMeans(dat) +summary(lm_m <- lm(m ~ x + c1 + c2, dat)) +summary(lm_y <- lm(y ~ m + x + c1 + c2, dat)) +dat2 <- dat +dat1$group <- "Group A" +dat2$group <- "Group B" +dat <- rbind(dat1, dat2) +mod <- +" +m ~ c(a1, a2) * x + c1 + c2 +y ~ c(b1, b2) * m + x + c1 + c2 +a1b1 := a1 * b1 +a2b2 := a2 * b2 +abdiff := a2b2 - a1b1 +adiff := a2 - a1 +bdiff := b2 - b1 +" +fit <- sem(mod, dat, meanstructure = TRUE, fixed.x = FALSE, + group = "group") +parameterEstimates(fit)[41:45, ] +head(dat) +data_med_mg <- dat +usethis::use_data(data_med_mg, overwrite = TRUE) + diff --git a/data/data_med_mg.rda b/data/data_med_mg.rda new file mode 100644 index 0000000000000000000000000000000000000000..930e56f5af7c2803d03f2b217cc68e68fc7089f3 GIT binary patch literal 10153 zcmV;aCsx=(T4*^jL0KkKS+^OCTL2F~fB*mg|NsC0|NsC0|NsC0|NsC0|NsC0|NsC0 z|NsC0|Nr0_UjRBg>;T_(_kaKZ^V8p5KKH5JnikCM+Se7mXRPbl+wZq+eb?UY=WlJE zz3Z#HySJ9hox5e$_q)aKcV_kPcJ9r-?(LAN{(+-S5wvIpJWo>u^)fJ2_o=Dq^)#N0 znKWjBJqDA~Xk%3JW{Hy~Oh%e%v?iXDDt-i;O`s-I(9x3vAq-?RG-M4Ln9$QkiHVbF z3WikjWMn3215Fb(Jxl;hXc}sp0%@k0k5I%k(V>$jQ_-fIQHklIVWBXYJwwRIOf&`* z^)$j{Z5kRhgz%b;rU=t&9-zQe#WA4{CMJSqehQPZ88MRqsdRmVvMJdnW^e*Q`(vyqZ8E|Ce=MOo{{Q2k?MMfrZpNg)Y+uk zAwNn#Q__Y+WYa=1Pft@O6V)f^+D4dYG&E>vWj!!SnKWQP(t4+~6+E6MRQ;6G(J+rx z@>B4W$%=TB^w8AFl*XAbsq9Reo~G45Q+lSJni`%HX({;_nJM~@8m1@eQ`9=Aw8SPc zPYI?YNtrcI(<38I283kP*ve_C81cv^b-WrOce1jr>WweYHX*VPek;dsp+Zh z1dXZW)bfuBiW^N&YM!U+o<=4Tc$3uFr;+FaAk#@8fCWz&nM|HTMokf#Y3P*w8lI<< zNsNg$n3+eJBTQ+eFlkTHY>hNi%?6n!(3+k!(?Fi4hG`mNo&cB>-jaDR(G4(adJw^) zFcegMF6i(>+l5F5>VXjvG3c+zJ>NA0$O$z4E01UZhyZnlZ4nI9^Kdd@zB}P>10Z~I z$bbZVK!E@(M{q2vsECM(2!Q|q6qYR@Ak)eAFqUTm>5RX!TcygXyl8J&nFp>lgf#bY z)O+ye6!@ff&NEj_RC}NOBWOfnMCd4}+ON&_Uw-wOZMea0`jsuWWNfdMFU?5#R@Y*J zA(<~1;r?y-7*_*?M;CL9xX(!d_yBQWQQ*&KFjWrud#~j19jEgQrJ8K$k7tsw8?_Ug z6~+4z0mEIGC46qTAA)s}hW~xmXQkdVFP=YEmQCagIpW5|;J5X(&~a66;`nWwr4hTF z#r3F3sOUri00MmGo6Ps?H#kkznZzc)DeQjBX0UPGK2kNf_SZ(Ga7vZ2>*Rx4;yQ-` za*C_Wwn@8&M-d|00u^$vsYd0b>}Y884x4Tdxew2x^Sy@hTx?S*IUI%!A=SZeGyc=( zPZ<|P?^EkZT3Q;%jY|hd1-xMNkFbA(hRrSg*=eCxe<5adw~+cOCtadK1VloePl5rL znU-KmMpoqU!|?jI;XpW6tzd9Y`cB6_c$FB)T0jU7aW$jBl*_y9v|F;G3eIK$N=zlS z0ssK>KSjIVam)X79tQnsqu=9P;a?x*beIdn??Y83jl0iU+$HtBJ(K-5AIu_+dv?{- zGd}#UQQIZJpoMBPyByC@=5(@**48ag*{*$Z*h?8Wy6hB84MmSC?Xp<+>PzhFpEm1( zOJeeJsvk#R>`?5hW7ggE*?sM&ldgkzA8Gt!lzKe9ucrtdFQ>C;yW4`KQnFS;deYf8 z+!Q^V(qr})q;N|RK|uf~Yyu#3fPgC9Qsc=BPS{~o1pWXUk#b5!H5^`7tzLlW`=DG$ zf&1zK*y92>PL?WI3_o*$Z|);05IAT6vKH#0?^2=+=rHS<;9L_4__iLAtSl*XoUW>` zfNxA?;Mdf)YxM1CN?y%(GF^%5b37JWmc#EOL_}c%G8fN4_d_jNOzT?%OMv8dyS+$g z4zbYF|E74jZ)_I(T8`&=as@P`N}I1iY`;2zJ7izq0j6N9DNshwk(p+ExhbuWlw_?k z%$sSv@KjcHb3SH<4;co*wIi@<&azV^(_FcIw@0y|uZZMaqxtVKq-Bd^l+yod|F%`V zZ{2Q`nEc!M2-IlG?spd!V__|fK-GGt)&+LF5U9n3s$=KFb-PeDO(SA=}maAX5dwNOF=%UxdU-(1i=c>Rhb&JP&-m}*rR`8*= zO(y$@q9-Bx%ye$e#1sn1n&JXsd9$`&Cjv3G6ObvtbqzhbqH`y{$$iVMue&_;%wHDB z&)3wX+qI%I80F9yjPmK*^!u<x|-nuGh%vm1Thsjw~F*EzhtY-#_gH~9gv74 zxv}Ha(A#Iz<7+cKZi}~KU30{6P|Hq@g#``btn*ptM~}gt1j1y^E^cw#CzD%?>1PFu z+{JS}A6Cr01k`mboOO*|-Bi*wwTduAqjUUPG^2a_UnaID+msQn)C&x)mMN}#&%0a% z{BrA&@P>9Tw&xxWA1=s$x-SQj&BeIfolyfh zMNM4L)REGwjA!KQlFxX+ogt;{Y8k&bh^b!nom(KOGM_T0tfZ#GL5cjs%4k}duz{>< zFwm62>Y>@AI9Y#PnBpkT62!MMml>5wGQ&=N0x?!46D2Q2CgD^Li5o`CXYub@i+|KJ zVc)#YdKC6~w>JWse4>O;5yTV$?4$w3Uez$i@gk6*6{bAn|7&{(pNsWNWg914>i)gc z1}BM)X0VTpr{Qx^{eMLWE~O>PCETWukiJ3&#DRx6gU33JhFhY!yK8XK5qHMt4Ae=Z zAZv;N4H>n}Ptms=!W$acMIY}{zRo(;XoAc)rMNz_>_-ghjKR$walRDAVr*}ogJc>^ znyztk#6gsTHkoxnB4RSP{exXE9uwtg2huzqRgf}jp|{AnbNP@V4T$)=c8%*u@wv`q zpzuxe1YW+n%ajzP!;S@4Wt*dZtH@Ecah_4$H8n~H&O`Ik{}HMil<^v486v!`{ug=J zo51p1pxzzXy7QF<*o60rJY7^nKm3DdnMt?pmB|+o~r}fP-p4_wUM$8Y*Q(9@UQ?!2=Sbv``N*?Vd(<*?Ym} z`OY1A7GQ^>21tZQB{?MknkhhNiV3p9JOu>l*+8lw(wp%?-Zv=)0_an7ZeOH;JEVP8 zs-FQ6=5iHA|C+VrT1#>(%2AX}X}pwzehNf-&k2Y5HAcUKxI2(*SmYIRv-A;CSdHf3xX}!?T_iXVmu@thH zJVpf@&ez+lp3)Ogu9g_TEy~Gv-J_Nn@0HqeRzGRHrZP@2kFLSvRvdSC`~bXU;{cd6 zdin1>;DK^yg-q__O^?>%NUXCk*L4h&(=%0X{7wd^ITRT94M$(a0Ab7Jt5|IGz9vD10ZTDOH_CHmyNDO;(8!!iRr@?#n z_!R^NC+O6Xw}7IXXX4|ZJLD(ADomaAyZyU((udk%wjp(m{Q3@jOGLmDzc*}g%pWlQ zNRLX&yQa{J*&jBY>z_NCg#X=D3}9{Jv0Q(TEc;UOf#0v+R#&#?7=)MTQ7gZD=Dyhs zrtrk^d9p>zeyGG!5>({(Ogl_{LOuy*huiC}jd^L*Xe>E9d zzxl~QYTS*g&^~w8{lsDDCiXjazY>R7(xauqjAJ6FV$qwo>)5SOj7 z$Uh7^TPu%R!$dFExNVBP)gqK73G@J35Yd_T^D-cXqZfVgi2SLM`=$bqaG)uDk_v$T z6KgPY9ugzuQ2Cy&bnqj~xHl2l0l7I`k;r>m8OlFr4n%oR5}cU|_W!w6Ox-XP`!2S| zu`I_h-u!w zyplMHzs4^g^3UM$=)*5qCZy?!r)HQ(awvj{o@MzgJ(##n8ii|VMIB3wc9Mcf+rHJzVi7IXnL z&7#K5d=8N4;}v)CRpA{PcjME}ySKHLd7fKu(pfg48XI~!veqi?ufkG6o#Lvabutv< zcQmIKq$5rowx`SMFXh2Go&l(1N1erm>T}Q^H%6Jb50wss-`d4nE$%w~rm}oYMV};r znS^#xzZ$Xg7V$KQZgMp66zx-^$Fct&OX&V~-D#yKJTfMYuAsR*sqtkyaYuq4)$!XM zX@pex{(6#38PNp9aKDZ7#@!4~L#> zDY-!7r;OXiS*hu^hi=M;60^O{FtU;Kq0|Q$S1HINnXb+7^1)AoZlPVPae=N753Q4E zS%NUbHlgye$@|?+o@UdT(PjAj_$V=6`Isy8`;>?2qAm$EtURcJqicRmx1jfKg-KtY z3OVOjBVGNwwVq8P`ZaFZN!?qTnS*d~mnsPd?1a?_VtBhxsj=K1tXI+C9i@b`7RX@KmgkS2HANU zgIiL(aI}0Vd~CEaj7W}o8uN~YfoT8`AOQdaKG{=3hhlSJq4Ar1o{FfmUgyxuE2SCd zOHF<86TVJ8=|pM7p*6(udkvhW|Rg`T3~t z-R`NAGMa!3!5wCtJwThKYc$U@)-TNyY<_%vRMfWqE7A7r)^oP<$sH;2q*#k&bc-ba zFU(QE;}B23gG%lNw}F0SvBhSMsW_pB5F92dYCF{{&B>c1TlMq%{%V8#@XmdFl(CM& z_?nLxZwU5HjLO%3&2L%Yqy@0%l!l)Ttg)u`DyvUwQR^XIEvqHYb8oIJ6kWbiTuMhcS!?sDGyUN&>?Ze9RUwqTKjUJK}^(FcJGp9X+e_cAj{O-@7>V5%Z)D)aJ zmq#EVrz7xom6l?PzvEiL7U765r9?PbI0j#WljU%%>x{Qa1n?dm)UbtBHu*wnlT>g8 zMg`c;;cPmae=k{v=M59476Vk=9KW`r!pSiLww&cFnkxtviclnMR@yO}>m`y_2Xb5 z<-65XXmoHl?UIqn%1E2nv&MR8&%wCqJVnX{%;k;@cCtdfp@A&gKhI6L1Af^14a?7@ z;-9VoZRRHMI?pjt7jy&_IpsEo5SJBl#C2i4iZun|t3tz=j^s1deeSxM>W)bH3!Xfd z73mqsl|;PqPrWQx$N35J-?Lad-tMUGOBW|I zGT1y0(+&668iF<3@qYU^pXa_)GBr-6lEGOuTZU8aauG=UCC)%S`#!&Y&f@)T>g$r! zZw_yG9b%b&$?(JyeZ&FbVWHgu($AwL64UYA4wJF*jl9;+nlGdDsiy)rw2Ad&M7xI| z>q7+|s?QZcT0BGR2!L0>$VzB4phDF_!9WcIAlE5Bpx+k&9F|6Rq&mofZn(9>MRbxN zRIL#)=ZMIIc(*S^x>zrb|`VZv+1y)5jO&0MTB9c=#O=N+MOa-&INnQxo6?Ru&PW$T{99y`3UKA zY8IBKRLBwNN#py4TDQnmN0~JU7EWRF%hW^Lj2W8h{yvVdy?(bjRT{A$w&L(LM~{nL zO_NwJ!~z>{7G`dNWHKFyWSr>)&4fA82>b$x7vu)lIW?MrL>p4z7pU7(AP=MH8~O-l zX^PP8>%h}i^C5Nz8I-zdEV>~+n?*oY_#rx|R&BSt+=nHhwe8%XuyBCU6&XDva0PW` zGR~VXC>nsS(WpSzN)VjalZa-A(4TPN)i4mZ9tZ$V5+jr1Be5(trdsIJ7A$(WewRmw&(GT9+i%t;1PF+mwYH+H?4uYCTEb4>OOdJl;uZD6 zuQ8MAks1ccJgFhhOtvtI4Jb~bESyk63JkXksy{BhRp%6=xPjo;OG5n!+-9~v1Yi1_ z#ovOl_`t1zzJn9V*O$NE)0<{hmWYz|vHUPBtLU#|qm+gq2oL~)0tAN4<;)W#?P^n= zN}tMuDrAH;E@Q0~hjAk@(807bO(lT%wF{VzVyn2J1C8f{3XUcD+VMGOT(O{^n8He% zfOEvE@lr@C6(7;vpMvdnDC0YR8Szae*MjYC+}d)pTD?0Lq3R!In6`dZ1#MJFZA1DF z@KG|vu8Rt!%Tj-7vCQIeBuYA-gKgI`p%O*xZOAd(zTfL?>+B)4{93!cby)>T`=Wo zmn`Ox>y)UtQ-GfpQW#4kh(yYpH!Hm@@2uY%rQJP-BLwNE0s5?Kd^xeVG2QGYA#Xb3 zk-+jc;lY%uK|kfanO)`k(efd8SYaT#$u`m3h7EL^sh~u zla@NZn#vNOsQuLrrkOU9X_V=i8_mA&#GLr;jy~!s^$tiMXMW-Eo~W=~Bxhkx>saws z8T8K5js7B3F5wW^=5}(@XK-sMCM_e8`UG(r&0!5UD`urlEM1BLhLedfuRGxZB{J&Xq>HMT!i zeTi4DJ94sM8uEN8mC*7qhjh5wZwuCs;6|J=Hv-|Z(-MFHy|ctMXIW;xZU$asD?Q!e zUb+3NH&Xv)77w+LrO*1%-g|r7;gCs_$~a)Dyfa|c=qZ~xFBi+4nRycxcSd6>R~lmE z$iZa@!g0*yaa#Yq6YHAB*+cx6_4EHO$?v)#^{eSKFnSS2L>0ynVN^3Z7VWdd^8zOT zh3JK}B+Ixgda~udB@N3rXRr9H!6c%#Ebz4~-QG`kjmN8k?0q^T8<0HNip^=z$J&o9 zt)+1*A|3J8{i`+SO1SF$tY*C#@k|s_wY`?iZ639D7IxK!YcjzMPd@=YWpK2_uPE2^ zdiF2w9lna>8=++@Os~jI7!mYSY%<+j_dVKqEN>r9*G%1lpsrSVP0pu?0BdJhpT+4@ ziR(n#N=gPji%*`S@80S9vIHUuh0M-zI(zEcHR9-8JDIp%&;5<7SD{UN`goy%E2&cM zD>}uJH@eeB%XH%1Q>{+gae4_xTsm@R*2f3@1dHYNGL#?nUvV_M+o$w~KixgDefB~< zZ+^;$o%cA`!dnK!l!l`4HtMwmI!L~5%2*3L9obw-u5Hs`qhDyj|6J`CZjm-v$gHj61^6W>97YJPozRf;0~g3_{or!; zlV9r71Z2cZU_gnj8Kb6YNqhMwxvUHTbi`S0yBh3NL^eh`aueI%QSLSCZ zl-P_OJ6>F`f`6dY_K)1TX8v3I3vMYWN&a}5b$Fuu%ExN`E`tFZ0fXWHXCXQ?OVZf5 zp4pA&Dvyc}~!@jRmN4~*3 zS>HC)F*W`!+uE2|SV9+kuJwiRf;Ao%yCx&7v7dCehLa`A&xYT|*3igxC~9Q17lw%0 zmDuqjks!lqH}@UEjrV6cddbY|$d0ngg>ARH3)a(nQfU%&+4di$DOBvm<-6E zc+xx_9R;xw4nd`@C#&q*@%JnzF}FklXV>iO-yaV2I0{2;M836zy*+ zOdk(0{OfKwvz0uErmZP6j#I3gJJ$_|mHm!-aFuNUePh@hypv2xmnmUPP%dU!a(+HeiZ4)<(M;Yo(M&#ua0g>y9O= zDYX!8d@klMh+MUZLhgopk78bMoHZ6+`0rS!u%hi4FH~JIU?8^+^n+0`ez6W;rbOdr z2&KIHCK$xt3nj@W1#(J=*a`eRztNUQPL?f@SPX-;c__eETgu)_47g2>0(-^ax&Fn| zKZSx0Rx@3xMNzZ4!oCF!K`&&d2leBz5I4$k=}cUVPqlqgg+jaMHkhOg&Uj8M3XB=we!X#SGWXv?O_>c7hYpDM6U|KTH@%ZcT6e35ab`Zn9Rdk4u6L0Vj__@$ zBwR$ZWGd(?(C)5L&y^sxk%v1Pb=OJUBs_jjnH+D>0a7qbjbGGcTypMYOFV72e&&vQ zwa?S7vVz+2r0n2_NvdLoDB!2!efA)m%y3BVz)2@%;^ow@jdFOk#up6N@Z1n0GssDx z$zphj9?Xt1F7lp9R@LmsG7Whn_#h z-`MG!6ZluI10qlABrHd%UZ~@BPb`lPDk!`ZLNnKXF-EAswR*mLcE^EZ5@4KcFb(5q4ejb-nCv= zn@X$E#_}y*E|CY{80St~dJF;w28wyg-dL0H0|XdA(Z5}IG3tzIVWoF^D*Cpq9o#;C zE0-^8MC=N`h^lR1`pt5SqnthFPf*Ov5dDM~Q#M9b-C?B@VTwEla#ux-tiH^7p`zBr zoi*?fVfVoedYTyfj^L=ek4gw0GT1@kp4J=M%Tz`tT5lZXp9(EgBDwQ(D(B|5!%JP9 zZFpx_jy9DodFH!6q(lDpmUgdDOgcsJK7{-Wz8LMSLXnf_#y6R*Xk;XBe7ScRPCkO- zDfW4T>`)9=Up;2eYszALMO1syg;YoVO!>4teO4uT_x&?GTk`?sKfIoRsoNab)L3(hu9`mC(iu zyn)eCPbjU5MX9#lw;qhub{AkS_h~dT@ip$*DrI8(X<+0m z{|x>QIP)GV^x}7SBO>}jNTefe812;ds?rLVNTz@+y3ZkxCijjmO@N2~F%!=2l%Z zBeJKrT5-aDvO1E&68^sCL`^eiBZD#LeMD6bBfb#*Ujl)AvDD?$HM7`rqw4N7ST!yI z4leb$vdOUv%rM3l0?an=zJdSXuZ*NhqoIL)qFv9>7k@_2=v!_u-Ll0pqbYa8>je|D zy}#{br`F$GA9eW19kTpFGm9q?4*y!;A4T9EA60ZR+@$~_IW^1->FtYFzoI|j(3);s znE>5(uGd=7r&39)g!W-=)Ac-c7{o@MGJ9E#;?0m#b#k5U#Q>pL zce$2sFChVI@(c%mHx!|Sz^8QV3>rD&rEb(Lzut#5+;M8?bJUZV;-bQ7>2=hnN+5OV zakx$}_S>ob57eK9o))oNVnVg<+PF{0aA>pzPQ)Gp_0He@mQ;K%-%MOjbqHO2k(q6$ zA_l0$imd7le?S$Kj*srE{J#NjtGW>o)sfW?N9LIKv~(U>eHX#X`Ay2d4G z3Xn)s`ge#PDz1nelx3yOeI)b0Q8)HC{n!H1)X$FSVzDA7FvgM24Oak1{_7Wq*8NeL zpV{8pOjE=g36PJX#)`}sOQjMmqSXb5#BZSshXdEbh&aVx8!_&3E{UED@0l_P9zNn`a;38N( zyv#T~Rtrblk@I(0*1#|SzWL}A0fWrZDR#hj=X#9Y2d)iBuheibA}|RQ(Hi`{6V)tq z&-Ih}!uqVDN;5M%Ns5r6uOP6h4&JDbyLZWXIRr+I+k(~nzEXXru+!d|0{vb)fBsho z4tQ(l9Uy1`=yNYnxAUNea&p_@iK#FAu&+zmCon&IQ_a`DtHZlAd!H6N-pV?>wLP*Z zvufeufgWpFAQlPfKEjw^_6z3RAodn2d9Cn=Z!NGF%hH-Gs{RIoi76Q-GV_;mn*8<( z@Bx7|Wq1tM*r)nCCwC{(cH2UG-n6`pri0Gy{FMB^9ke-7XSjaP1HGg~riQE+La~a3@QrS*W-`auBI!fOE3z@!6O#ESl+{ zvzu9>26u05{L0{!Wz#Q%10n8s$lQ590|JIY?kxtFRsyB@@>2n9OEjo}4EIzCZ-R>j zP7f>^q%I1ewHO(Jkq5x{H5TEMFCyF?Sw#r(;ZqiJJoFcP0UyjIU@>uQi%_S(!$wME z;-Yz;>029OT`lc^th5$Rr&%Bx#%}&8i7!KHpMKMcuw5&B5oB-pMoJ3rVB&&z Date: Sun, 31 Mar 2024 10:08:44 +0800 Subject: [PATCH 59/70] Doc indirect_effect for multigroup models Checks and build_site() passed. --- R/cond_indirect.R | 28 ++++++++++++++++++++++++++++ man/cond_indirect.Rd | 27 +++++++++++++++++++++++++++ 2 files changed, 55 insertions(+) diff --git a/R/cond_indirect.R b/R/cond_indirect.R index c5252e32..84827e4e 100644 --- a/R/cond_indirect.R +++ b/R/cond_indirect.R @@ -690,6 +690,34 @@ cond_indirect <- function(x, #' @export #' +#' @examples +#' +#' # Multigroup model with indirect effects +#' +#' dat <- data_med_mg +#' mod <- +#' " +#' m ~ x + c1 + c2 +#' y ~ m + x + c1 + c2 +#' " +#' fit <- sem(mod, dat, meanstructure = TRUE, fixed.x = FALSE, se = "none", baseline = FALSE, +#' group = "group") +#' +#' # If a model has more than one group, +#' # the argument 'group' must be set. +#' ind1 <- indirect_effect(x = "x", +#' y = "y", +#' m = "m", +#' fit = fit, +#' group = "Group A") +#' ind1 +#' ind2 <- indirect_effect(x = "x", +#' y = "y", +#' m = "m", +#' fit = fit, +#' group = 2) +#' ind2 +#' #' @describeIn cond_indirect Compute the #' indirect effect. A wrapper of #' [cond_indirect()]. Can be used when diff --git a/man/cond_indirect.Rd b/man/cond_indirect.Rd index 538301e5..96ec3c6e 100644 --- a/man/cond_indirect.Rd +++ b/man/cond_indirect.Rd @@ -609,6 +609,33 @@ cond_indirect_effects(x = "x", y = "y", m = "m1", wlevels = w1levels, fit = fit) +# Multigroup model with indirect effects + +dat <- data_med_mg +mod <- +" +m ~ x + c1 + c2 +y ~ m + x + c1 + c2 +" +fit <- sem(mod, dat, meanstructure = TRUE, fixed.x = FALSE, se = "none", baseline = FALSE, + group = "group") + +# If a model has more than one group, +# the argument 'group' must be set. +ind1 <- indirect_effect(x = "x", + y = "y", + m = "m", + fit = fit, + group = "Group A") +ind1 +ind2 <- indirect_effect(x = "x", + y = "y", + m = "m", + fit = fit, + group = 2) +ind2 + + # Examples for many_indirect_effects(): library(lavaan) From 896ffd4d2534bde726ac1ebe6ba04daa03da3c60 Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Sun, 31 Mar 2024 14:02:47 +0800 Subject: [PATCH 60/70] Add .vscode to .Rbuiildignore --- .Rbuildignore | 3 ++- .vscode/settings.json | 5 +++++ 2 files changed, 7 insertions(+), 1 deletion(-) create mode 100644 .vscode/settings.json diff --git a/.Rbuildignore b/.Rbuildignore index 6516e16a..f769702b 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -5,4 +5,5 @@ ^\.github$ ^data-raw$ ^rebuild_vignettes.R$ -^\.lintr$ \ No newline at end of file +^\.lintr$ +^\.vscode$ \ No newline at end of file diff --git a/.vscode/settings.json b/.vscode/settings.json new file mode 100644 index 00000000..5270aa4f --- /dev/null +++ b/.vscode/settings.json @@ -0,0 +1,5 @@ +{ + "cSpell.words": [ + "Multigroup" + ] +} \ No newline at end of file From 04c5e8ec3cf9ddb5c18c6dd28acf58fdee09bf03 Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Sun, 31 Mar 2024 14:18:40 +0800 Subject: [PATCH 61/70] Doc many_indirect_effects and friends: multigroup support Checks and build_site() passed. --- R/cond_indirect.R | 72 +++++++++++++++++++++++++++++++++++++------- man/cond_indirect.Rd | 71 ++++++++++++++++++++++++++++++++++++------- 2 files changed, 121 insertions(+), 22 deletions(-) diff --git a/R/cond_indirect.R b/R/cond_indirect.R index 84827e4e..ceb468ff 100644 --- a/R/cond_indirect.R +++ b/R/cond_indirect.R @@ -104,6 +104,37 @@ #' as `R`, `seed`, and `parallel` will #' be ignored. #' +#' ## Multigroup Models +#' +#' Since Version 0.1.14.2, support for +#' multigroup models is added for models +#' fitted by `lavaan`. Both bootstrapping +#' and Monte Carlo confidence intervals +#' are supported. When used on +#' a multigroup model: +#' +#' - For [cond_indirect()] and +#' [indirect_effect()], users need to +#' specify the `group` argument +#' (by number or label). When using +#' [cond_indirect_effects()], if +#' `group` is not set, all groups wil +#' be used and the indirect effect +#' in each group will be computed, +#' kind of treating group as a moderator. +#' +#' - For [many_indirect_effects()], +#' the paths can be generated from a +#' multigroup models. +#' +#' - Currently, [cond_indirect_effects()] +#' does not support a multigroup model +#' with moderators on the path selected. +#' The function [cond_indirect()] does +#' not have this limitation but users +#' need to manually specify the desired +#' value of the moderator(s). +#' #' @return [indirect_effect()] and #' [cond_indirect()] return an #' `indirect`-class object. @@ -113,8 +144,7 @@ #' #' These two classes of objects have #' their own print methods for printing -#' the results (see [print.indirect()] -#' and [print.cond_indirect_effects()]). +#' the results (see [print.indirect()] and [print.cond_indirect_effects()]). #' They also have a `coef` method for #' extracting the estimates #' ([coef.indirect()] and @@ -212,7 +242,7 @@ #' `TRUE`, `boot_out` is `NULL`, and #' bootstrap standard errors not #' requested if `fit` is a -#' [lavaan-class] object, this function +#' [lavaan::lavaan-class] object, this function #' will do bootstrapping on `fit`. `R` #' is the number of bootstrap samples. #' Default is 100. For Monte Carlo @@ -370,23 +400,23 @@ #' @param group Either the group number #' as appeared in the [summary()] #' or [lavaan::parameterEstimates()] -#' output of an `lavaan`-class object, +#' output of a [lavaan::lavaan-class] object, #' or the group label as used in -#' the `lavaan`-class object. +#' the [lavaan::lavaan-class] object. #' Used only when the number of #' groups is greater than one. Default -#' is NULL. +#' is `NULL`. #' #' @param groups Either a vector of #' group numbers #' as appeared in the [summary()] #' or [lavaan::parameterEstimates()] -#' output of an `lavaan`-class object, +#' output of a [lavaan::lavaan-class] object, #' or a vector of group labels as used in -#' the `lavaan`-class object. +#' the [lavaan::lavaan-class] object. #' Used only when the number of #' groups is greater than one. Default -#' is NULL. +#' is `NULL`. #' #' @seealso [mod_levels()] and #' [merge_mod_levels()] for generating @@ -1302,18 +1332,38 @@ cond_indirect_effects <- function(wlevels, #' " #' fit <- sem(mod, data_serial_parallel, #' fixed.x = FALSE) -#' #' # All indirect paths from x to y #' paths <- all_indirect_paths(fit, #' x = "x", #' y = "y") #' paths -#' #' # Indirect effect estimates #' out <- many_indirect_effects(paths, #' fit = fit) #' out #' +#' # Multigroup models +#' +#' data(data_med_complicated_mg) +#' mod <- +#' " +#' m11 ~ x1 + x2 + c1 + c2 +#' m12 ~ m11 + c1 + c2 +#' m2 ~ x1 + x2 + c1 + c2 +#' y1 ~ m11 + m12 + x1 + x2 + c1 + c2 +#' y2 ~ m2 + x1 + x2 + c1 + c2 +#' " +#' fit <- sem(mod, data_med_complicated_mg, group = "group") +#' summary(fit) +#' +#' paths <- all_indirect_paths(fit, +#' x = "x1", +#' y = "y1") +#' paths +#' # Indirect effect estimates for all paths in all groups +#' out <- many_indirect_effects(paths, +#' fit = fit) +#' out #' #' @export #' diff --git a/man/cond_indirect.Rd b/man/cond_indirect.Rd index 96ec3c6e..03bd6357 100644 --- a/man/cond_indirect.Rd +++ b/man/cond_indirect.Rd @@ -190,7 +190,7 @@ them from \code{fit}.} \code{TRUE}, \code{boot_out} is \code{NULL}, and bootstrap standard errors not requested if \code{fit} is a -\linkS4class{lavaan} object, this function +\link[lavaan:lavaan-class]{lavaan::lavaan} object, this function will do bootstrapping on \code{fit}. \code{R} is the number of bootstrap samples. Default is 100. For Monte Carlo @@ -311,12 +311,12 @@ and \code{mc_ci}.} \item{group}{Either the group number as appeared in the \code{\link[=summary]{summary()}} or \code{\link[lavaan:parameterEstimates]{lavaan::parameterEstimates()}} -output of an \code{lavaan}-class object, +output of a \link[lavaan:lavaan-class]{lavaan::lavaan} object, or the group label as used in -the \code{lavaan}-class object. +the \link[lavaan:lavaan-class]{lavaan::lavaan} object. Used only when the number of groups is greater than one. Default -is NULL.} +is \code{NULL}.} \item{wlevels}{The output of \code{\link[=merge_mod_levels]{merge_mod_levels()}}, or the @@ -401,12 +401,12 @@ moderators. Default is \code{list()}.} group numbers as appeared in the \code{\link[=summary]{summary()}} or \code{\link[lavaan:parameterEstimates]{lavaan::parameterEstimates()}} -output of an \code{lavaan}-class object, +output of a \link[lavaan:lavaan-class]{lavaan::lavaan} object, or a vector of group labels as used in -the \code{lavaan}-class object. +the \link[lavaan:lavaan-class]{lavaan::lavaan} object. Used only when the number of groups is greater than one. Default -is NULL.} +is \code{NULL}.} \item{...}{For \code{\link[=many_indirect_effects]{many_indirect_effects()}}, these are arguments to be passed to @@ -424,8 +424,7 @@ these are arguments to be passed to These two classes of objects have their own print methods for printing -the results (see \code{\link[=print.indirect]{print.indirect()}} -and \code{\link[=print.cond_indirect_effects]{print.cond_indirect_effects()}}). +the results (see \code{\link[=print.indirect]{print.indirect()}} and \code{\link[=print.cond_indirect_effects]{print.cond_indirect_effects()}}). They also have a \code{coef} method for extracting the estimates (\code{\link[=coef.indirect]{coef.indirect()}} and @@ -540,6 +539,36 @@ If \code{boot_out} or \code{mc_out} is set, arguments such as \code{R}, \code{seed}, and \code{parallel} will be ignored. +\subsection{Multigroup Models}{ + +Since Version 0.1.14.2, support for +multigroup models is added for models +fitted by \code{lavaan}. Both bootstrapping +and Monte Carlo confidence intervals +are supported. When used on +a multigroup model: +\itemize{ +\item For \code{\link[=cond_indirect]{cond_indirect()}} and +\code{\link[=indirect_effect]{indirect_effect()}}, users need to +specify the \code{group} argument +(by number or label). When using +\code{\link[=cond_indirect_effects]{cond_indirect_effects()}}, if +\code{group} is not set, all groups wil +be used and the indirect effect +in each group will be computed, +kind of treating group as a moderator. +\item For \code{\link[=many_indirect_effects]{many_indirect_effects()}}, +the paths can be generated from a +multigroup models. +\item Currently, \code{\link[=cond_indirect_effects]{cond_indirect_effects()}} +does not support a multigroup model +with moderators on the path selected. +The function \code{\link[=cond_indirect]{cond_indirect()}} does +not have this limitation but users +need to manually specify the desired +value of the moderator(s). +} +} } \section{Functions}{ \itemize{ @@ -649,18 +678,38 @@ y ~ m12 + m2 + m11 + x + c1 + c2 " fit <- sem(mod, data_serial_parallel, fixed.x = FALSE) - # All indirect paths from x to y paths <- all_indirect_paths(fit, x = "x", y = "y") paths - # Indirect effect estimates out <- many_indirect_effects(paths, fit = fit) out +# Multigroup models + +data(data_med_complicated_mg) +mod <- +" +m11 ~ x1 + x2 + c1 + c2 +m12 ~ m11 + c1 + c2 +m2 ~ x1 + x2 + c1 + c2 +y1 ~ m11 + m12 + x1 + x2 + c1 + c2 +y2 ~ m2 + x1 + x2 + c1 + c2 +" +fit <- sem(mod, data_med_complicated_mg, group = "group") +summary(fit) + +paths <- all_indirect_paths(fit, + x = "x1", + y = "y1") +paths +# Indirect effect estimates for all paths in all groups +out <- many_indirect_effects(paths, + fit = fit) +out } \seealso{ From d4e015c124357a51cfdbc7e03e025ce6ae5afc20 Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Sun, 31 Mar 2024 14:28:48 +0800 Subject: [PATCH 62/70] Doc all_indirect_paths for multigroup models Checks and build_site() passed --- R/all_indirect_paths.R | 43 ++++++++++++++++++++++++++++++++++++--- man/all_indirect_paths.Rd | 43 ++++++++++++++++++++++++++++++++++++--- 2 files changed, 80 insertions(+), 6 deletions(-) diff --git a/R/all_indirect_paths.R b/R/all_indirect_paths.R index e622d70c..eb7e6170 100644 --- a/R/all_indirect_paths.R +++ b/R/all_indirect_paths.R @@ -7,6 +7,17 @@ #' @details It makes use of [igraph::all_simple_paths()] #' to identify paths in a model. #' +#' ## Multigroup Models +#' +#' Since Version 0.1.14.2, support for +#' multigroup models has been added for models +#' fitted by `lavaan`. If a model has more +#' than one group and `group` is not +#' specified, than paths in all groups +#' will be returned. If `group` is +#' specified, than only paths in the +#' selected group will be returned. +#' #' @return #' [all_indirect_paths()] returns #' a list of the class `all_paths`. Each argument is a @@ -52,12 +63,12 @@ #' @param group Either the group number #' as appeared in the [summary()] #' or [lavaan::parameterEstimates()] -#' output of an `lavaan`-class object, +#' output of a [lavaan::lavaan-class] object, #' or the group label as used in -#' the `lavaan`-class object. +#' the [lavaan::lavaan-class] object. #' Used only when the number of #' groups is greater than one. Default -#' is NULL. If not specified by the model +#' is `NULL`. If not specified by the model #' has more than one group, than paths #' that appears in at least one group #' will be included in the output. @@ -98,6 +109,32 @@ #' out3 #' names(out3) #' +#' # Multigroup models +#' +#' data(data_med_complicated_mg) +#' mod <- +#' " +#' m11 ~ x1 + x2 + c1 + c2 +#' m12 ~ m11 + c1 + c2 +#' m2 ~ x1 + x2 + c1 + c2 +#' y1 ~ m11 + m12 + x1 + x2 + c1 + c2 +#' y2 ~ m2 + x1 + x2 + c1 + c2 +#' " +#' fit <- sem(mod, data_med_complicated_mg, group = "group") +#' summary(fit) +#' +#' all_indirect_paths(fit, +#' x = "x1", +#' y = "y1") +#' all_indirect_paths(fit, +#' x = "x1", +#' y = "y1", +#' group = 1) +#' all_indirect_paths(fit, +#' x = "x1", +#' y = "y1", +#' group = "Group B") +#' #' @describeIn all_indirect_paths Enumerate all indirect paths. #' #' @order 1 diff --git a/man/all_indirect_paths.Rd b/man/all_indirect_paths.Rd index 4d113670..136ceb1b 100644 --- a/man/all_indirect_paths.Rd +++ b/man/all_indirect_paths.Rd @@ -45,12 +45,12 @@ included in the search.} \item{group}{Either the group number as appeared in the \code{\link[=summary]{summary()}} or \code{\link[lavaan:parameterEstimates]{lavaan::parameterEstimates()}} -output of an \code{lavaan}-class object, +output of a \link[lavaan:lavaan-class]{lavaan::lavaan} object, or the group label as used in -the \code{lavaan}-class object. +the \link[lavaan:lavaan-class]{lavaan::lavaan} object. Used only when the number of groups is greater than one. Default -is NULL. If not specified by the model +is \code{NULL}. If not specified by the model has more than one group, than paths that appears in at least one group will be included in the output.} @@ -79,6 +79,17 @@ and \code{m}, to be used by \code{indirect_effect()}. \details{ It makes use of \code{\link[igraph:all_simple_paths]{igraph::all_simple_paths()}} to identify paths in a model. +\subsection{Multigroup Models}{ + +Since Version 0.1.14.2, support for +multigroup models has been added for models +fitted by \code{lavaan}. If a model has more +than one group and \code{group} is not +specified, than paths in all groups +will be returned. If \code{group} is +specified, than only paths in the +selected group will be returned. +} } \section{Functions}{ \itemize{ @@ -119,6 +130,32 @@ out3 <- all_indirect_paths(fit, exclude = c("c1", "c2"), out3 names(out3) +# Multigroup models + +data(data_med_complicated_mg) +mod <- +" +m11 ~ x1 + x2 + c1 + c2 +m12 ~ m11 + c1 + c2 +m2 ~ x1 + x2 + c1 + c2 +y1 ~ m11 + m12 + x1 + x2 + c1 + c2 +y2 ~ m2 + x1 + x2 + c1 + c2 +" +fit <- sem(mod, data_med_complicated_mg, group = "group") +summary(fit) + +all_indirect_paths(fit, + x = "x1", + y = "y1") +all_indirect_paths(fit, + x = "x1", + y = "y1", + group = 1) +all_indirect_paths(fit, + x = "x1", + y = "y1", + group = "Group B") + } \seealso{ \code{\link[=indirect_effect]{indirect_effect()}}, \code{\link[=lm2list]{lm2list()}}. From af7d1ed4bc85151a21a227e04fde71128d193e4e Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Sun, 31 Mar 2024 14:28:52 +0800 Subject: [PATCH 63/70] Fix typo --- R/cond_indirect.R | 2 +- man/cond_indirect.Rd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/cond_indirect.R b/R/cond_indirect.R index ceb468ff..42c1778d 100644 --- a/R/cond_indirect.R +++ b/R/cond_indirect.R @@ -107,7 +107,7 @@ #' ## Multigroup Models #' #' Since Version 0.1.14.2, support for -#' multigroup models is added for models +#' multigroup models has been added for models #' fitted by `lavaan`. Both bootstrapping #' and Monte Carlo confidence intervals #' are supported. When used on diff --git a/man/cond_indirect.Rd b/man/cond_indirect.Rd index 03bd6357..01850916 100644 --- a/man/cond_indirect.Rd +++ b/man/cond_indirect.Rd @@ -542,7 +542,7 @@ be ignored. \subsection{Multigroup Models}{ Since Version 0.1.14.2, support for -multigroup models is added for models +multigroup models has been added for models fitted by \code{lavaan}. Both bootstrapping and Monte Carlo confidence intervals are supported. When used on From bc78cd00f1917ebe931174a4305d7a5e59779189 Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Sun, 31 Mar 2024 14:34:14 +0800 Subject: [PATCH 64/70] Do do_boot and do_mc for multigroups Check and built_site() passed --- R/do_boot.R | 9 +++++++++ R/do_mc.R | 5 +++++ man/do_boot.Rd | 9 +++++++++ man/do_mc.Rd | 6 ++++++ 4 files changed, 29 insertions(+) diff --git a/R/do_boot.R b/R/do_boot.R index 193e2466..02370b1c 100644 --- a/R/do_boot.R +++ b/R/do_boot.R @@ -34,6 +34,15 @@ #' [lm2boot_out()], [fit2boot_out()], or #' [fit2boot_out_do_boot()]. #' +#' ## Multigroup Models +#' +#' Since Version 0.1.14.2, support for +#' multigroup models has been added for models +#' fitted by `lavaan`. The implementation +#' of bootstrapping is identical to +#' that used by `lavaan`, with resampling +#' done within each group. +#' #' @return A `boot_out`-class object #' that can be used for the `boot_out` #' argument of diff --git a/R/do_mc.R b/R/do_mc.R index 136fabe6..655603c8 100644 --- a/R/do_mc.R +++ b/R/do_mc.R @@ -38,6 +38,11 @@ #' estimates is used in all subsequent #' analysis. #' +#' ## Multigroup Models +#' +#' Since Version 0.1.14.2, support for +#' multigroup models has been added for models +#' fitted by `lavaan`. #' #' @return A `mc_out`-class object #' that can be used for the `mc_out` diff --git a/man/do_boot.Rd b/man/do_boot.Rd index d7a53b7c..e16294f6 100644 --- a/man/do_boot.Rd +++ b/man/do_boot.Rd @@ -105,6 +105,15 @@ It determines the type of the fit object automatically and then calls \code{\link[=lm2boot_out]{lm2boot_out()}}, \code{\link[=fit2boot_out]{fit2boot_out()}}, or \code{\link[=fit2boot_out_do_boot]{fit2boot_out_do_boot()}}. +\subsection{Multigroup Models}{ + +Since Version 0.1.14.2, support for +multigroup models has been added for models +fitted by \code{lavaan}. The implementation +of bootstrapping is identical to +that used by \code{lavaan}, with resampling +done within each group. +} } \examples{ data(data_med_mod_ab1) diff --git a/man/do_mc.Rd b/man/do_mc.Rd index b6cf824b..e1fc4320 100644 --- a/man/do_mc.Rd +++ b/man/do_mc.Rd @@ -103,6 +103,12 @@ each call to that the same set of Monte Carlo estimates is used in all subsequent analysis. +\subsection{Multigroup Models}{ + +Since Version 0.1.14.2, support for +multigroup models has been added for models +fitted by \code{lavaan}. +} } \section{Functions}{ \itemize{ From 2b8c89f519bd49b41641cd5dcb9b9851c3d35bd4 Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Sun, 31 Mar 2024 14:46:53 +0800 Subject: [PATCH 65/70] Doc math operator for multigroup models Check and build_site() passed --- R/cond_indirect_effects_math.R | 57 +++++++++++++++++++++++++++++++--- man/math_indirect.Rd | 57 +++++++++++++++++++++++++++++++--- 2 files changed, 106 insertions(+), 8 deletions(-) diff --git a/R/cond_indirect_effects_math.R b/R/cond_indirect_effects_math.R index daa44636..bfdde11e 100644 --- a/R/cond_indirect_effects_math.R +++ b/R/cond_indirect_effects_math.R @@ -10,8 +10,7 @@ #' and `-` operator are supported. These #' operators can be used to estimate and #' test a function of effects between -#' the same pair of variables but along -#' different paths. +#' the same pair of variables. #' #' For example, they can be used to #' compute and test the total effects @@ -28,8 +27,7 @@ #' the same variable, #' #' 2. the two paths do not end at the -#' same variable, (c) a path appears in -#' both objects, +#' same variable, #' #' 3. moderators are involved but they #' are not set to the same values in @@ -42,6 +40,28 @@ #' estimates stored in #' `mc_out`, if any, are not identical. #' +#' ## Multigroup Models +#' +#' Since Version 0.1.14.2, support for +#' multigroup models has been added for models +#' fitted by `lavaan`. Both bootstrapping +#' and Monte Carlo confidence intervals +#' are supported. These operators can +#' be used to compute and test the +#' difference of an indirect effect +#' between two groups. This can also +#' be used to compute and test the +#' difference between a function of +#' effects between groups, for example, +#' the total indirect effects between +#' two groups. +#' +#' The operators are flexible and allow +#' users to do many possible computations. +#' Therefore, users need to make sure +#' that the function of effects is +#' meaningful. +#' #' @return An 'indirect'-class object #' with a list of effects stored. See #' [indirect_effect()] on details for @@ -91,6 +111,35 @@ NULL #' out123 #' coef(out1) + coef(out2) + coef(out3) #' +#' # Multigroup model with indirect effects +#' +#' dat <- data_med_mg +#' mod <- +#' " +#' m ~ x + c1 + c2 +#' y ~ m + x + c1 + c2 +#' " +#' fit <- sem(mod, dat, meanstructure = TRUE, fixed.x = FALSE, se = "none", baseline = FALSE, +#' group = "group") +#' +#' # If a model has more than one group, +#' # the argument 'group' must be set. +#' ind1 <- indirect_effect(x = "x", +#' y = "y", +#' m = "m", +#' fit = fit, +#' group = "Group A") +#' ind1 +#' ind2 <- indirect_effect(x = "x", +#' y = "y", +#' m = "m", +#' fit = fit, +#' group = 2) +#' ind2 +#' +#' # Compute the difference in indirect effects between groups +#' ind2 - ind1 +#' #' @export `+.indirect` <- function(e1, e2) { plusminus(e1, e2, op = "+") diff --git a/man/math_indirect.Rd b/man/math_indirect.Rd index 6f27b1b6..18a57091 100644 --- a/man/math_indirect.Rd +++ b/man/math_indirect.Rd @@ -33,8 +33,7 @@ For now, only \code{+} operator and \code{-} operator are supported. These operators can be used to estimate and test a function of effects between -the same pair of variables but along -different paths. +the same pair of variables. For example, they can be used to compute and test the total effects @@ -50,8 +49,7 @@ not valid if \item the two paths do not start from the same variable, \item the two paths do not end at the -same variable, (c) a path appears in -both objects, +same variable, \item moderators are involved but they are not set to the same values in both objects, and @@ -61,6 +59,28 @@ both objects, and estimates stored in \code{mc_out}, if any, are not identical. } +\subsection{Multigroup Models}{ + +Since Version 0.1.14.2, support for +multigroup models has been added for models +fitted by \code{lavaan}. Both bootstrapping +and Monte Carlo confidence intervals +are supported. These operators can +be used to compute and test the +difference of an indirect effect +between two groups. This can also +be used to compute and test the +difference between a function of +effects between groups, for example, +the total indirect effects between +two groups. + +The operators are flexible and allow +users to do many possible computations. +Therefore, users need to make sure +that the function of effects is +meaningful. +} } \examples{ library(lavaan) @@ -93,6 +113,35 @@ out123 <- out1 + out2 + out3 out123 coef(out1) + coef(out2) + coef(out3) +# Multigroup model with indirect effects + +dat <- data_med_mg +mod <- +" +m ~ x + c1 + c2 +y ~ m + x + c1 + c2 +" +fit <- sem(mod, dat, meanstructure = TRUE, fixed.x = FALSE, se = "none", baseline = FALSE, + group = "group") + +# If a model has more than one group, +# the argument 'group' must be set. +ind1 <- indirect_effect(x = "x", + y = "y", + m = "m", + fit = fit, + group = "Group A") +ind1 +ind2 <- indirect_effect(x = "x", + y = "y", + m = "m", + fit = fit, + group = 2) +ind2 + +# Compute the difference in indirect effects between groups +ind2 - ind1 + } \seealso{ \code{\link[=indirect_effect]{indirect_effect()}} and From b756979815da834dff4fe1e12f89900fc77726e9 Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Sun, 31 Mar 2024 14:58:15 +0800 Subject: [PATCH 66/70] Doc cond_indirect_effects() for multigroup Checks and build_site() passed. --- R/cond_indirect.R | 20 ++++++++++++++++++-- man/cond_indirect.Rd | 20 ++++++++++++++++++-- 2 files changed, 36 insertions(+), 4 deletions(-) diff --git a/R/cond_indirect.R b/R/cond_indirect.R index 42c1778d..460cae10 100644 --- a/R/cond_indirect.R +++ b/R/cond_indirect.R @@ -722,7 +722,7 @@ cond_indirect <- function(x, #' #' @examples #' -#' # Multigroup model with indirect effects +#' # Multigroup model for indirect_effect() #' #' dat <- data_med_mg #' mod <- @@ -875,6 +875,22 @@ indirect_effect <- function(x, #' cond_indirect_effects(x = "x", y = "y", m = "m1", #' wlevels = w1levels, fit = fit) #' +#' # Multigroup models for cond_indirect_effects() +#' +#' dat <- data_med_mg +#' mod <- +#' " +#' m ~ x + c1 + c2 +#' y ~ m + x + c1 + c2 +#' " +#' fit <- sem(mod, dat, meanstructure = TRUE, fixed.x = FALSE, se = "none", baseline = FALSE, +#' group = "group") +#' +#' # If a model has more than one group, +#' # it will be used as a 'moderator'. +#' cond_indirect_effects(x = "x", y = "y", m = "m", +#' fit = fit) +#' #' @export #' #' @describeIn cond_indirect Compute the @@ -1342,7 +1358,7 @@ cond_indirect_effects <- function(wlevels, #' fit = fit) #' out #' -#' # Multigroup models +#' # Multigroup models for many_indirect_effects() #' #' data(data_med_complicated_mg) #' mod <- diff --git a/man/cond_indirect.Rd b/man/cond_indirect.Rd index 01850916..26989095 100644 --- a/man/cond_indirect.Rd +++ b/man/cond_indirect.Rd @@ -637,8 +637,24 @@ cond_indirect_effects(x = "x", y = "m1", cond_indirect_effects(x = "x", y = "y", m = "m1", wlevels = w1levels, fit = fit) +# Multigroup models for cond_indirect_effects() -# Multigroup model with indirect effects +dat <- data_med_mg +mod <- +" +m ~ x + c1 + c2 +y ~ m + x + c1 + c2 +" +fit <- sem(mod, dat, meanstructure = TRUE, fixed.x = FALSE, se = "none", baseline = FALSE, + group = "group") + +# If a model has more than one group, +# it will be used as a 'moderator'. +cond_indirect_effects(x = "x", y = "y", m = "m", + fit = fit) + + +# Multigroup model for indirect_effect() dat <- data_med_mg mod <- @@ -688,7 +704,7 @@ out <- many_indirect_effects(paths, fit = fit) out -# Multigroup models +# Multigroup models for many_indirect_effects() data(data_med_complicated_mg) mod <- From af69898bf9c73a427d652e8088434ce8f494c310 Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Sun, 31 Mar 2024 15:11:20 +0800 Subject: [PATCH 67/70] Doc plot.cond_indirect_effects for multigroups Check and build_site() passed. --- R/plotmod.R | 42 ++++++++++++++++++++++++++++--- man/plot.cond_indirect_effects.Rd | 42 ++++++++++++++++++++++++++++--- 2 files changed, 78 insertions(+), 6 deletions(-) diff --git a/R/plotmod.R b/R/plotmod.R index d97e57bf..fa7aa1af 100644 --- a/R/plotmod.R +++ b/R/plotmod.R @@ -12,13 +12,27 @@ #' #' It plots the conditional effect from #' `x` to `y` in a model for different -#' levels of the moderators. +#' levels of the moderators. For +#' multigroup models, the group will +#' be the 'moderator' and one line is +#' drawn for each group. #' #' It does not support conditional #' indirect effects. If there is one or #' more mediators in `x`, it will raise #' an error. #' +#' ## Multigroup Models +#' +#' Since Version 0.1.14.2, support for +#' multigroup models has been added for models +#' fitted by `lavaan`. If the effect +#' for each group is drawn, the +#' `graph_type` is automatically switched +#' to `"bumble"` and the means and SDs +#' in each group will be used to determine +#' the locations of the points. +#' #' @return A [ggplot2] graph. Plotted if #' not assigned to a name. It can be #' further modified like a usual @@ -116,9 +130,11 @@ #' @param graph_type If `"default"`, the #' typical line-graph with equal #' end-points will be plotted. If -#' `"tubmle"`, then the tumble graph +#' `"tumble"`, then the tumble graph #' proposed by Bodner (2016) will be -#' plotted. Default is `"default"`. +#' plotted. Default is `"default"` +#' for single-group models, and +#' `"tumble"` for multigroup models. #' #' @param ... Additional arguments. #' Ignored. @@ -174,6 +190,26 @@ #' plot(out_2) #' plot(out_2, graph_type = "tumble") #' +#' # Multigroup models +#' +#' dat <- data_med_mg +#' mod <- +#' " +#' m ~ x + c1 + c2 +#' y ~ m + x + c1 + c2 +#' " +#' fit <- sem(mod, dat, meanstructure = TRUE, fixed.x = FALSE, se = "none", baseline = FALSE, +#' group = "group") +#' +#' # For a multigroup model, group will be used as +#' # a moderator +#' out <- cond_indirect_effects(x = "m", +#' y = "y", +#' fit = fit) +#' out +#' plot(out) +#' +#' #' #' @export diff --git a/man/plot.cond_indirect_effects.Rd b/man/plot.cond_indirect_effects.Rd index a4d0955f..84df5324 100644 --- a/man/plot.cond_indirect_effects.Rd +++ b/man/plot.cond_indirect_effects.Rd @@ -115,9 +115,11 @@ points as used in \item{graph_type}{If \code{"default"}, the typical line-graph with equal end-points will be plotted. If -\code{"tubmle"}, then the tumble graph +\code{"tumble"}, then the tumble graph proposed by Bodner (2016) will be -plotted. Default is \code{"default"}.} +plotted. Default is \code{"default"} +for single-group models, and +\code{"tumble"} for multigroup models.} \item{...}{Additional arguments. Ignored.} @@ -142,12 +144,26 @@ output. It plots the conditional effect from \code{x} to \code{y} in a model for different -levels of the moderators. +levels of the moderators. For +multigroup models, the group will +be the 'moderator' and one line is +drawn for each group. It does not support conditional indirect effects. If there is one or more mediators in \code{x}, it will raise an error. +\subsection{Multigroup Models}{ + +Since Version 0.1.14.2, support for +multigroup models has been added for models +fitted by \code{lavaan}. If the effect +for each group is drawn, the +\code{graph_type} is automatically switched +to \code{"bumble"} and the means and SDs +in each group will be used to determine +the locations of the points. +} } \examples{ library(lavaan) @@ -190,6 +206,26 @@ out_2 <- cond_indirect_effects(wlevels = out_mm_2, x = "x", y = "m3", fit = fit2 plot(out_2) plot(out_2, graph_type = "tumble") +# Multigroup models + +dat <- data_med_mg +mod <- +" +m ~ x + c1 + c2 +y ~ m + x + c1 + c2 +" +fit <- sem(mod, dat, meanstructure = TRUE, fixed.x = FALSE, se = "none", baseline = FALSE, + group = "group") + +# For a multigroup model, group will be used as +# a moderator +out <- cond_indirect_effects(x = "m", + y = "y", + fit = fit) +out +plot(out) + + } \references{ From ac3048b5df1901e83cbe1e48da9ad2e031a2125d Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Sun, 31 Mar 2024 15:15:02 +0800 Subject: [PATCH 68/70] 0.1.14.4: Doc for multigroup models Check and build_site() passed. --- DESCRIPTION | 2 +- NEWS.md | 16 ++++++++-------- README.md | 2 +- 3 files changed, 10 insertions(+), 10 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 1f0bf72d..d5173756 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: manymome Title: Mediation, Moderation and Moderated-Mediation After Model Fitting -Version: 0.1.14.3 +Version: 0.1.14.4 Authors@R: c(person(given = "Shu Fai", family = "Cheung", diff --git a/NEWS.md b/NEWS.md index c8747b6a..8e04a24d 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,33 +1,33 @@ -# manymome 0.1.14.3 +# manymome 0.1.14.4 ## New Features - Many functions have been updated to - work for multiple-group models fitted + work for multigroup models fitted by `lavaan`. Most common tasks are supported. There likely are functions that may not yet work on - multiple-group models. Checks will be + multigroup models. Checks will be added to them to alert users. - Documentation and vignetted to be + Vignettes to be added or updated. For now, only some functions (e.g., `cond_indirect_effect()`) supports - multiple-group models which have + multigroup models which have one or more moderators within each group, but these models are rare. Functions that do not yet support multigroup models (e.g, `mod_levels()`) will raise an error if used on a multigroup model. - (0.1.14.2, 0.1.14.3) + (0.1.14.2, 0.1.14.3, 0.1.14.4) - Relaxed the requirement that only different paths can be used in `+` and `-`. They can now be used in these operations, as they may be paths in different groups in - multiple-group models. (0.1.14.2) + multigroup models. (0.1.14.2) - The `plot`-method of `cond_indirect_effects`-class objects @@ -39,7 +39,7 @@ approach, though leading to results different from those in single-group model using the group as a moderator, - makes more sense for multiple-group + makes more sense for multigroup models, in which the distribution of variables are allowed to be different between groups. (0.1.14.2) diff --git a/README.md b/README.md index 8126556f..b68198dd 100644 --- a/README.md +++ b/README.md @@ -9,7 +9,7 @@ [![R-CMD-check](https://github.com/sfcheung/manymome/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/sfcheung/manymome/actions/workflows/R-CMD-check.yaml) -(Version 0.1.14.3, updated on 2024-03-30, [release history](https://sfcheung.github.io/manymome/news/index.html)) +(Version 0.1.14.4, updated on 2024-03-31, [release history](https://sfcheung.github.io/manymome/news/index.html)) # manymome From 8ecb95c44de8ca6544ec951bb6ed372f62f7cda9 Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Sun, 31 Mar 2024 19:52:26 +0800 Subject: [PATCH 69/70] Add an article on multigroup model Checks and build_site() passed. --- _pkgdown.yml | 4 + rebuild_vignettes.R | 9 + vignettes/articles/manymome_draw_med_mg-1.png | Bin 0 -> 4786 bytes vignettes/articles/manymome_draw_mod_mg-1.png | Bin 0 -> 5654 bytes vignettes/articles/med_complicated-1.png | Bin 0 -> 6677 bytes vignettes/articles/med_mg.Rmd | 933 ++++++++++++++++++ vignettes/articles/med_mg.Rmd.original | 560 +++++++++++ vignettes/articles/references.bib | 13 + 8 files changed, 1519 insertions(+) create mode 100644 vignettes/articles/manymome_draw_med_mg-1.png create mode 100644 vignettes/articles/manymome_draw_mod_mg-1.png create mode 100644 vignettes/articles/med_complicated-1.png create mode 100644 vignettes/articles/med_mg.Rmd create mode 100644 vignettes/articles/med_mg.Rmd.original diff --git a/_pkgdown.yml b/_pkgdown.yml index ae1b9082..d5ef4a88 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -39,6 +39,10 @@ navbar: - text: Moderated Mediation href: articles/mome_lm.html - text: ------- + - text: "" + - text: Mediation in Multigroup Models + href: articles/med_mg.html + - text: ------- - text: "" - text: Monte Carlo Confidence Intervals with Multiple Imputation href: articles/do_mc_lavaan_mi.html diff --git a/rebuild_vignettes.R b/rebuild_vignettes.R index 48dafb4f..4903281a 100644 --- a/rebuild_vignettes.R +++ b/rebuild_vignettes.R @@ -12,3 +12,12 @@ knitr::knit("do_mc.Rmd.original", output = "do_mc.Rmd") knitr::knit("do_mc_lavaan_mi.Rmd.original", output = "do_mc_lavaan_mi.Rmd") setwd(base_dir) + +# For articles + +base_dir <- getwd() + +setwd("vignettes/articles") +knitr::knit("med_mg.Rmd.originaL", output = "med_mg.Rmd") + +setwd(base_dir) diff --git a/vignettes/articles/manymome_draw_med_mg-1.png b/vignettes/articles/manymome_draw_med_mg-1.png new file mode 100644 index 0000000000000000000000000000000000000000..c89b3e1a9378aeb489f7517b03bd1bd1199c9a6a GIT binary patch literal 4786 zcmd5=c~nwc-^QFZBZqQI%qcTVZlj3^jhaJgsd-INZv$Q{<0j!O&QV%HTACSJra9$s zwNOzUAj34J94kQ~^_r+~)D#rdkG}P-_5Jbw@viT$@7?SC_I`fP^X#+ETKnvC*8bh~ zIOC+DW}pTFfi#>?oj3;q$%%i3ioA?@xCA~e8{T-hd7YGvAP@`$LW5wkiv&VbWC;ue zgMrYpfcl8GIf`(B@Fd0FSrRx;R`uZ>lHcUbP(q*o789h9_zAm%M zg!N&W{>vgG;FI)c@e65Dy@7ql@BR?pG;S^~(k3l;zL8k* zIKpnv`(CxcrPvt1r$T`o=HM)AP7{$gVJw3QnEPF33Qc|g8}J9DFj5&;WlE`3?E&e= z{|$aY(7kh_fbuPi%_`|Au{ZhaeOnuh79RI8$&)tQo0|eQ2Pm!>ZNxT?E{d&hLkks) zXKTu%Yv&z#jJCL`F1zxgI@Q3dXWRVt(457m-bPr8e>2T2vQ-&9Ob)4_ONL*uCo)za z>c;?kPDz$nRh6_}zhsQ|HzcPj3-HafRT^z;zM8j~{X^fHW+kqq8nd&%=48|D4KOWf>o8I}sZ^>FM(zVD|e)LRDbmm0v-^VZt&3(xRBW_cnt)if34(*xGzwV?d ziV=4QcoX*eP4|1J3Bmz?qrt<74d*bPPW=p#_UjAHUDdvdXEz}|XqN>mu2qKkpn0E) zQS`TZ;LqE}yHFP*CW?GEA`j1&^1QPH_DKKY^fq3zp`91=R0DCb`EgE{9WAAI3a*6t z_(eYkF1>;oHud&erx<(xeNO;$tpelw&Ffb0gm(VO98yA7`ZsX4WCiF;JEpq9Rh2)> zxXi&c2Fh>hU>lMA#hZ1m_s@(Wc_h{2x}eOZN(nE0w2yARi>4)3^}dK3@{BeDw0B?! z8lRZK#t*i-TWPj5X7pMoG*5NBYFzx+X2jeyVnOr1ssyT`>qnE z8yNi=@GL%~1DE_GG1J3`T}f%^vZ48lKV&Z5NJt3LtyVXBsD`BN*5W8;2kekOo61my zqHRYU&85#8GWa%ce{SFfpYE6JO?u_`sdAes7(clCZn&;*bO^A&_|)O1dXA0JGzpg)@K+b|f@b_jV-)0+=)+)%lphY?hvQ8C$?aotsK+g+3us z9$tJUiYuIXx>2lH`{E5UtW!<9!_fw{{0Y&acI|Yqm)1D{X|y}&0)gI= z&IY>BN6H%$dKc)>wb!K2ww>w=H)`lmhwyFz!O5X-t%ndO{Y*}0h0l%+v<@}8h|iW} zW<-sDc;0@5&yk-c7^g#`r2b12N0hko941-axWV{D>m?>FO9XPCyYOnv<`$hv3kSI; zUg~n_%q3W^Y^-*+RqyW9hHKnc6~SVn#sFuIH=TJx25N0146X^hLC9^bP=j}SGZaP& z?YYW*Q|gfoW~$u#RC)Y%PE&#|e4j~ESVXIcd7URWYS<`95V{g=xF?BjN>w99fWzPZ zk*yKTH}+inK0>(;9yiZWO%SHF(T(H#&pAk`^{Rhp$D52iYp3V0b)Y2u*V7v3hi3Pz z#-1axIe~~!3^c#PHu!U#I9Ncb^O>m1O(#6CC&>pQ9IFNg7;oY}sZE`d#3J5ra=^#t z-2TnCzITxaV49PVRKE_okNh=7pzI?lQYGFr7{i_+YKLTN?9M zCo&$Ce&ww1YxA^R?HHOa=UW&}{PS_^+HRC*tqs-vc@o!njIp2J7urLJVYP>e(#?+o zKa-U%cQY{2m5+@W)8WQ=c}uC#Q*@9P64{rEyeW+CqWow+w<(Kvx)I!ht!sof3mWBX zf#cPkJo0L~p7!@b;HDg4`M1BgQ!?)0*J^xeXcag=%Z*uF{aY3JqfBRQTw^6uC>MX{ z1HGzeeXh6-SvW;>j!aGsT$E-8CSWf1(41(K>JH4Ok31{F%&xrz-IGO+yM>U3bIp zQa@3ZO@MiJNPqjFLq~$~y606Z(f7;yy$){i6FpZ)bREbjb*+rqEC($CQuqba5cAgb zo5fzb0ix|7yi~!0>~aA&g#$|gQ}*3~i6I9NB9WRzRSu855fP2sf&;UGruea)sniEl zWpv~jkvabYAJRm(Jm=#nYE@^A=eeM??X9JSE&eW)&$nPtzu58g+1h2(Wifv#w78U3 zRtOR`5#=!#ZpGoiu|OvJ>J+hl$NCugohaYb4fx9LE5G(S=C@7xM^V8XdEMAeqTPI# zX~+|9@#(>5rQI(pDS||0#M>Af91RCn;?m%mER^S##B^vNaXl+TlOA z);Mqu?}Hkv@Wv~F2^9X&KAZZ2N_Y)q7FUFV@~K5s<Gf}pJ+2T9zhy$ohFyPh_eHCE7mal|SS#`ToRh@pr-E z(wM71NkiByNL-unKbtQsW=!5<)mb%|;N>U3OIG~afRdOkR`IZGmc!8P6sA6$-%Q*r z_7_AQdTEl!JuAxWNMM<4SgNg0RF*`YXf1X+${BsH4F58EazpIZt^G8MP29GTt#Uxf zA0DEm-wDbwPGX*C?{fipuLgKYP|YZ29OXzZ>Oy8{yxZ>W$yD&Wo$xON`o?@E6`XO; zhR8IqnTx5yl4cIr{h`i@5=qIEWMxTxHNDU5h2YX9b;!(1hN^pa3f29NNo2LVsu_Hb z4j-}SJhu(8Hx_v0RU#RGlAtX4S>4w6#|r_rz!)-9OILJnPo=W%g+*4gG-SU#Jw5{Y zl-Jh09S-PRE|C$2r-KmhdmS1bMubA^*(gR3NBWMP9n^a6fs+H*VXR zM^eD`het$BNs_WXs)oU09_LuSREEqHe$YT>gK?G*v?8lLE%!^|NBYSK18!U1_9))u z<^qAUDFiYTlCcF3Gv(*)s^PWe?Y83;?<)|fn(0AitTHw62Il;{L+50|;bm^IM}gpj znHFSbDpLaw-@(r_o0r|nqJhf{D-h(EZiLJ^>o=R|_r6tfzP}oJ@?-l!_&s-=p`Q zsHbQj`~~5qhnv*Ug@4Im$P=lx1VzY<^p6B5j)gfA{^g{(Eu3#-ejPfwdF0<8i%x5a z<5vrIBBYt&Se4Lot(da>Vp`;O&bDK@3P7VIy(N`{OtbFo#$Ac?MD`+@Z&l2#EEMO6 z;t*jG@uC|c5rOP`^)EAD5F@%BjMvI-7riIfid8Ls?T{C*m#1;h(m8R4igvNjsu!== zMG-mk3&PmV`0-@Ek@SxryiJ3bAV*S6QbwPVxe+2?gTS7#r3mngyy4l819 zf6E{Kp4B;8+I-;JfFY-fz1sorGwbXr%I`cFZyYgmMbgb)=xzGcmK`i60I`P`D$*P4 z%(jMBI^3ilB2;FhbBXJ#Qjas^@tsb`pM9IYno%bys;9fg-g^{iz?+8*`bc;K8pyZ> zuc~>WS!~nv{2jjck}D7JGYMhMk0&?m0Mn>2*POGnxqbTh}&3&^E|KyY#Y6W5iJwutrnI9Z>ob`PmdAZ%N8@+*KRX~l`zBj zA2%^$xo`RR1%yG@ITH^XGHRfzCB3#t58pC5Je)54U^|p|^#Rytaj|xm=Z`usN?EDb z>F$Ise!F=D`}h;wm#OVY>m)7?w5`nlw8QsZ|1pb|YOalEMJ|>2AaQ*n_uK1VixKMFY`mT(UH{bK hf7SlO>KEPXa_3dy@s76#H zGsz_xBgUX`D7lo({M$rPrhSCLFyGqaJm2$u&v(A(`Om|wz25cy-plWO*P6X|^1%a6 zDoVOaC=^O%-`?L2p->7E)HTcUw1qY*oD^Ycg z78VvjYK^kCMg?0VAMl-F9UN>OTxp$=VVwcK`(2Swnrm2?YZ%KlttI$xD?kas0M+11 zS(s~DSQslTttE`b3S$kWA%L{BFjg8ET4Wj4s0?5?7=@VZm$AZJSwphQU{qzWbtQtX ztd#Xv%498Rt}SU{Eoo^jEwUDwtUtrLUnU!3g$=RNhGZ>6GTGSJnB?LafCQ>w8LY`< z2oC51MVU+%slU1qB)a14Uhi`#l=5oiU*XLFO^QOHyZ8OJ%Y*XAx7*4-dd=#NUTK5% z9ovKT9W=iF+`nrd=jEPoY<%DqPR6uMmfserO}uC@V0r9tRTVjgjwPyA9d;V9$T%MI zBtX+!S**yR(jnzdbhC0}Ugtf@?i5J*v7Kh@{BQt_7cDV!u&brb?VB?kh`soFl0SLk z!B~Y6>#1NY){nbz^vq-XiUNpz+K+88eTyw%C*Eg|8`R8aX5Y6Ep1f9 z7FmCbG(JL|PrALTn9_E78`WzvZvJ!m)Q@xl#G%Oo;QrwUvT38q=(UkHt9pBrmO;Hv z3$I(9%zWg8c?fTZP3d2?Kg3m%iaW!dY*`<-rl#5_MMQh15H&vkJl!Yu^Q=V` zxuQ2KG{iwbPMd9Vul4H9@4(Q3%D_;1Vx!fv7tF2+8@OU-_U-hH@`eYsXwjLb+3EId z-o%HR!CrFr+Sv2W?68h&?N=hKG~RXl(#fSmlb++7U$#3+$FK2tO%X|RQ~XrH)4Tej zql3M_sZ>$t9q3N1@ulPgY!au=OwQ$l-SIP8gVp1z7<<~9GhOl;u4kqm!p zKQ>_zUh#R7AX=cl?IDPwy+pj74c;|gz0p%&A1oAi>Dt*mw`*HA4m^0;F067N-o&%} ztnI{_3bH51QYJ&;JclsRhsjudk+fut6!_)vxf`XTsFBa3x2G7inRmlgAK8ORr-a?n zJ;SSO>9ccCIO{)0~VKRu!ViS6cs zrdOCKtY?NVZ#|ca7AFw6KjGml9YHh+&AvpC{)&fvbp)pVXoqA1R~rv2=?L5c{y{Cf zRuawjyo1SJ&6Ife&G#A+RyorNQoYbI&E#_an*g-Kl75=XmQS2U9YMznV_$~cngx!o z9f(+y>Mq|VsfJXf1g|&Hf z?MgDVY#TSi9d4L%A>k15XXxRi?IbXil`OR@9)^6%?^oZvQANa zJ-u$b_c6V??Y?$)cPT0>J*mgc4$!1whim-w_4Hi)R(^eC|E2aO$Ee$EVK}dVCvIeO zE=u1fP77TrB!bPt@Yo3!MqS`G@V**kiN#CJ{A_(5uVcema$2;0S@;rOZJWqt6-$2Z z>$9Y>hVjL7(FY2C$dl6m$wlc1oB|Zq3TqxxNOOiloQpbBvX=p6`M*nEwd0GNTWv^% zztx5iE@r=BvpRht)+s{nNItHW>cyc)(Hmv_p4UzM?2slyI5v)QBSOFZ!lWz8D8|l4G2Z8Pm5?bVrW~c30btBXAWH!Jc^8pl41OfgD_MJK=x1XbmS5 zq!$TXmBbATA6dencc5^3jVU+-n;>+63Ab{^F;`05$xG>=*M zz%!o~eOPW;_Hp6^*x|2xCC`2JOj9t`6|LpK>T77s&#i(D2MQ+;&dMczb=`HWV#=ye z7pZ4^szD*%ZPpf0lxTubbcypukWQ8$f~9gn1~_CvKEIZng*A*~@)6F^NOT8@@1Wvs zR79{uE+B#v4=|+VSuS~*W#0jq_?V0!aV0@;*IK!tUM|?mfSBgqI=Y@5$)!cbyK?#V zlB2NUqGFs}V9S7h0g48mC6YUfiX^#w=SpXABdD6%m~=)Ss1|3iLp#NH`W!Pt(5h9k z_r@mPx!B*}_d2-}R&aBj^lNgNGw)I8 zRxjvi4E4#!`mHu-~&1P z`aXTih+GA$8`*`sp9pZ2Q${SYh0WI*R6n$MvRd8&oAGcQ=ooF&@lyNI!lbZK+qR3% zOQ`yoPx?T~JcScn%%qNN4&yJey0AG|?V>o|N!|!8IkdicQyT%_f0X1Caef^7#VzV> z(S{f0{7UhVf;^b5MP@X#g%+mfGFGBZ-2YitA`ao;a65)xf1%7(EkNw)+HwU~5YIfdc`!;NU z%BgsjZxJGJ_*C!{YoqBmKfG74wA_(xAKF;MM#9q|+)BYr9DuhIM>zy>8g$&qZm+u~ zr;#)$JO((sTJ*^O6n_JEE?GN_aby3(Oo;b3NQ}DA6^ln4*Uz^_53h!EdsJ zbq`My55aKGEy>ZmM~U~9mA{X#2PaT1=h77+fm-BxxbaYeVk80~5OX4oz+o7YpcoaQ zQE=S-!joS~cZD&H;DkeKeI0P-#;;CnzfQ@Xv=7tjUymwg9^Y4%G%^2N-sy0q5a(v$M_@48|htyvqyyybLgP$ACMT}qKJ zeARVw!Yg$d3ze0Nn~y2VwslKoK?I&s*gAh$uZVxc?%yOx# zD!S;)RdJ-Db9vG8z%Gxzp`E1MY)S>#jweG_=II%`FezrC*OdMMSMKVf>1zU_tKy5I z2c4Oj4O`d4QGlpBJvz2q4&@XX@}@0cW#%fyrMh2nyVI=2e&+9}bTU=_mtPW21tJG- z9j!+C*$AAlO%HMayj&f2yJ^JIZcbg;4$pTP`{&Xxrye9A>U@Yyd-hB-_Uu_)jCmhA z3ExrDm)U7?`uhXFW7zZ>tIM)>6-L3Xcdod;b(%YX^KFI;(6bp$6W({I?ad9^DjjX3%pVQsr`#B!!aulr&cV`)Jrw+hnTp_g&@%6~xJ+9i7J4$!$@X0A5La1SSmVHtx&MJ8*E8k)43- z_55YrZtN`z3#=y+8<0t=PFX_&pA`wsM&1@;S=;NdCadqg7{{1W9uWK$T? z*vlP2G{B9~6`~UOMaqY)ZbXIOQFH!92sYC771>mfKa=8vop0G|n7xzQxz7zgV}b;{ zuh9qmio9vwilj0F@weFuWF=ccg7?+P&;7X^e;0&DCdI<#6d3b1*?%uAraVUSiKFx@ z4kjd!PJ@={I||=j%R3K8A=gy6Nx4Z`xgHJ3HK$j-*ou(617cM&v>DplQXe8TTYyst zlQ`+{WQz}cSo1jVDEtZ(FNa7yEVyOn$(@pC`YLBuK0eP`kdKdY>i@^ML93%?78Uw+ z*-)8g2Yb-y$?F0}o0qi1T}Po zyjvVEuR%fr{q4OtUb-b83k;s>uQ6#fw%-v9w&hg<^>kYl!iA(UX9m!Shfh8E?p0Dq zQEYqsP!&Y4BPedP1&4$=-R)|%iz={KpgM6&&lp%(GrSe)SL(*L5KtAS#3QFyo=GyU z3e=JTb@|f(bKp6nUQbS%TU_K~2&i-N5NN6w-(5d@9eFOrlWyjfEq4ZwlX`idZbO#1 zEKaNQIEAk`7*F7Sx%_*BvG9ETb`ly??++Z^>KN{zj(BvFHUnKbrCQr$h&)RU(3*V* z!ENDx^ql)oYW0wKblvck5iPz)mocq_4_=#beucc}-2eNT-1C_vC9AvLt94a@$>w0w z(2Chltpz0wwE2rOuNM+3c%$X%(FV#|vh$H|u(Qzij}3VK=t5uli3uy4CrZ)3hoXCC zA9dwV6(-Q@X72ioDW_;gkhEiGns!syPKoN?hc;|$bCEuRCkG>3|9!wwe{!2K*A=1P6H#}Ad&JLz4G+YftX|}lRFBav1{KI?y;U!j& bOyTXHXMdvkp>1Z&H*h2-1|i2!cQW1!?lqM5zK&q)4v`Eul!07O5fvqV(Qt0tv;? zQIHNHNL3(&UP8I}&HZ<0?#%sn&+M6<-RGGzyL*0|IlHk2dYTNhT(kfHfI(a9$uj_e z?D+4dCcpB$KV;IqQV9nCK3Bie0DuAj-~dp#5(L1Z@ybvDC@26N6cnxmp>X9vT*<7% zf0G;>{$dCR2Y|!XYP<{$4Mivb5dWbf8~_M}1ELXum~BMNUN$-a8XXiGXAzB;jg6PH zjhC0R2!+|%zsT(6?Cj;`730cvrLK@G>msmC^(q`1Pc1Va0DzA5?7 zJbn)Sw3Qv_zw|IM%5vJ<&!lneg_5FSX%J-TcaFUyD>m>FYcYR!L-i>Ib@HvS%jNEx zA-Wj-e9`b{j15oo8A})p3f_lvic^A~(^?g?Aq~W!dC!Qd1^CFP7`n9o|9}()9H6z; zE$)#r8qSm~lfEmfjrp3^q)p3Lfz*9QbXsvs4%d|MNMQq;2V~{rfAr4^Q6?GV?ubF_ z|IgGoZT6?^<~ELmmC`2HDl%fvjV=wotZW%&MWTv0YUQVj~FX{eKjG5QTRIf z?vq1!|CCVrJF%yQyf!UcFv3|S3dgH`&GV4p;@DsZ*LX4}gu{yM+4HCW1C^^qeC3yz znhLWs{>wzFspV`=zLtR62FS}W2O8DT=9uO%GKAt@=7)=OupH}U3I`ii~h?EPoAe$^`+Zv2Bakr&``IZ@V zG>Gh|cD$bsBMpfcF5e9AI1u3kPG(j1d|9ZxL6IXC;Eykxee~!4m&1U@0kx@WBVMOl z&xr0HeIR=?jG`Ylj*?B<*c1EG;Zm$B#L2MwYoQBUUkUAyoQACoiV;@BV9ccZ+Nji| zRbJwY?LyCbM+X+Q-7~bw*grRhM^?ARKC4oTLlNQ|+y;6+@3zctsk5j5JnOBaV)D(P zlegen*!YH8-t6@uPueCX{?>g z!yc3RLcICkD0uYs#e%Jgd{#3_nc;UJzUlu6jsU@C(F+4@o2!yP9*XN6BOJ+dl1awy zd)F9CMc)e0!b;LK!It)Y?KKIE#>^9pvdcP@N$b;vp!1_Y-ohgkVEH3ImJii;QS7e0 zdw>pqs>mP*os|!-gWuflr4?qTBNiHF*1tqQV+df*77HlE$9^JziQs=`LgqSkAr$s7 zlxcji&HMXoSs#%oGy({IL{ls;;o(7acYldzf;jhS}G=n7EoPs zjia`*{PCkX$1GQLrbofC1*`ABT@nwVU&+rh29TB5#mP&;idzWBi&zYBkRl#6hyHA8dzwH3CxF|#tL+XU4eM$za5N~*V-%R%t zB@e0<;hUpQWdvJBi_GwEE6_dqVLQ2!5+<_5cx_RI6fx0k8K|&Zf}V98skZ&h?DQw{ zYf<)hW>FU+O&i}dOUAokK_c6n*qT}M%>qb6??kZXR_PF*I1 zM-`dEbc)L~ZNIZOq_Lf;8%U9F`^yvf8!0E9LH!RDF`}9!Z1{5p@KD71;}?X~71G=b zF+8d{#Uol!Y-G>IS*#Ze?6?V>?t9vClvetvV|Md8VuTtja8M)JDTuOtw9}^vOj^;4 zM^z;p8*~Dr27pQQDc|jwj6_da=zjERQYHQ3TUUv0J^xDMS<(yR%>u)THpOGPOCFR< zm9v5=NpyTLM*7I?Kw}jUcil>zJ@FL*Q+?eU%iSN14gZy#L<8Fv4>?ih@gGf7v|ukJ z4^Y&+r4w&Ur+mwAwBfYEoZbt)MW1(9N>mU^eN;X5`->0y zb+u!2IgtWuT)#fps)5LnOFj1@0qjo{sE5{tLyrRXg`R(=wKcO-wFV#4)`o7~dv)?- z&}?Ln7RZlR33a7;340QuVX|MP9s#5(2~j`Zrx4F<T;OOb=<&Dpe>3s-hUr^r1htK!(;Y|Vem%kO+XNJ9I!j}nRER@&!m11Ah z=BVO?v2wc1$FGJN4)oQXgaRwtjYJnlQ@IJ%GVpSIi24gx`(1Ce^co)_+zJ!T>|7$H zJIH&6J>qQ2zv-D|yX>buHknJHO+H_mY)i%W(J^?e941$^sm!Zqo$sG)?e2S?oP)+# z%uD`OJm8HUaZ6j7<+zyS5T4rPJ?f(P+Lnp$gN!smir#7{69%5WFLC^+ zN4?mV^Nh6UH1vt-SbTG=P|%Y}6X(s_Q4oxtj2lX?r~6~r3{*4)5~i!hJ%lPanwY`7zupO*BS%zGY?krAsL(rBe%F_MSbqN$gY<4H0AnW8vm^}O z4P;k$#?m!*)!td5h4CyS*|QaO)6#yM-BLwQvTa`XJgV|_Z8Rk|h>%P(yvhPYc4t6u z27oFappPMfn|u#IS>oKm3HG^(ik0qaw^fnnE8}wx3jn~e&5ix+L4|;n2tmW; z)xPnpl&vW1@yR?nx_sy2@hv@_J@oqOGR<9YgS*7K9r_&ksq}lSy1CfRCV<(kW9JQn z=_RFEzPxF7TGzu?PvUy|i}x3?G#Y7>zQ|ToIuJIa5PUPZa>-%0UIO!qg9ZF}FUl=e zW);!boIz#Uy$s>$p;(X`j3ynVu>^hG`qiEjCLuzs(^2KvTr-C9je2pju?KHGkhiEH z-ErusT!;%^{?<*oJ*I5*&3AL?!P1ZzFBtbg$U-ir-caPX7w@wl7+^1F#<`x`l<=ot znA;g!{@1&`KB*}+Q>EjUyy_IUiAo7PF6a*|aP9lbP$(U$>xiwhXOc{w4Jnos^y}7U zSiu)_QyJ)Bzff@KEr%pgrt!{BPR~0a#9egYx;utZhC5q02leC`D=}2|w8v9PoyD0l z|88&v>@eDg@wuPXW=ImxyWzKxhh+LcE8KD=;To4yzACPvC6*QDheAKT1soT_IYhx!%N0-W)~H-hK5is z;Vo`yj%J~>vrg#nAEn^rBtACZAp6I(o{=Y?DPLx!)>4@I zyRnCF9${!opY`)h8ZD(h#l2n}y}S~xpdd9txQG3f90%PlJ({E<{l{lRxp$LNKxa6*D znjrvcu<>e3_tZ(}9o9bo>c)_3Dp}g+kBp!{M|SE^9x?GBeTB}90QxMnpW11mCJFbZh*j6*9?(F4 z3g5N_OOXf6N<(gzc4jLx_BOLlUVV^D+&iVZ}y zK|Y^tQ&2p_ELiU+u;8#L1yYkuk=(|gLkqCo;2})DHSO*S-@z+EN?+faD(&&htaK$J z*r#3l+Cbxa)^t?*)!a%zvP}Z`e)-P~T0WMLz7+8HKVDef_xSfxO+0;FOxrGqZ%R7K z_!>WZEj~J{U*;&wlQ67BIlibr0U3>=g%u)uNv37^wf=X=m&Ct+IW2P|J-kpU%3yf4*lS{piPJDtQ2$E<^A1 z`0${B@t6MSW=7E}1zaI#h6FAax$Q@_{2S9GeX0FP`nE^*W)tGgcRsGHN>h|F+}`1vzVDu9x|u+S**b9j(d2 z){+KOP=Kf7HQYeTTjRG?DK!4dc%?wqVCz7Y%h0f?&?7IA0(Jq3<%n!{s4qNbOMjm{ z(P@ZyU4#hD7&T`plr^4e3Bw+~`=F<8-W#tdM|A37wRmjFF1JaKSvu7KW51LyVY3CG z`5t{0pUa{J{B!VzNOe;p^aG%)YU~^Umvv7Q`4BYgd=&*Jf`=I=-c4X5-^= zG>4)ik%(iR8G03T!)J}2Z}Imn<5xOs@!9fFr`$z~96v}^O9U`T5y4KZ&9qx%;+yj6 zJmGer3L>0g)GV!PSyKA};Nr`F0J)DLReJy?pP)=Cgai{2Va3+D6FMWkm_r9eY{!)< zrq+^e<1$9WMhe>|<->r-9f-gPaS`IM(!2CfmjW}d5jv#eTVz>$-XL1>uxuSKy+QDU z;VmC8n_J4P0C5!%!#vMY2{nRzI3%B?tnhA)BQ36Hx(2-#t7Jl~iP=nl?|c;ic zh3(p#9?T57Is(|CDXLX-Vh18S^FQjkKhtaS2vQXX;Qs<~_tIqV)l&~$*nE4#;1K-U z_o$VPm{lyQBS9G?kC$r|mn7TYMBEugo0RtGVvys z^`$TSvJ!7{Wi^**5nVzP@eFg$n~O!Nm@36my5kq`p0x#8NvJ zS>w!qoKd7{ulLmeAGb|-z<73YQ2|4_^yX|X|M)@)w`?T~;|%2mUhJE~gM%uAwD>#t z2v##{i@QrFXDgo2@)2uz8>#O1PFEXAWhO&*zGzL^PwwU1fm)~d5BQk|b$cuAH7g1T z{c+MZ=zugesn0Z&1;2#45)$Pgs#1R&CXI%3O^vYnwXg-#3k01( z6Zr$rR= z^ssVe8o6IGORsbsAgF}JUiUVJwtkJgCZDzshoSV^kB2_4?z_$%S`kc( zVFmb%choS!JNT?JY?s$bUU<_RE~ky9H(LvE*!dRW^>MXuD@#q8K73nw6STdy*!s_X zxxE7?Q_<%{+4*a3L)!wCvJ@*(en`f%9=;lvjI*c))azzR#OjbMV^U3<$Q>eVtkE|YWIp#wet5nnd0{oWWLwhs7C33|9 zFT&sW+m)s5lz+s8xZ!EZd=I^F)rM?Xj4>k0wj4r(x+}MKhG^_!und7r)k!X?l);=f zQ~#QmBi4?kzRLntl(3VBF_s|;RtxvK{KD+1F5!g(w3Hs>uEy|$R{xa4zUTvu?#k?O zcwi32)}6npMO=PGd1;71gmpMQ(?=Zwg@(*#{!Pl4*U9?*UdGW`S}A$;?teJ?yaDVZrllNKM=7Lb=iI%7L~_I#*56cUfDL?@YHubmy9TwM!-?jdCB;~AWv zk!d^HJ%CWX=b`?Xf zqH}9oVNTnJApX?f@Jhpp9phpFMrkVd)7LY~;|3GU?ImX2hsNs*xEZIMNz*EPhN{L@ zS3!dql6nBfojs(duq!@nRfacLd{2tyWSQMr+g*ZR9$xj@)aRD4Fy!=7^z)E-e=X#@ zDcmrB72G3J0{SfA(-H%|s>$Hv@QxfYMZfiiTLzT9Cfjv;{mW`#qDb0EIgIvV*Y{|o z$h{qxxVSWwwC1ILZ)J=cQvd%?1OB(+#VI_#)6a&u8c6y(-qBXqds3 x m y c1 c2 group +#> 1 10.11 17.0 17.4 1.9864 5.90 Group A +#> 2 9.75 16.6 17.5 0.7748 4.37 Group A +#> 3 9.81 17.9 14.9 0.0973 6.96 Group A +#> 4 10.15 19.7 18.0 2.3974 5.75 Group A +#> 5 10.30 17.7 20.7 3.2225 5.84 Group A +#> 6 10.01 18.9 20.7 2.3631 4.51 Group A +``` + +Suppose this is the model being fitted, with `c1` and +`c2` the control variables. The grouping variable is `group`, +with two possible values, `"Group A"` and `"Group B"`. + +![Simple Mediation Model](manymome_draw_med_mg-1.png) + +# Fitting the Model + +We first fit this multigroup model in +`lavaan::sem()` as usual. There is +no need to label any parameters because +`manymome` will extract the parameters +automatically. + + +```r +mod_med <- +" +m ~ x + c1 + c2 +y ~ m + x + c1 + c2 +" +fit <- sem(model = mod_med, + data = dat, + fixed.x = FALSE, + group = "group") +``` + +These are the estimates of the paths: + + +```r +summary(fit, + estimates = TRUE) +#> lavaan 0.6.17 ended normally after 1 iteration +#> +#> Estimator ML +#> Optimization method NLMINB +#> Number of model parameters 40 +#> +#> Number of observations per group: +#> Group A 100 +#> Group B 150 +#> +#> Model Test User Model: +#> +#> Test statistic 0.000 +#> Degrees of freedom 0 +#> Test statistic for each group: +#> Group A 0.000 +#> Group B 0.000 +#> +#> Parameter Estimates: +#> +#> Standard errors Standard +#> Information Expected +#> Information saturated (h1) model Structured +#> +#> +#> Group 1 [Group A]: +#> +#> Regressions: +#> Estimate Std.Err z-value P(>|z|) +#> m ~ +#> x 0.880 0.093 9.507 0.000 +#> c1 0.264 0.104 2.531 0.011 +#> c2 -0.316 0.095 -3.315 0.001 +#> y ~ +#> m 0.465 0.190 2.446 0.014 +#> x 0.321 0.243 1.324 0.186 +#> c1 0.285 0.204 1.395 0.163 +#> c2 -0.228 0.191 -1.195 0.232 +#> +#> Covariances: +#> Estimate Std.Err z-value P(>|z|) +#> x ~~ +#> c1 -0.080 0.107 -0.741 0.459 +#> c2 -0.212 0.121 -1.761 0.078 +#> c1 ~~ +#> c2 -0.071 0.104 -0.677 0.499 +#> +#> Intercepts: +#> Estimate Std.Err z-value P(>|z|) +#> .m 10.647 1.156 9.211 0.000 +#> .y 6.724 2.987 2.251 0.024 +#> x 9.985 0.111 90.313 0.000 +#> c1 2.055 0.097 21.214 0.000 +#> c2 4.883 0.107 45.454 0.000 +#> +#> Variances: +#> Estimate Std.Err z-value P(>|z|) +#> .m 1.006 0.142 7.071 0.000 +#> .y 3.633 0.514 7.071 0.000 +#> x 1.222 0.173 7.071 0.000 +#> c1 0.939 0.133 7.071 0.000 +#> c2 1.154 0.163 7.071 0.000 +#> +#> +#> Group 2 [Group B]: +#> +#> Regressions: +#> Estimate Std.Err z-value P(>|z|) +#> m ~ +#> x 0.597 0.081 7.335 0.000 +#> c1 0.226 0.087 2.610 0.009 +#> c2 -0.181 0.078 -2.335 0.020 +#> y ~ +#> m 1.110 0.171 6.492 0.000 +#> x 0.264 0.199 1.330 0.183 +#> c1 -0.016 0.186 -0.088 0.930 +#> c2 -0.072 0.165 -0.437 0.662 +#> +#> Covariances: +#> Estimate Std.Err z-value P(>|z|) +#> x ~~ +#> c1 0.102 0.079 1.299 0.194 +#> c2 -0.050 0.087 -0.574 0.566 +#> c1 ~~ +#> c2 0.109 0.083 1.313 0.189 +#> +#> Intercepts: +#> Estimate Std.Err z-value P(>|z|) +#> .m 7.862 0.924 8.511 0.000 +#> .y 1.757 2.356 0.746 0.456 +#> x 10.046 0.082 121.888 0.000 +#> c1 2.138 0.078 27.515 0.000 +#> c2 5.088 0.087 58.820 0.000 +#> +#> Variances: +#> Estimate Std.Err z-value P(>|z|) +#> .m 0.998 0.115 8.660 0.000 +#> .y 4.379 0.506 8.660 0.000 +#> x 1.019 0.118 8.660 0.000 +#> c1 0.906 0.105 8.660 0.000 +#> c2 1.122 0.130 8.660 0.000 +``` + +# Generate Bootstrap estimates + +We can use `do_boot()` to generate +the bootstrap estimates first +(see [this article](https://sfcheung.github.io/manymome/articles/do_boot.html) +for an illustration on this function). +The argument `ncores` can be omitted +if the default value is acceptable. + + +```r +fit_boot_out <- do_boot(fit = fit, + R = 5000, + seed = 53253, + ncores = 8) +#> 8 processes started to run bootstrapping. +#> The expected CPU time is about 0 second(s). +``` + +# Estimate Indirect Effects + +## Estimate Each Effect by `indirect_effect()` + +The function `indirect_effect()` can be used to as usual +to estimate an indirect effect +and form its bootstrapping or Monte Carlo +confidence interval along a path in a model +that starts with any numeric variable, ends with +any numeric variable, through any numeric variable(s). +A detailed illustration can be found in +[this section](https://sfcheung.github.io/manymome/articles/manymome.html#est_indirect). + +For a multigroup model, the only +difference is that users need to specify +the group using the argument `group`. +It can be set to the group label +as used in `lavaan` (`"Group A"` +or `"Group B"` in this example) +or the group number used in `lavaan` + + +```r +ind_gpA <- indirect_effect(x = "x", + y = "y", + m = "m", + fit = fit, + group = "Group A", + boot_ci = TRUE, + boot_out = fit_boot_out) +``` + +This is the output: + + +```r +ind_gpA +#> +#> == Indirect Effect == +#> +#> Path: Group A[1]: x -> m -> y +#> Indirect Effect: 0.409 +#> 95.0% Bootstrap CI: [0.096 to 0.753] +#> +#> Computation Formula: +#> (b.m~x)*(b.y~m) +#> Computation: +#> (0.87989)*(0.46481) +#> +#> Percentile confidence interval formed by nonparametric bootstrapping +#> with 5000 bootstrap samples. +#> +#> Coefficients of Component Paths: +#> Path Coefficient +#> m~x 0.880 +#> y~m 0.465 +#> +#> NOTE: +#> - The group label is printed before each path. +#> - The group number in square brackets is the number used internally in +#> lavaan. +``` + +The indirect effect from `x` to `y` through `m` in +`"Group A"` is 0.409, +with a 95% confidence interval of +[0.096, 0.753], +significantly different from zero (*p* < .05). + +We illustrate computing the indirect effect in +`"Group B"`, using group number: + + +```r +ind_gpB <- indirect_effect(x = "x", + y = "y", + m = "m", + fit = fit, + group = 2, + boot_ci = TRUE, + boot_out = fit_boot_out) +``` + +This is the output: + + +```r +ind_gpB +#> +#> == Indirect Effect == +#> +#> Path: Group B[2]: x -> m -> y +#> Indirect Effect: 0.663 +#> 95.0% Bootstrap CI: [0.411 to 0.959] +#> +#> Computation Formula: +#> (b.m~x)*(b.y~m) +#> Computation: +#> (0.59716)*(1.11040) +#> +#> Percentile confidence interval formed by nonparametric bootstrapping +#> with 5000 bootstrap samples. +#> +#> Coefficients of Component Paths: +#> Path Coefficient +#> m~x 0.597 +#> y~m 1.110 +#> +#> NOTE: +#> - The group label is printed before each path. +#> - The group number in square brackets is the number used internally in +#> lavaan. +``` + +The indirect effect from `x` to `y` through `m` in +`"Group B"` is 0.663, +with a 95% confidence interval of +[0.096, 0.753], +also significantly different from zero (*p* < .05). + +## Treating Group as a "Moderator" + +Instead of computing the indirect effects one-by-one, +we can also treat the grouping variable as +a "moderator" and use +`cond_indirect_effects()` to compute +the indirect effects along a path for +all groups. The detailed illustration +of this function can be found [here](https://sfcheung.github.io/manymome/articles/manymome.html#conditional-indirect-effects). +When use on a multigroup model, +wwe can omit the argument `wlevels`. +The function will automatically identify +all groups in a model, and compute +the indirect effect of the requested +path in each model. + + +```r +ind <- cond_indirect_effects(x = "x", + y = "y", + m = "m", + fit = fit, + boot_ci = TRUE, + boot_out = fit_boot_out) +``` + +This is the output: + + +```r +ind +#> +#> == Conditional indirect effects == +#> +#> Path: x -> m -> y +#> Conditional on group(s): Group A[1], Group B[2] +#> +#> Group Group_ID ind CI.lo CI.hi Sig m~x y~m +#> 1 Group A 1 0.409 0.096 0.753 Sig 0.880 0.465 +#> 2 Group B 2 0.663 0.411 0.959 Sig 0.597 1.110 +#> +#> - [CI.lo to CI.hi] are 95.0% percentile confidence intervals by +#> nonparametric bootstrapping with 5000 samples. +#> - The 'ind' column shows the indirect effects. +#> - 'm~x','y~m' is/are the path coefficient(s) along the path conditional +#> on the group(s). +``` + +The results are identical to those computed +individually using `indirect_effect()`. Using +`cond_indirect_effects()` is convenient when +the number of groups is more than two. + +# Compute and Test Between-Group difference + +There are several ways to compute and test +the difference in indirect effects between +two groups. + +## Using the Math Operator `-` + +The math operator `-` (described [here](https://sfcheung.github.io/manymome/reference/math_indirect.html)) +can be used if the indirect effects +have been computed individually by +`indirect_effect()`. We have already +computed the path `x->m->y` before +for the two groups. Let us compute the +differences: + + +```r +ind_diff <- ind_gpB - ind_gpA +ind_diff +#> +#> == Indirect Effect == +#> +#> Path: Group B[2]: x -> m -> y +#> Path: Group A[1]: x -> m -> y +#> Function of Effects: 0.254 +#> 95.0% Bootstrap CI: [-0.173 to 0.685] +#> +#> Computation of the Function of Effects: +#> (Group B[2]: x->m->y) +#> -(Group A[1]: x->m->y) +#> +#> +#> Percentile confidence interval formed by nonparametric bootstrapping +#> with 5000 bootstrap samples. +#> +#> NOTE: +#> - The group label is printed before each path. +#> - The group number in square brackets is the number used internally in +#> lavaan. +``` + +The difference in indirect effects from `x` to `y` through `m` +is 0.254, +with a 95% confidence interval of +[-0.173, 0.685], +not significantly different from zero (*p* < .05). Therefore, +we conclude that the two groups are not significantly +different on the indirect effects. + +## Using `cond_indirect_diff()` + +If the indirect effects are computed using +`cond_indirect_effects()`, we can use the function +`cond_indirect_diff()` to compute the difference +(described [here](https://sfcheung.github.io/manymome/reference/cond_indirect_diff.html)) +This is more convenient than using the math +operator when the number of groups is +greater than two. + +Let us use `cond_indirect_diff()` on the +output of `cond_indirect_effects()`: + + +```r +ind_diff2 <- cond_indirect_diff(ind, + from = 1, + to = 2) +ind_diff2 +#> +#> == Conditional indirect effects == +#> +#> Path: x -> m -> y +#> Conditional on group(s): Group B[2], Group A[1] +#> +#> Group Group_ID ind CI.lo CI.hi Sig m~x y~m +#> 1 Group B 2 0.663 0.411 0.959 Sig 0.597 1.110 +#> 2 Group A 1 0.409 0.096 0.753 Sig 0.880 0.465 +#> +#> == Difference in Conditional Indirect Effect == +#> +#> Levels: +#> Group +#> To: Group B [2] +#> From: Group A [1] +#> +#> Levels compared: Group B [2] - Group A [1] +#> +#> Change in Indirect Effect: +#> +#> x y Change CI.lo CI.hi +#> Change x y 0.254 -0.173 0.685 +#> +#> - [CI.lo, CI.hi]: 95% percentile confidence interval. +``` + +The convention is `to` row minus `from` row. +Though may sound not intuitive, the printout +always states clearly which group is subtracted +from which group. The results are identical +to those using the math operator. + +# Advanced Skills + +## Standardized Indirect Effects + +Standardized indirect effects can be computed +as for single-group models (described [here](https://sfcheung.github.io/manymome/articles/manymome.html#standardized-indirect-effect)), +by setting `standardized_x` and/or `standardized_y`. +This is an example: + + +```r +std_gpA <- indirect_effect(x = "x", + y = "y", + m = "m", + fit = fit, + group = "Group A", + boot_ci = TRUE, + boot_out = fit_boot_out, + standardized_x = TRUE, + standardized_y = TRUE) +std_gpA +#> +#> == Indirect Effect (Both 'x' and 'y' Standardized) == +#> +#> Path: Group A[1]: x -> m -> y +#> Indirect Effect: 0.204 +#> 95.0% Bootstrap CI: [0.049 to 0.366] +#> +#> Computation Formula: +#> (b.m~x)*(b.y~m)*sd_x/sd_y +#> Computation: +#> (0.87989)*(0.46481)*(1.10557)/(2.21581) +#> +#> Percentile confidence interval formed by nonparametric bootstrapping +#> with 5000 bootstrap samples. +#> +#> Coefficients of Component Paths: +#> Path Coefficient +#> m~x 0.880 +#> y~m 0.465 +#> +#> NOTE: +#> - The effects of the component paths are from the model, not +#> standardized. +#> - SD(s) in the selected group is/are used in standardiziation. +#> - The group label is printed before each path. +#> - The group number in square brackets is the number used internally in +#> lavaan. +``` + + +```r +std_gpB <- indirect_effect(x = "x", + y = "y", + m = "m", + fit = fit, + group = "Group B", + boot_ci = TRUE, + boot_out = fit_boot_out, + standardized_x = TRUE, + standardized_y = TRUE) +std_gpB +#> +#> == Indirect Effect (Both 'x' and 'y' Standardized) == +#> +#> Path: Group B[2]: x -> m -> y +#> Indirect Effect: 0.259 +#> 95.0% Bootstrap CI: [0.166 to 0.360] +#> +#> Computation Formula: +#> (b.m~x)*(b.y~m)*sd_x/sd_y +#> Computation: +#> (0.59716)*(1.11040)*(1.00943)/(2.58386) +#> +#> Percentile confidence interval formed by nonparametric bootstrapping +#> with 5000 bootstrap samples. +#> +#> Coefficients of Component Paths: +#> Path Coefficient +#> m~x 0.597 +#> y~m 1.110 +#> +#> NOTE: +#> - The effects of the component paths are from the model, not +#> standardized. +#> - SD(s) in the selected group is/are used in standardiziation. +#> - The group label is printed before each path. +#> - The group number in square brackets is the number used internally in +#> lavaan. +``` + +In `"Group A"`, the (completely) standardized indirect effect +from `x` to `y` through `m` is +0.204. In +`"Group B"`, this effect is +0.259. + +Note that, unlike single-group model, in multigroup models, +the standardized indirect effect in a group uses the +the standard deviations of `x`- and `y`-variables in this group +to do the standardization. Therefore, two groups can have +different unstandardized +effects on a path but similar standardized effects on the +same path, or have similar unstandardized effects on a path +but different standardized effects on this path. This is a +known phenomenon in multigroup structural equation model. + +The difference in the two completely standardized indirect +effects can computed and tested using the math operator `-`: + + +```r +std_diff <- std_gpB - std_gpA +std_diff +#> +#> == Indirect Effect (Both 'x' and 'y' Standardized) == +#> +#> Path: Group B[2]: x -> m -> y +#> Path: Group A[1]: x -> m -> y +#> Function of Effects: 0.055 +#> 95.0% Bootstrap CI: [-0.133 to 0.245] +#> +#> Computation of the Function of Effects: +#> (Group B[2]: x->m->y) +#> -(Group A[1]: x->m->y) +#> +#> +#> Percentile confidence interval formed by nonparametric bootstrapping +#> with 5000 bootstrap samples. +#> +#> NOTE: +#> - The group label is printed before each path. +#> - The group number in square brackets is the number used internally in +#> lavaan. +``` + +The difference in completely standardized indirect effects +from `x` to `y` through `m` +is 0.055, +with a 95% confidence interval of +[-0.133, 0.245], +not significantly different from zero (*p* < .05). Therefore, +we conclude that the two groups are also not significantly +different on the completely standardized indirect effects. + +The function `cond_indirect_effects()` and +`cond_indirect_diff()` can also be used with standardization: + + +```r +std <- cond_indirect_effects(x = "x", + y = "y", + m = "m", + fit = fit, + boot_ci = TRUE, + boot_out = fit_boot_out, + standardized_x = TRUE, + standardized_y = TRUE) +std +#> +#> == Conditional indirect effects == +#> +#> Path: x -> m -> y +#> Conditional on group(s): Group A[1], Group B[2] +#> +#> Group Group_ID std CI.lo CI.hi Sig m~x y~m ind +#> 1 Group A 1 0.204 0.049 0.366 Sig 0.880 0.465 0.409 +#> 2 Group B 2 0.259 0.166 0.360 Sig 0.597 1.110 0.663 +#> +#> - [CI.lo to CI.hi] are 95.0% percentile confidence intervals by +#> nonparametric bootstrapping with 5000 samples. +#> - std: The standardized indirect effects. +#> - ind: The unstandardized indirect effects. +#> - 'm~x','y~m' is/are the path coefficient(s) along the path conditional +#> on the group(s). +``` + + +```r +std_diff2 <- cond_indirect_diff(std, + from = 1, + to = 2) +std_diff2 +#> +#> == Conditional indirect effects == +#> +#> Path: x -> m -> y +#> Conditional on group(s): Group B[2], Group A[1] +#> +#> Group Group_ID std CI.lo CI.hi Sig m~x y~m ind +#> 1 Group B 2 0.259 0.166 0.360 Sig 0.597 1.110 0.663 +#> 2 Group A 1 0.204 0.049 0.366 Sig 0.880 0.465 0.409 +#> +#> == Difference in Conditional Indirect Effect == +#> +#> Levels: +#> Group +#> To: Group B [2] +#> From: Group A [1] +#> +#> Levels compared: Group B [2] - Group A [1] +#> +#> Change in Indirect Effect: +#> +#> x y Change CI.lo CI.hi +#> Change x y 0.055 -0.133 0.245 +#> +#> - [CI.lo, CI.hi]: 95% percentile confidence interval. +#> - x standardized. +#> - y standardized. +``` + +The results, again, are identical to those using +`indirect_effect()` and the math operator `-`. + +## Finding All Indirect Paths in a Multigroup Model + +Suppose a model which has more than one, or has many, +indirect paths, is fitted to this dataset: + + +```r +dat2 <- data_med_complicated_mg +print(head(dat2), digits = 2) +#> m11 m12 m2 y1 y2 x1 x2 c1 c2 group +#> 1 1.05 1.17 0.514 0.063 1.027 1.82 -0.365 0.580 -0.3221 Group A +#> 2 -0.48 0.71 0.366 -1.278 -1.442 0.18 -0.012 0.620 -0.8751 Group A +#> 3 -1.18 -2.01 -0.044 -0.177 0.152 0.32 -0.403 0.257 -0.1078 Group A +#> 4 3.64 1.47 -0.815 1.309 0.052 0.98 0.139 0.054 1.2495 Group A +#> 5 -0.41 -0.38 -1.177 -0.151 0.255 -0.36 -1.637 0.275 0.0078 Group A +#> 6 0.18 -1.00 -0.119 -0.588 0.036 -0.53 0.349 0.618 -0.4073 Group A +``` + +![A Complicated Path Model](med_complicated-1.png) + +We first fit this model in `lavaan`: + + +```r +mod2 <- +" +m11 ~ x1 + x2 +m12 ~ m11 + x1 + x2 +m2 ~ x1 + x2 +y1 ~ m2 + m12 + m11 + x1 + x2 +y2 ~ m2 + m12 + m11 + x1 + x2 +" +fit2 <- sem(mod2, data = dat2, group = "group") +``` + +The function `all_indirect_paths()` can be used on a +multigroup model to identify indirect paths. The search +can be restricted by setting arguments such as +`x`, `y`, and `exclude` (see the [help page](file:///C:/GitHub/manymome/docs/reference/all_indirect_paths.html) +for details). + +For example, the following identify all paths from `x1` +to `y1`: + + +```r +paths_x1_y1 <- all_indirect_paths(fit = fit2, + x = "x1", + y = "y1") +``` + +If the `group` argument is not specified, it will automatically +identify all paths in all groups, as shown in the printout: + + +```r +paths_x1_y1 +#> Call: +#> all_indirect_paths(fit = fit2, x = "x1", y = "y1") +#> Path(s): +#> path +#> 1 Group A.x1 -> m11 -> m12 -> y1 +#> 2 Group A.x1 -> m11 -> y1 +#> 3 Group A.x1 -> m12 -> y1 +#> 4 Group A.x1 -> m2 -> y1 +#> 5 Group B.x1 -> m11 -> m12 -> y1 +#> 6 Group B.x1 -> m11 -> y1 +#> 7 Group B.x1 -> m12 -> y1 +#> 8 Group B.x1 -> m2 -> y1 +``` + +We can then use `many_indirect_effects()` to +compute the indirect effects for all paths identified: + + +```r +all_ind_x1_y1 <- many_indirect_effects(paths_x1_y1, + fit = fit2) +all_ind_x1_y1 +#> +#> == Indirect Effect(s) == +#> ind +#> Group A.x1 -> m11 -> m12 -> y1 0.079 +#> Group A.x1 -> m11 -> y1 0.106 +#> Group A.x1 -> m12 -> y1 -0.043 +#> Group A.x1 -> m2 -> y1 -0.000 +#> Group B.x1 -> m11 -> m12 -> y1 0.000 +#> Group B.x1 -> m11 -> y1 0.024 +#> Group B.x1 -> m12 -> y1 -0.000 +#> Group B.x1 -> m2 -> y1 0.004 +#> +#> - The 'ind' column shows the indirect effects. +#> +``` + +Bootstrapping and Monte Carlo confidence intervals can +be formed in the same way they are formed for single-group +models. + +## Computing, Testing, and Plotting Conditional Effects + +Though the focus is on indirect effect, +the main functions in `manymome` can also be used for +computing and plotting the effects along the direct path +between two variables. That is, we can focus on the +moderating effect of group on a direct path. + +For example, in the simple mediation model examined +above, suppose we are interested in the between-group +difference in the path from `m` to `y`, the "b path". +We can first +compute the conditional effect using `cond_indirect_effects()`, +without setting the mediator: + + +```r +path1 <- cond_indirect_effects(x = "m", + y = "y", + fit = fit, + boot_ci = TRUE, + boot_out = fit_boot_out) +path1 +#> +#> == Conditional effects == +#> +#> Path: m -> y +#> Conditional on group(s): Group A[1], Group B[2] +#> +#> Group Group_ID ind CI.lo CI.hi Sig y~m +#> 1 Group A 1 0.465 0.110 0.819 Sig 0.465 +#> 2 Group B 2 1.110 0.765 1.475 Sig 1.110 +#> +#> - [CI.lo to CI.hi] are 95.0% percentile confidence intervals by +#> nonparametric bootstrapping with 5000 samples. +#> - The 'ind' column shows the effects. +#> - 'y~m' is/are the path coefficient(s) along the path conditional on +#> the group(s). +``` + +The difference between the two paths can be tested +using bootstrapping confidence interval using +`cond_indirect_diff()`: + + +```r +path1_diff <- cond_indirect_diff(path1, + from = 1, + to = 2) +path1_diff +#> +#> == Conditional effects == +#> +#> Path: m -> y +#> Conditional on group(s): Group B[2], Group A[1] +#> +#> Group Group_ID ind CI.lo CI.hi Sig y~m +#> 1 Group B 2 1.110 0.765 1.475 Sig 1.110 +#> 2 Group A 1 0.465 0.110 0.819 Sig 0.465 +#> +#> == Difference in Conditional Indirect Effect == +#> +#> Levels: +#> Group +#> To: Group B [2] +#> From: Group A [1] +#> +#> Levels compared: Group B [2] - Group A [1] +#> +#> Change in Indirect Effect: +#> +#> x y Change CI.lo CI.hi +#> Change m y 0.646 0.148 1.152 +#> +#> - [CI.lo, CI.hi]: 95% percentile confidence interval. +``` + +Based on bootstrapping, the effect of `m` on `y` +in `"Group B"` is significantly greater than that +in `"Group A"` (*p* < .05). (This is compatible +with the conclusion on the indirect effects because +two groups can have no difference on `ab` even if +they differ on `a` and/or `b`.) + +The `plot` method for the output +of `cond_indirect_effects()` can also be used +for multigroup models: + +![Conditional Effects](manymome_draw_mod_mg-1.png) + +Note that, for multigroup models, the *tumble* +graph proposed by @bodner_tumble_2016 will +always be used. The position of a line for +a group is determined by the descriptive statistics +of this group (e.g, means and SDs). For example, +the line segment of `"Group A"` is far to the right +because `"Group A"` has a larger mean of `m` than +`"Group B"`: + + +```r +by(dat$m, dat$group, mean) +#> dat$group: Group A +#> [1] 18.43357 +#> ------------------------------------------------------------ +#> dat$group: Group B +#> [1] 13.42327 +``` + +It would be misleading if the two lines are plotted on the +same horizontal position, assuming incorrectly that the ranges +of `m` are similar in the two groups. + +The vertical positions of the two lines are similarly determined +by the distributions of other predictors in each +group (the control variables +and `x` in this example). + +Details of the `plot` method can be found +in the [help page](https://sfcheung.github.io/manymome/reference/plot.cond_indirect_effects.html). + +# Final Remarks + +There are some limitations on the support +for multigroup models. Currently, +multiple imputation is not supported. +Moreover, most functions do not (yet) +support multigroup models with +within-group moderators, except for +`cond_indirect()`. We would appreciate +users to report issues discovered when +using [manymome](https://sfcheung.github.io/manymome/index.html) +on multigroup models at [GitHub](https://github.com/sfcheung/manymome/issues). + +# Reference(s) diff --git a/vignettes/articles/med_mg.Rmd.original b/vignettes/articles/med_mg.Rmd.original new file mode 100644 index 00000000..3ad4e5c1 --- /dev/null +++ b/vignettes/articles/med_mg.Rmd.original @@ -0,0 +1,560 @@ +--- +title: "Multigroup Models With Mediation Effects" +author: "Shu Fai Cheung & Sing-Hang Cheung" +date: "`r Sys.Date()`" +output: + html_document: + fig.align: "center" + toc: true + number_sections: false +bibliography: references.bib +csl: apa.csl +--- + +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>", + fig.path = "" +) +``` + +# Introduction + +This article is a brief illustration of how to use +[manymome](https://sfcheung.github.io/manymome/index.html) +([Cheung & Cheung, 2023](https://doi.org/10.3758/s13428-023-02224-z)) +to compute and test indirect effects +in a multigroup model fitted by +`lavaan`. [^mgver] + +This article only focuses on issues specific +to multigroup models. Readers are assumed to have basic +understanding on using `manymome`. +Please refer to +the [Get Started](https://sfcheung.github.io/manymome/articles/manymome.html) +guide for a full introduction, and +[this section](https://sfcheung.github.io/manymome/articles/manymome.html#mediation-only) +on an illustration on a mediation model. + +[^mgver]: Support for multigroup model was introduced +in Version 0.1.14.2. + +# Model + +This is the sample data set that comes with the package: + +```{r dataset_me_mg} +library(manymome) +dat <- data_med_mg +print(head(dat), digits = 3) +``` + +Suppose this is the model being fitted, with `c1` and +`c2` the control variables. The grouping variable is `group`, +with two possible values, `"Group A"` and `"Group B"`. + +```{r manymome_draw_med_mg, echo = FALSE, fig.cap = "Simple Mediation Model"} +library(semPlot) +suppressMessages(library(lavaan)) +mod <- +" +m ~ x + c1 + c2 +y ~ m + x + c1 + c2 +" +fit0 <- sem(mod, dat, do.fit = FALSE, fixed.x = FALSE) +layout_m <- matrix(c(NA, "m", NA, + "x", NA, "y", + "c1", NA, NA, + "c2", NA, NA), 4, 3, byrow = TRUE) +p <- semPaths(fit0, + layout = layout_m, + nCharNodes = 0, + exoCov = FALSE, + residuals = FALSE, + sizeMan = 10, + asize = 5, + DoNotPlot = TRUE) +plot(p) +text(label = "(Covariances excluded for readability)", + x = .25, y = -1, + adj = c(.5, .5)) +``` + +# Fitting the Model + +We first fit this multigroup model in +`lavaan::sem()` as usual. There is +no need to label any parameters because +`manymome` will extract the parameters +automatically. + +```{r} +mod_med <- +" +m ~ x + c1 + c2 +y ~ m + x + c1 + c2 +" +fit <- sem(model = mod_med, + data = dat, + fixed.x = FALSE, + group = "group") +``` + +These are the estimates of the paths: + +```{r est_med_mg} +summary(fit, + estimates = TRUE) +``` + +# Generate Bootstrap estimates + +We can use `do_boot()` to generate +the bootstrap estimates first +(see [this article](https://sfcheung.github.io/manymome/articles/do_boot.html) +for an illustration on this function). +The argument `ncores` can be omitted +if the default value is acceptable. + +```{r do_boot_mg, results = FALSE} +fit_boot_out <- do_boot(fit = fit, + R = 5000, + seed = 53253, + ncores = 8) +``` + +# Estimate Indirect Effects + +## Estimate Each Effect by `indirect_effect()` + +The function `indirect_effect()` can be used to as usual +to estimate an indirect effect +and form its bootstrapping or Monte Carlo +confidence interval along a path in a model +that starts with any numeric variable, ends with +any numeric variable, through any numeric variable(s). +A detailed illustration can be found in +[this section](https://sfcheung.github.io/manymome/articles/manymome.html#est_indirect). + +For a multigroup model, the only +difference is that users need to specify +the group using the argument `group`. +It can be set to the group label +as used in `lavaan` (`"Group A"` +or `"Group B"` in this example) +or the group number used in `lavaan` + +```{r do_indirect_mg_A} +ind_gpA <- indirect_effect(x = "x", + y = "y", + m = "m", + fit = fit, + group = "Group A", + boot_ci = TRUE, + boot_out = fit_boot_out) +``` + +This is the output: + +```{r out_med_A} +ind_gpA +``` + +The indirect effect from `x` to `y` through `m` in +`"Group A"` is `r formatC(coef(ind_gpA), digits = 3, format = "f")`, +with a 95% confidence interval of +[`r paste0(formatC(confint(ind_gpA), digits = 3, format = "f"), collapse = ", ")`], +significantly different from zero (*p* < .05). + +We illustrate computing the indirect effect in +`"Group B"`, using group number: + +```{r do_indirect_mg_B} +ind_gpB <- indirect_effect(x = "x", + y = "y", + m = "m", + fit = fit, + group = 2, + boot_ci = TRUE, + boot_out = fit_boot_out) +``` + +This is the output: + +```{r out_med_B} +ind_gpB +``` + +The indirect effect from `x` to `y` through `m` in +`"Group B"` is `r formatC(coef(ind_gpB), digits = 3, format = "f")`, +with a 95% confidence interval of +[`r paste0(formatC(confint(ind_gpA), digits = 3, format = "f"), collapse = ", ")`], +also significantly different from zero (*p* < .05). + +## Treating Group as a "Moderator" + +Instead of computing the indirect effects one-by-one, +we can also treat the grouping variable as +a "moderator" and use +`cond_indirect_effects()` to compute +the indirect effects along a path for +all groups. The detailed illustration +of this function can be found [here](https://sfcheung.github.io/manymome/articles/manymome.html#conditional-indirect-effects). +When use on a multigroup model, +wwe can omit the argument `wlevels`. +The function will automatically identify +all groups in a model, and compute +the indirect effect of the requested +path in each model. + +```{r} +ind <- cond_indirect_effects(x = "x", + y = "y", + m = "m", + fit = fit, + boot_ci = TRUE, + boot_out = fit_boot_out) +``` + +This is the output: + +```{r} +ind +``` + +The results are identical to those computed +individually using `indirect_effect()`. Using +`cond_indirect_effects()` is convenient when +the number of groups is more than two. + +# Compute and Test Between-Group difference + +There are several ways to compute and test +the difference in indirect effects between +two groups. + +## Using the Math Operator `-` + +The math operator `-` (described [here](https://sfcheung.github.io/manymome/reference/math_indirect.html)) +can be used if the indirect effects +have been computed individually by +`indirect_effect()`. We have already +computed the path `x->m->y` before +for the two groups. Let us compute the +differences: + +```{r} +ind_diff <- ind_gpB - ind_gpA +ind_diff +``` + +The difference in indirect effects from `x` to `y` through `m` +is `r formatC(coef(ind_diff), digits = 3, format = "f")`, +with a 95% confidence interval of +[`r paste0(formatC(confint(ind_diff), digits = 3, format = "f"), collapse = ", ")`], +not significantly different from zero (*p* < .05). Therefore, +we conclude that the two groups are not significantly +different on the indirect effects. + +## Using `cond_indirect_diff()` + +If the indirect effects are computed using +`cond_indirect_effects()`, we can use the function +`cond_indirect_diff()` to compute the difference +(described [here](https://sfcheung.github.io/manymome/reference/cond_indirect_diff.html)) +This is more convenient than using the math +operator when the number of groups is +greater than two. + +Let us use `cond_indirect_diff()` on the +output of `cond_indirect_effects()`: + +```{r} +ind_diff2 <- cond_indirect_diff(ind, + from = 1, + to = 2) +ind_diff2 +``` + +The convention is `to` row minus `from` row. +Though may sound not intuitive, the printout +always states clearly which group is subtracted +from which group. The results are identical +to those using the math operator. + +# Advanced Skills + +## Standardized Indirect Effects + +Standardized indirect effects can be computed +as for single-group models (described [here](https://sfcheung.github.io/manymome/articles/manymome.html#standardized-indirect-effect)), +by setting `standardized_x` and/or `standardized_y`. +This is an example: + +```{r} +std_gpA <- indirect_effect(x = "x", + y = "y", + m = "m", + fit = fit, + group = "Group A", + boot_ci = TRUE, + boot_out = fit_boot_out, + standardized_x = TRUE, + standardized_y = TRUE) +std_gpA +``` + +```{r} +std_gpB <- indirect_effect(x = "x", + y = "y", + m = "m", + fit = fit, + group = "Group B", + boot_ci = TRUE, + boot_out = fit_boot_out, + standardized_x = TRUE, + standardized_y = TRUE) +std_gpB +``` + +In `"Group A"`, the (completely) standardized indirect effect +from `x` to `y` through `m` is +`r formatC(coef(std_gpA), digits = 3, format = "f")`. In +`"Group B"`, this effect is +`r formatC(coef(std_gpB), digits = 3, format = "f")`. + +Note that, unlike single-group model, in multigroup models, +the standardized indirect effect in a group uses the +the standard deviations of `x`- and `y`-variables in this group +to do the standardization. Therefore, two groups can have +different unstandardized +effects on a path but similar standardized effects on the +same path, or have similar unstandardized effects on a path +but different standardized effects on this path. This is a +known phenomenon in multigroup structural equation model. + +The difference in the two completely standardized indirect +effects can computed and tested using the math operator `-`: + +```{r} +std_diff <- std_gpB - std_gpA +std_diff +``` + +The difference in completely standardized indirect effects +from `x` to `y` through `m` +is `r formatC(coef(std_diff), digits = 3, format = "f")`, +with a 95% confidence interval of +[`r paste0(formatC(confint(std_diff), digits = 3, format = "f"), collapse = ", ")`], +not significantly different from zero (*p* < .05). Therefore, +we conclude that the two groups are also not significantly +different on the completely standardized indirect effects. + +The function `cond_indirect_effects()` and +`cond_indirect_diff()` can also be used with standardization: + +```{r} +std <- cond_indirect_effects(x = "x", + y = "y", + m = "m", + fit = fit, + boot_ci = TRUE, + boot_out = fit_boot_out, + standardized_x = TRUE, + standardized_y = TRUE) +std +``` + +```{r} +std_diff2 <- cond_indirect_diff(std, + from = 1, + to = 2) +std_diff2 +``` + +The results, again, are identical to those using +`indirect_effect()` and the math operator `-`. + +## Finding All Indirect Paths in a Multigroup Model + +Suppose a model which has more than one, or has many, +indirect paths, is fitted to this dataset: + +```{r} +dat2 <- data_med_complicated_mg +print(head(dat2), digits = 2) +``` + +```{r med_complicated, echo = FALSE, fig.cap = "A Complicated Path Model"} +library(semPlot) +suppressMessages(library(lavaan)) +mod2 <- +" +m11 ~ x1 + x2 +m12 ~ m11 + x1 + x2 +m2 ~ x1 + x2 +y1 ~ m2 + m12 + m11 + x1 + x2 +y2 ~ m2 + m12 + m11 + x1 + x2 +" +fit0 <- sem(mod2, dat2, do.fit = FALSE, fixed.x = FALSE) +layout_m <- matrix(c( NA, "m11", NA, "m12", NA, + "x1", NA, NA, NA, "y1", + "x2", NA, NA, NA, "y2", + NA, NA, "m2", NA, NA), byrow = TRUE, 4, 5) +p <- semPaths(fit0, + residuals = FALSE, + sizeMan = 8, + exoCov = FALSE, + node.width = 1, + edge.label.cex = .50, + label.cex = .75, + style = "ram", + mar = c(5, 5, 5, 5), + layout = layout_m, + DoNotPlot = TRUE) +p$graphAttributes$Edges$color[18:19] <- "white" +plot(p) +text(-1.2, -1, paste("(Covariances and\ncontrol variables", + "omitted for readability)", sep = "\n"), + adj = c(0, .5)) +``` + +We first fit this model in `lavaan`: + +```{r} +mod2 <- +" +m11 ~ x1 + x2 +m12 ~ m11 + x1 + x2 +m2 ~ x1 + x2 +y1 ~ m2 + m12 + m11 + x1 + x2 +y2 ~ m2 + m12 + m11 + x1 + x2 +" +fit2 <- sem(mod2, data = dat2, group = "group") +``` + +The function `all_indirect_paths()` can be used on a +multigroup model to identify indirect paths. The search +can be restricted by setting arguments such as +`x`, `y`, and `exclude` (see the [help page](file:///C:/GitHub/manymome/docs/reference/all_indirect_paths.html) +for details). + +For example, the following identify all paths from `x1` +to `y1`: + +```{r} +paths_x1_y1 <- all_indirect_paths(fit = fit2, + x = "x1", + y = "y1") +``` + +If the `group` argument is not specified, it will automatically +identify all paths in all groups, as shown in the printout: + +```{r} +paths_x1_y1 +``` + +We can then use `many_indirect_effects()` to +compute the indirect effects for all paths identified: + +```{r} +all_ind_x1_y1 <- many_indirect_effects(paths_x1_y1, + fit = fit2) +all_ind_x1_y1 +``` + +Bootstrapping and Monte Carlo confidence intervals can +be formed in the same way they are formed for single-group +models. + +## Computing, Testing, and Plotting Conditional Effects + +Though the focus is on indirect effect, +the main functions in `manymome` can also be used for +computing and plotting the effects along the direct path +between two variables. That is, we can focus on the +moderating effect of group on a direct path. + +For example, in the simple mediation model examined +above, suppose we are interested in the between-group +difference in the path from `m` to `y`, the "b path". +We can first +compute the conditional effect using `cond_indirect_effects()`, +without setting the mediator: + +```{r} +path1 <- cond_indirect_effects(x = "m", + y = "y", + fit = fit, + boot_ci = TRUE, + boot_out = fit_boot_out) +path1 +``` + +The difference between the two paths can be tested +using bootstrapping confidence interval using +`cond_indirect_diff()`: + +```{r} +path1_diff <- cond_indirect_diff(path1, + from = 1, + to = 2) +path1_diff +``` + +Based on bootstrapping, the effect of `m` on `y` +in `"Group B"` is significantly greater than that +in `"Group A"` (*p* < .05). (This is compatible +with the conclusion on the indirect effects because +two groups can have no difference on `ab` even if +they differ on `a` and/or `b`.) + +The `plot` method for the output +of `cond_indirect_effects()` can also be used +for multigroup models: + +```{r manymome_draw_mod_mg, echo = FALSE, fig.cap = "Conditional Effects"} +plot(path1) +``` + +Note that, for multigroup models, the *tumble* +graph proposed by @bodner_tumble_2016 will +always be used. The position of a line for +a group is determined by the descriptive statistics +of this group (e.g, means and SDs). For example, +the line segment of `"Group A"` is far to the right +because `"Group A"` has a larger mean of `m` than +`"Group B"`: + +```{r} +by(dat$m, dat$group, mean) +``` + +It would be misleading if the two lines are plotted on the +same horizontal position, assuming incorrectly that the ranges +of `m` are similar in the two groups. + +The vertical positions of the two lines are similarly determined +by the distributions of other predictors in each +group (the control variables +and `x` in this example). + +Details of the `plot` method can be found +in the [help page](https://sfcheung.github.io/manymome/reference/plot.cond_indirect_effects.html). + +# Final Remarks + +There are some limitations on the support +for multigroup models. Currently, +multiple imputation is not supported. +Moreover, most functions do not (yet) +support multigroup models with +within-group moderators, except for +`cond_indirect()`. We would appreciate +users to report issues discovered when +using [manymome](https://sfcheung.github.io/manymome/index.html) +on multigroup models at [GitHub](https://github.com/sfcheung/manymome/issues). + +# Reference(s) diff --git a/vignettes/articles/references.bib b/vignettes/articles/references.bib index e69de29b..1146363f 100644 --- a/vignettes/articles/references.bib +++ b/vignettes/articles/references.bib @@ -0,0 +1,13 @@ + +@article{bodner_tumble_2016, + title = {Tumble graphs: Avoiding misleading end point extrapolation when graphing interactions from a moderated multiple regression analysis}, + volume = {41}, + issn = {1076-9986}, + doi = {10.3102/1076998616657080}, + pages = {593--604}, + number = {6}, + journaltitle = {Journal of Educational and Behavioral Statistics}, + author = {Bodner, Todd E.}, + date = {2016}, + keywords = {Regression, Moderation (Interaction), Graphs, Tumble Graph}, +} From d4fc6572b5ae258d788e4e46ac04e276e20381fc Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Sun, 31 Mar 2024 20:09:17 +0800 Subject: [PATCH 70/70] Update to 0.1.14.5, with README.md on multigroup models build_site() passed. --- DESCRIPTION | 2 +- NEWS.md | 7 +++---- README.md | 25 ++++++++++++++++++++++--- 3 files changed, 26 insertions(+), 8 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index d5173756..306b9b63 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: manymome Title: Mediation, Moderation and Moderated-Mediation After Model Fitting -Version: 0.1.14.4 +Version: 0.1.14.5 Authors@R: c(person(given = "Shu Fai", family = "Cheung", diff --git a/NEWS.md b/NEWS.md index 8e04a24d..d3ce3816 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# manymome 0.1.14.4 +# manymome 0.1.14.5 ## New Features @@ -9,8 +9,7 @@ that may not yet work on multigroup models. Checks will be added to them to alert users. - Vignettes to be - added or updated. For now, only some + For now, only some functions (e.g., `cond_indirect_effect()`) supports multigroup models which have @@ -20,7 +19,7 @@ multigroup models (e.g, `mod_levels()`) will raise an error if used on a multigroup model. - (0.1.14.2, 0.1.14.3, 0.1.14.4) + (0.1.14.2 to 0.1.14.5) - Relaxed the requirement that only different paths can be used in `+` diff --git a/README.md b/README.md index b68198dd..e14d4d61 100644 --- a/README.md +++ b/README.md @@ -9,7 +9,7 @@ [![R-CMD-check](https://github.com/sfcheung/manymome/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/sfcheung/manymome/actions/workflows/R-CMD-check.yaml) -(Version 0.1.14.4, updated on 2024-03-31, [release history](https://sfcheung.github.io/manymome/news/index.html)) +(Version 0.1.14.5, updated on 2024-03-31, [release history](https://sfcheung.github.io/manymome/news/index.html)) # manymome @@ -35,6 +35,9 @@ by multiple regression. The package was introduced in: while Monte Carlo is supported for models fitted by `lavaan::sem()`. +- Multigroup models fitted by `lavaan::sem()` + are also supported in 0.1.14.2 and later versions. + # Advantages - **A Simpler Workflow** @@ -47,7 +50,11 @@ by multiple regression. The package was introduced in: nearly any variable, to nearly any other variables, conditional on nearly any moderators, and at any levels of the moderators. - (See `vignette("manymome")` for details.) + (See `vignette("manymome")` for details.) This is particularly + convenient for multigroup models fitted by `lavaan::sem()`, + which are supported in 0.1.14.2 and later versions + (see [this guide](https://sfcheung.github.io/manymome/articles/med_mg.html), + for an illustration). - **Supports Both SEM-Based and Regression-Based Analysis** @@ -61,6 +68,10 @@ by multiple regression. The package was introduced in: No limit on the number of predictors, mediators, and outcome variables, other than those by `lavaan::sem()` and `lm()`. + For multigroup models fitted by `lavaan::sem()`, + there is no inherent limit on the number of groups, + other than the limit due to `lavaan::sem(), if any + (supported in 0.1.14.2 and later versions). - **Supports Standardized Effects** @@ -78,7 +89,7 @@ by multiple regression. The package was introduced in: Supports datasets with missing data through `lavaan::sem()` with full information maximum likelihood (`fiml`). - Since version 0.1.9.8, it also supports missing data handled + In version 0.1.9.8 or later, it also supports missing data handled by multiple imputation if the models are fitted by `semTools::sem.mi()` or `semTools::runMI()` (see `vignette("do_mc_lavaan_mi")`). @@ -103,6 +114,14 @@ by multiple regression. The package was introduced in: latent variables for models fitted by `lavaan::sem()` (see `vignette("med_lav")`). +- **Support Treating Group As a Moderator** + + For multigroup models fitted by `lavaan::sem()`, it supports + comparing the direct or indirect effects along any path + between any two groups. That is, it uses the grouping variable + as a moderator (illustrated [here](https://sfcheung.github.io/manymome/articles/med_mg.html); + supported in 0.1.14.2 and later versions). + # Limitations Despite the aforementioned advantages, the current version of