correct lavaan_defined (#28)

rempsyc · Oct 9, 2023 · b2af2b4 · b2af2b4
1 parent c022587
commit b2af2b4
Show file tree

Hide file tree

Showing 5 changed files with 62 additions and 99 deletions.
diff --git a/R/lavaan_defined.R b/R/lavaan_defined.R
@@ -7,9 +7,6 @@
 #'  the beta (B) represents the resulting `std.all` column. See "Value" section
 #'  for more details.
 #' @param fit lavaan fit object to extract fit indices from
-#' @param estimate What estimate to use, either the standardized
-#'                 estimate ("B", default), or unstandardized
-#'                 estimate ("b").
 #' @param nice_table Logical, whether to print the table as a
 #'                   [rempsyc::nice_table] as well as print the
 #'                   reference values at the bottom of the table.
@@ -60,26 +57,28 @@
 #' fit <- sem(HS.model, data = HolzingerSwineford1939)
 #' lavaan_defined(fit, lhs_name = "Indirect Effect")
 lavaan_defined <- function(fit,
-                           estimate = "B",
                            nice_table = FALSE,
                            underscores_to_symbol = "\u2192",
                            lhs_name = "User-Defined Parameter",
                            rhs_name = "Paths",
                            ...) {
-  og.names <- c("lhs", "rhs", "pvalue", "est", "ci.lower", "ci.upper")
-  new.names <- c(lhs_name, rhs_name, "p", "b", "CI_lower", "CI_upper")
-  if (estimate == "b") {
-    x <- lavaan::parameterEstimates(fit)
-  } else if (estimate == "B") {
-    x <- lavaan::standardizedsolution(fit, level = 0.95)
-    og.names[4] <- "est.std"
-    new.names[4] <- "B"
-  } else {
-    stop("The 'estimate' argument may only be one of c('B', 'b').")
-  }
+  og.names <- c("lhs", "rhs", "se", "z", "pvalue", "est", "ci.lower", "ci.upper")
+  new.names <- c(lhs_name, rhs_name, "SE", "Z", "p", "b", "CI_lower", "CI_upper", "B", "CI_lower_B", "CI_upper_B")
+
+  x <- lavaan::parameterEstimates(fit)
   x <- x[which(x["op"] == ":="), ]
   x <- x[og.names]
+
+  es <- lavaan::standardizedsolution(fit, level = 0.95)
+  es <- es[which(es["op"] == ":="), ]
+  es <- es[c("est.std", og.names[7:8])]
+
+  names(es)[2:3] <- paste0(names(es)[2:3], ".std")
+
+  x <- cbind(x, es)
+
   names(x) <- new.names
+
   if (!is.null(underscores_to_symbol)) {
     if (length(underscores_to_symbol) == 1 || length(underscores_to_symbol) == nrow(x)) {
       x[[1]] <- unlist(lapply(seq_along(underscores_to_symbol), function(i) {

diff --git a/R/lavaan_reg.R b/R/lavaan_reg.R
@@ -36,7 +36,7 @@
 #' lavaan_reg(fit)
 lavaan_reg <- function(fit, nice_table = FALSE, ...) {
   og.names <- c("lhs", "rhs", "se", "z", "pvalue", "est", "ci.lower", "ci.upper")
-  new.names <- c("Outcome", "Predictor", "SE", "z", "p", "b", "CI_lower", "CI_upper", "B", "CI_lower_B", "CI_upper_B")
+  new.names <- c("Outcome", "Predictor", "SE", "Z", "p", "b", "CI_lower", "CI_upper", "B", "CI_lower_B", "CI_upper_B")
 
   x <- lavaan::parameterEstimates(fit)
   x <- x[which(x["op"] == "~"), ]

diff --git a/man/lavaan_defined.Rd b/man/lavaan_defined.Rd
diff --git a/tests/testthat/_snaps/lavaan_defined.md b/tests/testthat/_snaps/lavaan_defined.md
@@ -3,93 +3,74 @@
     Code
       lavaan_defined(fit)
     Output
-         User.Defined.Parameter                       Paths     p      B CI_lower
-      30 ageyr → visual → speed   ageyr_visual*visual_speed 0.001 -0.151   -0.236
-      31 ageyr → visual → speed ageyr_visual*visual_textual 0.000 -0.153   -0.237
-      32 ageyr → visual → speed   grade_visual*visual_speed 0.000  0.248    0.150
-      33 ageyr → visual → speed grade_visual*visual_textual 0.000  0.252    0.160
-         CI_upper
-      30   -0.066
-      31   -0.070
-      32    0.345
-      33    0.344
+         User-Defined Parameter                       Paths         SE         Z
+      30 ageyr → visual → speed   ageyr_visual*visual_speed 0.02808889 -3.198387
+      31 ageyr → visual → speed ageyr_visual*visual_textual 0.04191650 -3.461890
+      32 ageyr → visual → speed   grade_visual*visual_speed 0.07291514  4.257496
+      33 ageyr → visual → speed grade_visual*visual_textual 0.10134908  4.947490
+                    p           b   CI_lower    CI_upper          B CI_lower_B
+      30 1.381987e-03 -0.08983914 -0.1448924 -0.03478593 -0.1508037 -0.2358595
+      31 5.363956e-04 -0.14511033 -0.2272652 -0.06295550 -0.1534909 -0.2371048
+      32 2.067294e-05  0.31043593  0.1675249  0.45334698  0.2477787  0.1503789
+      33 7.517664e-07  0.50142352  0.3027830  0.70006406  0.2521937  0.1601663
+          CI_upper_B
+      30 -0.06574796
+      31 -0.06987694
+      32  0.34517843
+      33  0.34422119
 
 # nice_fit as nice_table
 
     Code
       lavaan_defined(fit, nice_table = TRUE)
     Output
       a flextable object.
-      col_keys: `User-Defined Parameter`, `Paths`, `p`, `B`, `95% CI` 
+      col_keys: `User-Defined Parameter`, `Paths`, `SE`, `Z`, `p`, `b`, `95% CI (b)`, `B`, `95% CI (B)` 
       header has 1 row(s) 
       body has 4 row(s) 
       original dataset sample: 
-         User-Defined Parameter                       Paths            p          B
-      30 ageyr → visual → speed   ageyr_visual*visual_speed 5.108293e-04 -0.1508037
-      31 ageyr → visual → speed ageyr_visual*visual_textual 3.207669e-04 -0.1534909
-      32 ageyr → visual → speed   grade_visual*visual_speed 6.163554e-07  0.2477787
-      33 ageyr → visual → speed grade_visual*visual_textual 7.824837e-08  0.2521937
-                 95% CI
-      30 [-0.24, -0.07]
-      31 [-0.24, -0.07]
-      32   [0.15, 0.35]
-      33   [0.16, 0.34]
-
-# nice_fit estimates
-
-    Code
-      lavaan_defined(fit, estimate = "b")
-    Output
-         User.Defined.Parameter                       Paths     p      b CI_lower
-      30 ageyr → visual → speed   ageyr_visual*visual_speed 0.001 -0.090   -0.145
-      31 ageyr → visual → speed ageyr_visual*visual_textual 0.001 -0.145   -0.227
-      32 ageyr → visual → speed   grade_visual*visual_speed 0.000  0.310    0.168
-      33 ageyr → visual → speed grade_visual*visual_textual 0.000  0.501    0.303
-         CI_upper
-      30   -0.035
-      31   -0.063
-      32    0.453
-      33    0.700
-
----
-
-    Code
-      lavaan_defined(fit, estimate = "B")
-    Output
-         User.Defined.Parameter                       Paths     p      B CI_lower
-      30 ageyr → visual → speed   ageyr_visual*visual_speed 0.001 -0.151   -0.236
-      31 ageyr → visual → speed ageyr_visual*visual_textual 0.000 -0.153   -0.237
-      32 ageyr → visual → speed   grade_visual*visual_speed 0.000  0.248    0.150
-      33 ageyr → visual → speed grade_visual*visual_textual 0.000  0.252    0.160
-         CI_upper
-      30   -0.066
-      31   -0.070
-      32    0.345
-      33    0.344
+         User-Defined Parameter                       Paths         SE         Z
+      30 ageyr → visual → speed   ageyr_visual*visual_speed 0.02808889 -3.198387
+      31 ageyr → visual → speed ageyr_visual*visual_textual 0.04191650 -3.461890
+      32 ageyr → visual → speed   grade_visual*visual_speed 0.07291514  4.257496
+      33 ageyr → visual → speed grade_visual*visual_textual 0.10134908  4.947490
+                    p           b     95% CI (b)          B     95% CI (B)
+      30 1.381987e-03 -0.08983914 [-0.14, -0.03] -0.1508037 [-0.24, -0.07]
+      31 5.363956e-04 -0.14511033 [-0.23, -0.06] -0.1534909 [-0.24, -0.07]
+      32 2.067294e-05  0.31043593   [0.17, 0.45]  0.2477787   [0.15, 0.35]
+      33 7.517664e-07  0.50142352   [0.30, 0.70]  0.2521937   [0.16, 0.34]
 
 # nice_fit total effects
 
     Code
       lavaan_defined(fit)
     Output
-        User.Defined.Parameter   Paths p     B CI_lower CI_upper
-      7                     ab     a*b 0 0.285    0.164    0.405
-      8                     ab c+(a*b) 0 0.312    0.140    0.485
+        User-Defined Parameter   Paths         SE        Z            p         b
+      7                     ab     a*b 0.09204847 4.058692 4.934835e-05 0.3735964
+      8                     ab c+(a*b) 0.12471394 3.287131 1.012138e-03 0.4099510
+         CI_lower  CI_upper         B CI_lower_B CI_upper_B
+      7 0.1931847 0.5540081 0.2845821  0.1638308  0.4053334
+      8 0.1655162 0.6543859 0.3122748  0.1397572  0.4847923
 
 # nice_fit multiple symbols, lhs, rhs
 
     Code
       lavaan_defined(fit, underscores_to_symbol = c("*", "+", "|", "~"), lhs_name = "Special Parameters",
       rhs_name = "Some paths")
     Output
-               Special.Parameters                  Some.paths     p      B CI_lower
-      30   ageyr * visual * speed   ageyr_visual*visual_speed 0.001 -0.151   -0.236
-      31 ageyr + visual + textual ageyr_visual*visual_textual 0.000 -0.153   -0.237
-      32   grade | visual | speed   grade_visual*visual_speed 0.000  0.248    0.150
-      33 grade ~ visual ~ textual grade_visual*visual_textual 0.000  0.252    0.160
-         CI_upper
-      30   -0.066
-      31   -0.070
-      32    0.345
-      33    0.344
+               Special Parameters                  Some paths         SE         Z
+      30   ageyr * visual * speed   ageyr_visual*visual_speed 0.02808889 -3.198387
+      31 ageyr + visual + textual ageyr_visual*visual_textual 0.04191650 -3.461890
+      32   grade | visual | speed   grade_visual*visual_speed 0.07291514  4.257496
+      33 grade ~ visual ~ textual grade_visual*visual_textual 0.10134908  4.947490
+                    p           b   CI_lower    CI_upper          B CI_lower_B
+      30 1.381987e-03 -0.08983914 -0.1448924 -0.03478593 -0.1508037 -0.2358595
+      31 5.363956e-04 -0.14511033 -0.2272652 -0.06295550 -0.1534909 -0.2371048
+      32 2.067294e-05  0.31043593  0.1675249  0.45334698  0.2477787  0.1503789
+      33 7.517664e-07  0.50142352  0.3027830  0.70006406  0.2521937  0.1601663
+          CI_upper_B
+      30 -0.06574796
+      31 -0.06987694
+      32  0.34517843
+      33  0.34422119
 
diff --git a/tests/testthat/test-lavaan_defined.R b/tests/testthat/test-lavaan_defined.R
@@ -43,18 +43,6 @@ test_that("nice_fit as nice_table", {
   )
 })
 
-test_that("nice_fit estimates", {
-  expect_snapshot(
-    lavaan_defined(fit, estimate = "b")
-  )
-  expect_snapshot(
-    lavaan_defined(fit, estimate = "B")
-  )
-  expect_error(
-    lavaan_defined(fit, estimate = "C"),
-  )
-})
-
 test_that("nice_fit total effects", {
   set.seed(1234)
   X <- rnorm(100)