Merge pull request #143 from sfcheung/devel

0.1.14.6 - 0.1.14.9: A bunch of updates. Please refer to NEWS.md

DESCRIPTION

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

NEWS.md

@@ -1,4 +1,4 @@
-# manymome 0.1.14.5
+# manymome 0.1.14.9
 
 ## New Features
 
@@ -41,7 +41,19 @@
   makes more sense for multigroup
   models, in which the distribution of
   variables are allowed to be different
-  between groups. (0.1.14.2)
+  between groups. If desired, users
+  can use the model implied statistics
+  to determine the means and SDs, which
+  is useful when equality constraints
+  are present. (0.1.14.2, 0.1.14.6)
+
+- The `plot`-method of
+  `cond_indirect_effects`-class objects
+  now supports plotting a path that
+  involves latent variables. The model
+  implied statistics will always be used
+  for the latent variables when determining
+  the means and SDs. (0.1.14.7)
 
 ## Miscellaneous
 
@@ -54,6 +66,18 @@
   treated as a "product term."
   (0.1.14.1)
 
+- Bootstrapping and Monte Carlo
+  simulation will no longer be run
+  once for each path in
+  `many_indirect_effects()`. If
+  `do_boot()` or `do_mc()` is not used
+  first but bootstrapping or Monte
+  Carlo confidence intervals are
+  requested, this process will be done
+  only once, and the estimates will be
+  reused by all paths. (0.1.14.9)
+
+
 # manymome 0.1.14
 
 ## New Features

R/cond_indirect.R

@@ -135,6 +135,24 @@
 #' need to manually specify the desired
 #' value of the moderator(s).
 #'
+#' ## [many_indirect_effects()]
+#'
+#' If bootstrapping or Monte Carlo
+#' confidence intervals are requested,
+#' it is advised to use [do_boot()]
+#' first to simulate the estimates.
+#' Nevertheless, In Version 0.1.14.9
+#' and later versions, if `boot_ci`
+#' or `mc_ci` is `TRUE` when calling
+#' [many_indirect_effects()] but
+#' `boot_out` or `mc_out` is not set,
+#' bootstrapping or simulation will
+#' be done only once, and then the
+#' bootstrapping or simulated estimates
+#' will be used for all paths. This
+#' prevents accidentally repeating the
+#' process once for each direct path.
+#'
 #' @return [indirect_effect()] and
 #' [cond_indirect()] return an
 #' `indirect`-class object.
@@ -1393,20 +1411,62 @@ cond_indirect_effects <- function(wlevels,
 many_indirect_effects <- function(paths, ...) {
     path_names <- names(paths)
     xym <- all_paths_to_df(paths)
+    args <- list(...)
+    if ((isTRUE(args$boot_ci) && is.null(args$boot_out)) ||
+        (isTRUE(args$mc_ci) && is.null(args$mc_out))) {
+        do_sim_once <- TRUE
+      } else {
+        do_sim_once <- FALSE
+      }
     if ("group_label" %in% colnames(xym)) {
+        if (do_sim_once) {
+            args_tmp <- utils::modifyList(args,
+                                x = xym$x[1],
+                                y = xym$y[1],
+                                m = xym$m[1],
+                                group = xym$group_number[1])
+            sim_out <- do.call(indirect_effect, args_tmp)
+            if (isTRUE(args$boot_ci)) {
+                args_final <- utils::modifyList(args,
+                              list(boot_out = sim_out))
+              }
+            if (isTRUE(args$mc_ci)) {
+                args_final <- utils::modifyList(args,
+                              list(mc_out = sim_out))
+              }
+          } else {
+            args_final <- args
+          }
         out <- mapply(indirect_effect,
                       x = xym$x,
                       y = xym$y,
                       m = xym$m,
                       group = xym$group_number,
-                      MoreArgs = list(...),
+                      MoreArgs = args_final,
                       SIMPLIFY = FALSE)
       } else {
+        if (do_sim_once) {
+            args_tmp <- utils::modifyList(args,
+                           list(x = xym$x[1],
+                                y = xym$y[1],
+                                m = xym$m[1]))
+            sim_out <- do.call(indirect_effect, args_tmp)
+            if (isTRUE(args$boot_ci)) {
+                args_final <- utils::modifyList(args,
+                              list(boot_out = sim_out))
+              }
+            if (isTRUE(args$mc_ci)) {
+                args_final <- utils::modifyList(args,
+                              list(mc_out = sim_out))
+              }
+          } else {
+            args_final <- args
+          }
         out <- mapply(indirect_effect,
                       x = xym$x,
                       y = xym$y,
                       m = xym$m,
-                      MoreArgs = list(...),
+                      MoreArgs = args_final,
                       SIMPLIFY = FALSE)
       }
     names(out) <- path_names

R/lavaan_helpers.R

@@ -322,3 +322,29 @@ group_labels_and_numbers_list <- function(object) {
     list(label = group_labels,
          number = group_numbers)
   }
+
+#' @noRd
+# Check if a cond_indirect_effects-class object has latent x- or y-variables.
+
+cond_indirect_effects_has_x_y <- function(object) {
+    fit <- attr(object, "fit")
+    fit_type <- cond_indirect_check_fit(fit)
+    if (isFALSE(fit_type %in% c("lavaan", "lavaan.mi"))) {
+        out <- list(x_latent = NA,
+                    y_latent = NA)
+        return(out)
+      } else {
+        fit_lav <- lavaan::lavNames(fit, "lv")
+        if (length(fit_lav) == 0) {
+            out <- list(x_latent = NA,
+                        y_latent = NA)
+            return(out)
+          }
+        full_output <- attr(object, "full_output")[[1]]
+        fit_x <- full_output$x
+        fit_y <- full_output$y
+        out <- list(x_latent = isTRUE(fit_x %in% fit_lav),
+                    y_latent = isTRUE(fit_y %in% fit_lav))
+        return(out)
+      }
+  }

R/plotmod.R

@@ -29,10 +29,31 @@
 #' fitted by `lavaan`. If the effect
 #' for each group is drawn, the
 #' `graph_type` is automatically switched
-#' to `"bumble"` and the means and SDs
+#' to `"tumble"` and the means and SDs
 #' in each group will be used to determine
 #' the locations of the points.
 #'
+#' If the multigroup model has any equality
+#' constraints, the implied means and/or
+#' SDs may be different from those of
+#' the raw data. For example, the mean
+#' of the `x`-variable may be constrained
+#' to be equal in this model. To plot
+#' the tumble graph using the model implied
+#' means and SDs, set `use_implied_stats`
+#' to `TRUE`.
+#'
+#' ## Latent Variables
+#'
+#' A path that involves a latent `x`-variable
+#' and/or a latent `y`-variable can be
+#' plotted. Because the latent variables
+#' have no observed data, the model
+#' implied statistics will always be used
+#' to get the means and SDs to compute
+#' values such as the low and high points
+#' of the `x`-variable.
+#'
 #' @return A [ggplot2] graph. Plotted if
 #' not assigned to a name. It can be
 #' further modified like a usual
@@ -78,7 +99,9 @@
 #' variable, `"sd"`. If equal to
 #' `"percentile"`, then the percentiles
 #' of the focal variable in the dataset
-#' is used.
+#' is used. If the focal variable is
+#' a latent variable, only
+#' `"sd"` can be used.
 #'
 #' @param x_percentiles If `x_method` is
 #' `"percentile"`, then this argument
@@ -136,6 +159,18 @@
 #' for single-group models, and
 #' `"tumble"` for multigroup models.
 #'
+#' @param use_implied_stats For a
+#' multigroup model, if `TRUE`,
+#' model implied statistics will be
+#' used in computing the means and SDs,
+#' which take into equality constraints,
+#' if any.
+#' If `FALSE`, the default, then the raw
+#' data is
+#' used to compute the means and SDs.
+#' For latent variables, model implied
+#' statistics are always used.
+#'
 #' @param ... Additional arguments.
 #' Ignored.
 #'
@@ -228,6 +263,7 @@ plot.cond_indirect_effects <- function(
                             line_width = 1,
                             point_size = 5,
                             graph_type = c("default", "tumble"),
+                            use_implied_stats = FALSE,
                             ...
                     ) {
     has_groups <- cond_indirect_effects_has_groups(x)
@@ -249,7 +285,18 @@ plot.cond_indirect_effects <- function(
       }
     fit <- attr(output, "fit")
     fit_type <- cond_indirect_check_fit(fit)
+    tmp <- cond_indirect_effects_has_x_y(x)
+    x_latent <- tmp$x_latent
+    y_latent <- tmp$y_latent
+    latent_vars <- switch(fit_type,
+                          lavaan = lavaan::lavNames(fit, "lv"),
+                          lavaan.mi = lavaan::lavNames(fit, "lv"),
+                          lm = character(0))
+    has_latent <- (length(latent_vars) > 0)
     x_method <- match.arg(x_method)
+    if ((x_method == "percentile") && x_latent) {
+        stop("x_method cannot be 'percentile' if x is a latent variable.")
+      }
     graph_type <- match.arg(graph_type)
     if (has_groups && graph_type == "default") {
         # warning("Only tumble graph is supported for multiple group models. ",
@@ -272,21 +319,52 @@ plot.cond_indirect_effects <- function(
         w_names <- colnames(wlevels)
       }
     # mf0 is a list of datasets for multiple group models
+    # TODO:
+    # - Add support for paths involving latent variables
     mf0 <- switch(fit_type,
                   lavaan = lavaan::lavInspect(fit, "data"),
                   lavaan.mi = lav_data_used(fit, drop_colon = FALSE),
                   lm = merge_model_frame(fit))
+    if (has_groups && use_implied_stats) {
+        fit_implied_stats <- lavaan::lavInspect(fit, "implied")
+        fit_implied_stats <- fit_implied_stats[names(mf0)]
+        mf0 <- mapply(scale_by_implied,
+                      data_original = mf0,
+                      implied = fit_implied_stats,
+                      SIMPLIFY = FALSE)
+      }
+    # Add fill-in data if latent variables are present.
+    # The covariance structure with observed variables is not maintained but
+    # this is not an issue because only univariate means and SDs are used.
+    if (has_latent && (fit_type == "lavaan")) {
+        cov_lv <- lavaan::lavInspect(fit, "cov.lv")
+        mean_lv <- lavaan::lavInspect(fit, "mean.lv")
+        if (has_groups) {
+            cov_lv <- cov_lv[names(mf0)]
+            mean_lv <- mean_lv[names(mf0)]
+            mf0 <- mapply(add_fillin_lv,
+                          data_original = mf0,
+                          cov_lv = cov_lv,
+                          mean_lv = mean_lv,
+                          SIMPLIFY = FALSE)
+          } else {
+            mf0 <- add_fillin_lv(mf0,
+                                 cov_lv = cov_lv,
+                                 mean_lv = mean_lv)
+          }
+      }
     fit_list <- switch(fit_type,
                        lavaan = lm_from_lavaan_list(fit),
                        lavaan.mi = lm_from_lavaan_list(fit),
                        lm = fit)
     if ((fit_type == "lm") && !inherits(fit_list, "lm_list")) {
         fit_list <- lm2list(fit_list)
       }
-    dat0 <- switch(fit_type,
-                  lavaan = lavaan::lavInspect(fit, "data"),
-                  lavaan.mi = lav_data_used(fit, drop_colon = FALSE),
-                  lm = merge_model_frame(fit))
+    # dat0 <- switch(fit_type,
+    #               lavaan = lavaan::lavInspect(fit, "data"),
+    #               lavaan.mi = lav_data_used(fit, drop_colon = FALSE),
+    #               lm = merge_model_frame(fit))
+    dat0 <- mf0
     x_numeric <- TRUE
     if (!x_numeric) {
         stop("x variable must be a numeric variable.")
@@ -390,14 +468,32 @@ plot.cond_indirect_effects <- function(
                           lavaan = lavaan::lavInspect(fit, "implied"),
                           lavaan.mi = lav_implied_all(fit),
                           lm = lm2ptable(fit)$implied_stats)
+        if (has_latent) {
+            # Cannot use "cov.all" because we also need the mean vectors.
+            # numeric(0) if an element is not present.
+            cov_lv <- lavaan::lavInspect(fit, "cov.lv")
+            mean_lv <- lavaan::lavInspect(fit, "mean.lv")
+            if (has_groups) {
+                implied_stats <- mapply(add_lv_implied,
+                                   implied_stats = implied_stats,
+                                   cov_lv = cov_lv,
+                                   mean_lv = mean_lv,
+                                   SIMPLIFY = FALSE)
+              } else {
+                implied_stats <- add_lv_implied(
+                                   implied_stats = implied_stats,
+                                   cov_lv = cov_lv,
+                                   mean_lv = mean_lv)
+              }
+          }
       }
     if (x_standardized) {
         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]
+                        sqrt(xx$cov[x, x])
                       })
             x_mean <- sapply(implied_stats, function(xx) {
                         out <- xx$mean[x]