Skip to content

Commit

Permalink
Merge pull request #206 from sfcheung/devel
Browse files Browse the repository at this point in the history 
0.2.5.3: Add direct effects to quick functions
  • Loading branch information
@sfcheung
sfcheung authored Jan 18, 2025
2 parents aaa2ada + 769a67e commit 7b4a5d9
Show file tree
Hide file tree
Showing 8 changed files with 496 additions and 20 deletions.
2 changes: 1 addition & 1 deletion DESCRIPTION
View file
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
Package: manymome
Title: Mediation, Moderation and Moderated-Mediation After Model Fitting
Version: 0.2.5.2
Version: 0.2.5.3
Authors@R:
c(person(given = "Shu Fai",
family = "Cheung",
Expand Down
10 changes: 5 additions & 5 deletions NEWS.md
View file
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
# manymome 0.2.5.2
# manymome 0.2.5.3

## New Features

Expand All @@ -9,10 +9,10 @@
`q_serial_mediation()`, and
`q_parallel_mediation()` for
simple, serial, and parallel
mediation models, respectively.
(0.2.5.1, 0.2.5.2). Also added an
article to the website to introduce
these functions.
mediation models, respectively. Also
added an article to the website to
introduce these functions.
(0.2.5.1, 0.2.5.2, 0.2.5.3)

# manymome 0.2.5

Expand Down
3 changes: 3 additions & 0 deletions R/print_indirect_list.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -169,6 +169,9 @@ print.indirect_list <- function(x, digits = 3,
}
# Should always have mediators
has_m <- TRUE
all_m_null <- sapply(x,
function(xx) {is.null(xx$m)})
if (all(all_m_null)) has_m <- FALSE
coef0 <- indirect_effects_from_list(xold,
add_sig = TRUE,
pvalue = pvalue,
Expand Down
144 changes: 143 additions & 1 deletion R/q_mediation.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -367,6 +367,61 @@ q_mediation <- function(x,
ind_total_stdy <- total_indirect_effect(ind_stdy, x = x, y = y)
ind_total_std0 <- total_indirect_effect(ind_std0, x = x, y = y)

# Direct effects

direct_path <- list(path = list(x = x,
y = y,
m = NULL))
names(direct_path) <- paste(x, "->", y)
dir_ustd <- many_indirect_effects(paths = direct_path,
fit = lm_all,
R = R,
boot_ci = TRUE,
boot_type = boot_type,
level = level,
seed = seed,
progress = progress,
ncores = ncores,
parallel = parallel,
boot_out = ind_with_boot_out)
dir_stdy <- many_indirect_effects(paths = direct_path,
fit = lm_all,
R = R,
boot_ci = TRUE,
boot_type = boot_type,
level = level,
seed = seed,
progress = progress,
ncores = ncores,
parallel = FALSE,
standardized_y = TRUE,
boot_out = ind_with_boot_out)
dir_stdx <- many_indirect_effects(paths = direct_path,
fit = lm_all,
R = R,
boot_ci = TRUE,
boot_type = boot_type,
level = level,
seed = seed,
progress = progress,
ncores = ncores,
parallel = FALSE,
standardized_x = TRUE,
boot_out = ind_with_boot_out)
dir_std0 <- many_indirect_effects(paths = direct_path,
fit = lm_all,
R = R,
boot_ci = TRUE,
boot_type = boot_type,
level = level,
seed = seed,
progress = progress,
ncores = ncores,
parallel = FALSE,
standardized_y = TRUE,
standardized_x = TRUE,
boot_out = ind_with_boot_out)

# Combine the output
out <- list(lm_out = lm_all,
lm_form = lm_forms,
Expand All @@ -378,6 +433,10 @@ q_mediation <- function(x,
stdx = ind_total_stdx,
stdy = ind_total_stdy,
stdxy = ind_total_std0),
dir_out = list(ustd = dir_ustd,
stdx = dir_stdx,
stdy = dir_stdy,
stdxy = dir_std0),
call = match.call(),
model = model,
x = x,
Expand Down Expand Up @@ -999,13 +1058,96 @@ print.q_mediation <- function(x,
...)
}

# Print indirect effects

print_direct <- !is.null(x$dir_out$ustd) ||
!is.null(x$dir_out$stdx) ||
!is.null(x$dir_out$stdy) ||
!is.null(x$dir_out$stdxy)

print_direct_std <- !is.null(x$dir_out$stdx) ||
!is.null(x$dir_out$stdy) ||
!is.null(x$dir_out$stdxy)

if (print_direct) {
cat("\n")
cat("===================================================\n")
cat("| Direct Effect Results |\n")
cat("===================================================\n")
}

if (!is.null(x$dir_out$ustd)) {
print(x$dir_out$ustd,
digits = digits,
annotation = annotation,
pvalue = pvalue,
pvalue_digits = pvalue_digits,
se = se,
for_each_path = for_each_path,
...)
}

if (!is.null(x$dir_out$stdx)) {
print(x$dir_out$stdx,
digits = digits,
annotation = annotation,
pvalue = pvalue,
pvalue_digits = pvalue_digits,
se = se,
for_each_path = for_each_path,
...)
}

if (!is.null(x$dir_out$stdy)) {
print(x$dir_out$stdy,
digits = digits,
annotation = annotation,
pvalue = pvalue,
pvalue_digits = pvalue_digits,
se = se,
for_each_path = for_each_path,
...)
}

if (!is.null(x$dir_out$stdxy)) {
print(x$dir_out$stdxy,
digits = digits,
annotation = annotation,
pvalue = pvalue,
pvalue_digits = pvalue_digits,
se = se,
for_each_path = for_each_path,
...)
}

str_note <- character(0)

if (print_direct) {
str_note <- c(str_note,
strwrap(paste("- For reference, the bootstrap confidence interval",
"(and bootstrap p-value, if requested) of the",
"(unstandardize) direct effect is also reported.",
"The bootstrap p-value and the OLS t-statistic p-value",
"can be different."),
exdent = 2))
}

if (print_direct_std) {
str_note <- c(str_note,
strwrap(paste("- For the direct effects with either 'x'-variable or",
"'y'-variable, or both, standardized, it is",
"recommended to use the bootstrap confidence intervals,",
"which take into account the sampling error of",
"the sample standard deviations."),
exdent = 2))
}

if (pvalue) {
str_note <- c(str_note,
strwrap(paste("- The asymmetric bootstrap value for an effect",
"is the same whether x and/or y is/are",
"standardized."),
exdent = 2,))
exdent = 2))
}
if (length(str_note) > 0) {
cat("\n")
Expand Down
2 changes: 1 addition & 1 deletion README.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)
<!-- badges: end -->

(Version 0.2.5.2, updated on 2025-01-18, [release history](https://sfcheung.github.io/manymome/news/index.html))
(Version 0.2.5.3, updated on 2025-01-19, [release history](https://sfcheung.github.io/manymome/news/index.html))

# manymome <img src="man/figures/logo.png" align="right" height="150" />

Expand Down
97 changes: 90 additions & 7 deletions tests/testthat/test_q_fct_mediation.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -13,7 +13,8 @@ out <- q_simple_mediation(x = "x",
data = data_med,
R = 200,
seed = 1234,
parallel = FALSE)
parallel = FALSE,
progress = FALSE)
out1 <- q_simple_mediation(x = "x",
y = "y",
m = "m",
Expand All @@ -23,7 +24,8 @@ out1 <- q_simple_mediation(x = "x",
R = 200,
seed = 1234,
boot_type = "bc",
parallel = FALSE)
parallel = FALSE,
progress = FALSE)
lm_m <- lm(m ~ x + c2 + c1, data = data_med)
lm_m_c2 <- lm(m ~ x + c2, data = data_med)
lm_y <- lm(y ~ m + x + c2 + c1, data = data_med)
Expand Down Expand Up @@ -61,6 +63,25 @@ chk2 <- indirect_effect(x = "x",
standardized_y = TRUE,
parallel = FALSE,
progress = FALSE)
chk_dir0 <- indirect_effect(x = "x",
y = "y",
fit = lm_all,
boot_ci = TRUE,
boot_out = chk0,
R = 200,
seed = 1234,
parallel = FALSE,
progress = FALSE)
chk_dir1 <- indirect_effect(x = "x",
y = "y",
fit = lm_all,
boot_ci = TRUE,
boot_out = chk0,
R = 200,
seed = 1234,
standardized_y = TRUE,
parallel = FALSE,
progress = FALSE)
expect_equal(coef(out$ind_out$ustd),
coef(chk0),
ignore_attr = TRUE)
Expand All @@ -76,6 +97,12 @@ expect_equal(confint(out$ind_out$stdxy),
expect_equal(confint(out1$ind_out$stdy),
confint(chk2),
ignore_attr = TRUE)
expect_equal(confint(out$dir_out$ustd),
confint(chk_dir0),
ignore_attr = TRUE)
expect_equal(confint(out$dir_out$stdy),
confint(chk_dir1),
ignore_attr = TRUE)
expect_error(q_simple_mediation(x = "x",
y = "y",
m = "m1",
Expand All @@ -96,7 +123,8 @@ out0 <- q_serial_mediation(x = "x",
data = data_serial,
R = 100,
seed = 1234,
parallel = FALSE)
parallel = FALSE,
progress = FALSE)
out1 <- q_serial_mediation(x = "x",
y = "y",
m = c("m1", "m2"),
Expand All @@ -106,7 +134,8 @@ out1 <- q_serial_mediation(x = "x",
data = data_serial,
R = 100,
seed = 1234,
parallel = FALSE)
parallel = FALSE,
progress = FALSE)
lm_m1 <- lm(m1 ~ x + c2 + c1, data = data_serial)
lm_m2 <- lm(m2 ~ m1 + x + c1 + c2, data = data_serial)
lm_m1_v1 <- lm(m1 ~ x + c2, data = data_serial)
Expand Down Expand Up @@ -145,6 +174,26 @@ chk2 <- indirect_effect(x = "x",
standardized_y = TRUE,
parallel = FALSE,
progress = FALSE)
chk_dir0 <- indirect_effect(x = "x",
y = "y",
fit = lm_all0,
boot_ci = TRUE,
boot_out = chk0,
R = 200,
seed = 1234,
parallel = FALSE,
progress = FALSE)
chk_dir1 <- indirect_effect(x = "x",
y = "y",
fit = lm_all0,
boot_ci = TRUE,
boot_out = chk0,
R = 200,
seed = 1234,
standardized_x = TRUE,
standardized_y = TRUE,
parallel = FALSE,
progress = FALSE)
expect_equal(coef(out0$ind_out$ustd[[1]]),
coef(chk0),
ignore_attr = TRUE)
Expand All @@ -160,6 +209,12 @@ expect_equal(confint(out0$ind_out$stdxy[[1]]),
expect_equal(confint(out1$ind_out$stdy[[1]]),
confint(chk2),
ignore_attr = TRUE)
expect_equal(confint(out0$dir_out$ustd),
confint(chk_dir0),
ignore_attr = TRUE)
expect_equal(confint(out0$dir_out$stdxy),
confint(chk_dir1),
ignore_attr = TRUE)
expect_error(q_serial_mediation(x = "x",
y = "y",
m = "m",
Expand All @@ -180,7 +235,8 @@ out0 <- q_parallel_mediation(x = "x",
data = data_parallel,
R = 100,
seed = 1234,
parallel = FALSE)
parallel = FALSE,
progress = FALSE)
out1 <- q_parallel_mediation(x = "x",
y = "y",
m = c("m1", "m2"),
Expand All @@ -190,7 +246,8 @@ out1 <- q_parallel_mediation(x = "x",
data = data_parallel,
R = 100,
seed = 1234,
parallel = FALSE)
parallel = FALSE,
progress = FALSE)
lm_m1 <- lm(m1 ~ x + c2 + c1, data = data_parallel)
lm_m2 <- lm(m2 ~ x + c1 + c2, data = data_parallel)
lm_m1_v1 <- lm(m1 ~ x + c2, data = data_parallel)
Expand Down Expand Up @@ -262,7 +319,25 @@ chk2b <- indirect_effect(x = "x",
standardized_y = TRUE,
parallel = FALSE,
progress = FALSE)

chk_dir0 <- indirect_effect(x = "x",
y = "y",
fit = lm_all0,
boot_ci = TRUE,
boot_out = chk0a,
R = 200,
seed = 1234,
parallel = FALSE,
progress = FALSE)
chk_dir1 <- indirect_effect(x = "x",
y = "y",
fit = lm_all0,
boot_ci = TRUE,
boot_out = chk0a,
R = 200,
seed = 1234,
standardized_x = TRUE,
parallel = FALSE,
progress = FALSE)
expect_equal(coef(out0$ind_out$ustd[[1]]),
coef(chk0a),
ignore_attr = TRUE)
Expand Down Expand Up @@ -305,6 +380,14 @@ expect_equal(confint(out1$ind_out$stdy[[2]]),
expect_equal(confint(out1$ind_total$stdy),
confint(chk2a + chk2b),
ignore_attr = TRUE)

expect_equal(confint(out0$dir_out$ustd),
confint(chk_dir0),
ignore_attr = TRUE)
expect_equal(confint(out0$dir_out$stdx),
confint(chk_dir1),
ignore_attr = TRUE)

expect_error(q_parallel_mediation(x = "x",
y = "y",
m = "m",
Expand Down
Loading

0 comments on commit 7b4a5d9

Please sign in to comment.