Merge pull request #183 from sfcheung/devel

Update to 0.2.3.8

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: manymome
 Title: Mediation, Moderation and Moderated-Mediation After Model Fitting
-Version: 0.2.3.7
+Version: 0.2.3.8
 Authors@R:
     c(person(given = "Shu Fai",
            family = "Cheung",

NEWS.md

@@ -1,4 +1,4 @@
-# manymome 0.2.3.7
+# manymome 0.2.3.8
 
 ## New Features
 
@@ -28,6 +28,11 @@
   such as when computing effects in a
   moderation-only model. (0.2.3.4)
 
+- *P*-values and confidence intervals
+  based on standard errors will now be
+  computed even for direct paths not
+  moderated. (0.2.3.8)
+
 ## Documentation
 
 - Corrected `README` to remark that

R/cond_indirect.R

@@ -656,9 +656,9 @@ cond_indirect <- function(x,
             est_vcov <- lm_est$vcov
           }
         if (is.null(lm_est$df_residual)) {
-            df_residual <- lm_list_vcov(fit)
-          } else {
             df_residual <- lm_df_residual(fit)
+          } else {
+            df_residual <- lm_est$df_residual
           }
         fit_data <- lm_est$data
       }

R/indirect.R

@@ -407,25 +407,33 @@ indirect_i <- function(x,
     if (is.null(m) &&
         !is.null(est_vcov) &&
         !is.null(df_residual) &&
-        ngroups == 1 &&
-        has_w) {
+        ngroups == 1) {
         # TODO: Add support for multigroup-models
         est_vcov <- est_vcov_list(est_vcov = est_vcov,
                                   est = est)
-        if (!is.null(wvalues)) {
-            bs_se <- sapply(prods_tmp,
-                            FUN = cond_se,
-                            est_vcov = est_vcov,
-                            wvalues = wvalues)
-            bs_df_residual <- df_residual[y]
+        if (has_w) {
+            # A direct path with some product terms in the y-model
+            if (!is.null(wvalues)) {
+                bs_se <- sapply(prods_tmp,
+                                FUN = cond_se,
+                                est_vcov = est_vcov,
+                                wvalues = wvalues)
+                bs_df_residual <- unname(df_residual[y])
+              } else {
+                bs_se <- sqrt(est_vcov[[y]][x, x])
+                bs_df_residual <- unname(df_residual[y])
+              }
           } else {
+            # A direct path with no product term in the y-model
             bs_se <- sqrt(est_vcov[[y]][x, x])
             bs_df_residual <- unname(df_residual[y])
           }
       } else {
         bs_se <- NA
         bs_df_residual <- NA
       }
+    bs_se <- unname(bs_se)
+    bs_df_residual <- unname(bs_df_residual)
     b_cond_str <- mapply(gen_computation, xi = prods, yi = bs_org,
                           yiname = names(bs_org),
                           MoreArgs = list(digits = computation_digits,

R/lm_helpers_mod.R

@@ -70,7 +70,10 @@ cond_se <- function(xi,
                     est_vcov,
                     wvalues) {
     if (all(is.na(xi))) return(0)
-    if (is.null(xi$prod)) return(0)
+    if (is.null(xi$prod)) {
+        out <- sqrt(est_vcov[[xi$y]][xi$x, xi$x, drop = FALSE])
+        return(out)
+      }
     prod_i <- xi$prod
     b_i <- xi$b
     w_i <- xi$w

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)
 <!-- badges: end -->
 
-(Version 0.2.3.7, updated on 2024-09-28, [release history](https://sfcheung.github.io/manymome/news/index.html))
+(Version 0.2.3.8, updated on 2024-09-28, [release history](https://sfcheung.github.io/manymome/news/index.html))
 
 # manymome  <img src="man/figures/logo.png" align="right" height="150" />
 

tests/testthat/test_mod_only_not_moderated.R

@@ -12,7 +12,10 @@ cond_out <- cond_indirect_effects(wlevels = "w",
                                   y = "y",
                                   fit = fit_lm)
 test_that("No moderator", {
-    expect_false(any(grepl("standard errors",
-                           capture.output(print(cond_out)))))
-    expect_true(is.null(cond_effects_original_se(cond_out)))
+    # Updated in 0.2.3.8.
+    # SEs are computed even for a direct path in
+    # a y-model with no product term.
+    expect_true(any(grepl("standard errors",
+                          capture.output(print(cond_out)))))
+    expect_false(is.null(cond_effects_original_se(cond_out)))
   })

tests/testthat/test_unmod.R

@@ -0,0 +1,50 @@
+library(testthat)
+library(manymome)
+suppressMessages(library(lavaan))
+
+test_that("More tests", {
+dat <- data_med_mod_b_mod
+lm_m <- lm(m ~ x, dat)
+lm_y <- lm(y ~ m + x*w1, dat)
+lm_out <- lm2list(lm_m, lm_y)
+b_m <- coef(lm_m)
+b_y <- coef(lm_y)
+vcov_y <- vcov(lm_y)
+vcov_m <- vcov(lm_m)
+out <- cond_indirect(x = "m", y = "y",  wvalues = c(w1 = 5), fit = lm_out)
+expect_equal(out$original_se,
+             sqrt(vcov_y["m", "m"]))
+out <- cond_indirect(x = "x", y = "m",  wvalues = c(w1 = 5), fit = lm_out)
+expect_equal(out$original_se,
+             sqrt(vcov_m["x", "x"]))
+out <- cond_indirect_effects(x = "m", y = "y", wlevels = c("w1"), fit = lm_out)
+tmp <- range(sapply(attr(out, "full_output"), function(xx) xx$original_se))
+expect_equal(mean(tmp), tmp[1])
+out <- cond_indirect_effects(x = "x", y = "m", wlevels = c("w1"), fit = lm_out)
+tmp <- range(sapply(attr(out, "full_output"), function(xx) xx$original_se))
+expect_equal(mean(tmp), tmp[1])
+expect_equal(attr(out, "full_output")[[1]]$original_se,
+             sqrt(vcov_m["x", "x"]))
+})
+
+test_that("More tests", {
+dat <- data_med_mod_b_mod
+lm_m <- lm(m ~ x, dat)
+lm_y <- lm(y ~ m + x*w1*w2, dat)
+lm_out <- lm2list(lm_m, lm_y)
+b_m <- coef(lm_m)
+b_y <- coef(lm_y)
+vcov_y <- vcov(lm_y)
+vcov_m <- vcov(lm_m)
+out <- cond_indirect(x = "m", y = "y",  wvalues = c(w1 = 5), fit = lm_out)
+expect_equal(out$original_se,
+             sqrt(vcov_y["m", "m"]))
+out <- cond_indirect(x = "x", y = "m",  wvalues = c(w1 = 5), fit = lm_out)
+expect_equal(out$original_se,
+             sqrt(vcov_m["x", "x"]))
+out <- cond_indirect_effects(x = "m", y = "y", wlevels = c("w1"), fit = lm_out)
+tmp <- range(sapply(attr(out, "full_output"), function(xx) xx$original_se))
+expect_equal(mean(tmp), tmp[1])
+expect_equal(attr(out, "full_output")[[1]]$original_se,
+             sqrt(vcov_y["m", "m"]))
+})