Merge pull request #179 from sfcheung/devel

Update to 0.2.3.5
sfcheung · Sep 28, 2024 · 48199e3 · 48199e3
2 parents 490b5c9 + b7f816a
commit 48199e3
Show file tree

Hide file tree

Showing 27 changed files with 173 additions and 22 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: manymome
 Title: Mediation, Moderation and Moderated-Mediation After Model Fitting
-Version: 0.2.3.3
+Version: 0.2.3.5
 Authors@R:
     c(person(given = "Shu Fai",
            family = "Cheung",

diff --git a/NEWS.md b/NEWS.md
@@ -1,4 +1,4 @@
-# manymome 0.2.3.3
+# manymome 0.2.3.5
 
 ## New Features
 
@@ -7,7 +7,9 @@
   using `facet_grid()` to plot the
   conditional effects when there are
   two or more moderators in a path.
-  (0.2.3.3)
+  (0.2.3.3, 0.2.3.5)
+
+## Improvement
 
 - If all paths have the same `x`
   variables, the argument `x` can be
@@ -18,6 +20,14 @@
   omitted when calling
   `total_indirect_effect()`. (0.2.3.2)
 
+- If appropriate, most functions will
+  automatically convert a single
+  model fitted by `lm()` to a list by
+  `lm2list()`. This allows users to
+  use the output of `lm()` directly,
+  such as when computing effects in a
+  moderation-only model. (0.2.3.4)
+
 ## Bug Fixes
 
 - Fixed an issue related to

diff --git a/R/all_indirect_paths.R b/R/all_indirect_paths.R
@@ -31,10 +31,13 @@
 #' columns, `x`, `y`, and `m`, which can be used by
 #' functions such as [indirect_effect()].
 #'
-#' @param fit A fit object. Either the output of
+#' @param fit A fit object. It can be the output of
 #' [lavaan::lavaan()] or its wrapper such as [lavaan::sem()],
 #' or a list of the output of [lm()] or the output of
 #' [lm2list()].
+#' If it is a single model fitted by
+#' [lm()], it will be automatically converted
+#' to a list by [lm2list()].
 #'
 #' @param exclude A character vector of variables to be excluded
 #' in the search, such as control variables.
@@ -146,6 +149,9 @@ all_indirect_paths <- function(fit = NULL,
                                x = NULL,
                                y = NULL,
                                group = NULL) {
+    if (!is.null(fit)) {
+        fit <- auto_lm2list(fit)
+      }
     fit_type <- cond_indirect_check_fit(fit)
     if (is.na(fit_type)) {
         stop("'fit' is not of a supported type.")

diff --git a/R/boot2est_lm.R b/R/boot2est_lm.R
@@ -101,6 +101,9 @@
 
 lm2boot_out <- function(outputs, R = 100, seed = NULL,
                         progress = TRUE) {
+    if (!missing(outputs)) {
+         outputs <- auto_lm2list(outputs)
+      }
     out_type <- cond_indirect_check_fit(outputs)
     if (out_type != "lm") {
         stop("'outputs' must be a list of 'lm()' outputs.")
@@ -181,6 +184,9 @@ lm2boot_out_parallel <- function(outputs,
                                  ncores = max(parallel::detectCores(logical = FALSE) - 1, 1),
                                  make_cluster_args = list(),
                                  progress = TRUE) {
+    if (!missing(outputs)) {
+         outputs <- auto_lm2list(outputs)
+      }
     out_type <- cond_indirect_check_fit(outputs)
     if (out_type != "lm") {
         stop("'outputs' must be a list of 'lm()' outputs.")

diff --git a/R/check_path.R b/R/check_path.R
@@ -46,6 +46,9 @@
 #' returned by
 #' [semTools::runMI()] or
 #' its wrapper, such as [semTools::sem.mi()].
+#' If it is a single model fitted by
+#' [lm()], it will be automatically converted
+#' to a list by [lm2list()].
 #'
 #' @param x Character. The name of
 #' predictor at the start of the path.
@@ -99,6 +102,7 @@ check_path <- function(x,
                        m = NULL,
                        fit = NULL,
                        est = NULL) {
+    fit <- auto_lm2list(fit)
     if (is.null(est)) {
       fit_type <- cond_indirect_check_fit(fit)
       est <- switch(fit_type,

diff --git a/R/cond_indirect.R b/R/cond_indirect.R
@@ -198,6 +198,9 @@
 #' returned by
 #' [semTools::runMI()] or
 #' its wrapper, such as [semTools::sem.mi()].
+#' If it is a single model fitted by
+#' [lm()], it will be automatically converted
+#' to a list by [lm2list()].
 #'
 #' @param est The output of
 #' [lavaan::parameterEstimates()]. If
@@ -528,6 +531,7 @@ cond_indirect <- function(x,
                      ci_type = NULL,
                      group = NULL,
                      boot_type = c("perc", "bc")) {
+    fit <- auto_lm2list(fit)
     boot_type <- match.arg(boot_type)
     fit_type <- cond_indirect_check_fit(fit)
     chkpath <- check_path(x = x, y = y, m = m, fit = fit, est = est)
@@ -827,6 +831,7 @@ indirect_effect <- function(x,
                      ci_type = NULL,
                      boot_type = c("perc", "bc"),
                      group = NULL) {
+    fit <- auto_lm2list(fit)
     boot_type <- match.arg(boot_type)
     cond_indirect(x = x,
                   y = y,
@@ -975,6 +980,7 @@ cond_indirect_effects <- function(wlevels,
                                   boot_type = c("perc", "bc"),
                                   groups = NULL,
                                   ...) {
+    fit <- auto_lm2list(fit)
     boot_type <- match.arg(boot_type)
     # Check the number of groups and handle multiple-group models
     has_group <- FALSE

diff --git a/R/do_boot.R b/R/do_boot.R
@@ -58,11 +58,14 @@
 #' the variables in each bootstrap
 #' sample.
 #'
-#' @param fit Either (a) a list of `lm`
+#' @param fit It can be (a) a list of `lm`
 #' class objects, or the output of
 #' [lm2list()] (i.e., an `lm_list`-class
 #' object), or (b) the output of
 #' [lavaan::sem()].
+#' If it is a single model fitted by
+#' [lm()], it will be automatically converted
+#' to a list by [lm2list()].
 #'
 #' @param R The number of bootstrap
 #' samples. Default is 100.
@@ -137,6 +140,9 @@ do_boot <- function(fit,
                     ncores = max(parallel::detectCores(logical = FALSE) - 1, 1),
                     make_cluster_args = list(),
                     progress = TRUE) {
+    if (!missing(fit)) {
+         fit <- auto_lm2list(fit)
+      }
     fit_type <- cond_indirect_check_fit(fit)
     if (fit_type == "lavaan.mi") {
         stop("Bootstrapping does not support multiple imputation.")

diff --git a/R/do_mc.R b/R/do_mc.R
@@ -134,6 +134,9 @@ do_mc <- function(fit,
                     ncores = max(parallel::detectCores(logical = FALSE) - 1, 1),
                     make_cluster_args = list(),
                     progress = TRUE) {
+    if (!missing(fit)) {
+         fit <- auto_lm2list(fit)
+      }
     fit_type <- cond_indirect_check_fit(fit)
     if (fit_type == "lavaan" || fit_type == "lavaan.mi") {
         fit0 <- gen_mc_est(fit = fit,
@@ -161,6 +164,9 @@ gen_mc_est <- function(fit,
                        seed = NULL) {
     # fit_vcov <- tryCatch(lavaan::lavInspect(fit, "vcov"),
     #                         error = function(e) e)
+    if (!missing(fit)) {
+         fit <- auto_lm2list(fit)
+      }
     fit_vcov <- tryCatch(get_vcov(fit),
                          error = function(e) e)
       if (inherits(fit_vcov, "error")) {

diff --git a/R/get_b.R b/R/get_b.R
@@ -32,6 +32,9 @@ get_b <- function(x,
                   fit,
                   est = NULL,
                   group_number = NULL) {
+    if (!missing(fit)) {
+         fit <- auto_lm2list(fit)
+      }
     if (is.null(est)) {
       est <- lav_est(fit, se = FALSE, ci = FALSE)
     }

diff --git a/R/get_intercept.R b/R/get_intercept.R
@@ -31,6 +31,9 @@
 get_intercept <- function(x,
                           fit,
                           est = NULL) {
+    if (!missing(fit)) {
+         fit <- auto_lm2list(fit)
+      }
     if (is.null(est)) {
       est <- lav_est(fit, se = FALSE, ci = FALSE)
     }

diff --git a/R/get_prod.R b/R/get_prod.R
@@ -117,6 +117,7 @@ get_prod <- function(x,
                      est = NULL,
                      data = NULL,
                      expand = FALSE) {
+    fit <- auto_lm2list(fit)
     if (is.null(est)) {
       est <- lav_est(fit, se = FALSE, ci = FALSE)
     }

diff --git a/R/index_mome.R b/R/index_mome.R
@@ -245,6 +245,7 @@ index_of_mome <- function(x,
                           ci_out = NULL,
                           boot_type = c("perc", "bc"),
                           ...) {
+    fit <- auto_lm2list(fit)
     boot_type <- match.arg(boot_type)
     if (is.null(w) || length(w) != 1) {
         stop("The path must have exactly one moderator.")
@@ -329,6 +330,7 @@ index_of_momome <- function(x,
                             ci_out = NULL,
                             boot_type = c("perc", "bc"),
                             ...) {
+    fit <- auto_lm2list(fit)
     boot_type <- match.arg(boot_type)
     if (is.null(w) || is.null(z) ||
         length(w) != 1 || length(z) != 1) {

diff --git a/R/indirect.R b/R/indirect.R
@@ -247,7 +247,7 @@ indirect_i <- function(x,
     # Need these arguments to compute SE
     # - est_vcov
     # - df_residual
-
+    fit <- auto_lm2list(fit)
     if (is.null(est)) {
       est <- lav_est(fit)
     }

diff --git a/R/indirect_proportion.R b/R/indirect_proportion.R
@@ -101,6 +101,7 @@ indirect_proportion <- function(x,
                                 m = NULL,
                                 fit = NULL) {
     # Support for boot tentatively added but not enabled.
+    fit <- auto_lm2list(fit)
     boot_type <- "perc"
     if (is.null(m)) {
         stop("m cannot be NULL.")

diff --git a/R/lm2ptable.R b/R/lm2ptable.R
@@ -52,6 +52,9 @@
 #'
 
 lm2ptable <- function(outputs) {
+    if (!missing(outputs)) {
+        outputs <- auto_lm2list(outputs)
+      }
     mm <- merge_model_matrix(outputs)
     coefs <- lapply(outputs, coef2lor)
     out <- do.call(rbind, coefs)

diff --git a/R/lm_helpers.R b/R/lm_helpers.R
@@ -152,4 +152,12 @@ check_cases <- function(x) {
           }
       }
     return(TRUE)
+  }
+
+auto_lm2list <- function(object) {
+    if (inherits(object, "lm")) {
+        out <- lm2list(object)
+        return(out)
+      }
+    object
   }
diff --git a/R/mod_levels.R b/R/mod_levels.R
@@ -56,6 +56,9 @@
 #' returned by
 #' [semTools::runMI()] or
 #' its wrapper, such as [semTools::sem.mi()].
+#' If it is a single model fitted by
+#' [lm()], it will be automatically converted
+#' to a list by [lm2list()].
 #'
 #' @param w_type Character. Whether the
 #' moderator is a `"numeric"` variable
@@ -226,6 +229,9 @@ mod_levels <- function(w,
                        values = NULL,
                        reference_group_label = NULL,
                        descending = TRUE) {
+    if (!missing(fit)) {
+         fit <- auto_lm2list(fit)
+      }
     fit_type <- cond_indirect_check_fit(fit)
     if (fit_type == "lavaan") {
         if (lavaan::lavTech(fit, "ngroups") > 1) {
@@ -317,6 +323,9 @@ mod_levels_list <- function(...,
                             prefix = NULL,
                             descending = TRUE,
                             merge = FALSE) {
+    if (!missing(fit)) {
+         fit <- auto_lm2list(fit)
+      }
     x <- list(...)
     p <- length(x)
     if (is.null(sd_from_mean)) {

diff --git a/R/plotmod.R b/R/plotmod.R
@@ -187,6 +187,11 @@
 #' if [ggplot2::facet_grid()] is not
 #' used.
 #'
+#' @param digits The number of decimal
+#' places to be printed for numerical
+#' moderators when `facet_grid` is used.
+#' Default is 4.
+#'
 #' @param ... Additional arguments.
 #' Ignored.
 #'
@@ -284,6 +289,7 @@ plot.cond_indirect_effects <- function(
                             facet_grid_rows = NULL,
                             facet_grid_args = list(as.table = FALSE,
                                                    labeller = "label_both"),
+                            digits = 4,
                             ...
                     ) {
     has_groups <- cond_indirect_effects_has_groups(x)
@@ -617,11 +623,14 @@ plot.cond_indirect_effects <- function(
             w_names_in <- NULL
           }
         plot_df_tmp <- w_to_numeric(plot_df,
-                                    w_names = w_names)
+                                    w_names = w_names,
+                                    digits = digits)
         plot_df_xstart_tmp <- w_to_numeric(plot_df_xstart,
-                                           w_names = w_names)
+                                           w_names = w_names,
+                                           digits = digits)
         plot_df_xend_tmp <- w_to_numeric(plot_df_xend,
-                                         w_names = w_names)
+                                         w_names = w_names,
+                                         digits = digits)
         plot_df_xstart_end <- plot_df_xstart_tmp
         plot_df_xstart_end[paste0(x, "___end")] <- plot_df_xend_tmp[, x, drop = TRUE]
         plot_df_xstart_end[paste0(y, "___end")] <- plot_df_xend_tmp[, y, drop = TRUE]
@@ -702,8 +711,9 @@ w_to_numeric <- function(xx,
     for (i in colnames(xx)) {
         if (is.numeric(xx[, i]) &&
             (i %in% w_names)) {
-            xx[, i] <- as.factor(round(xx[, i],
-                                 digits = digits))
+            xx[, i] <- as.factor(formatC(xx[, i],
+                                         digits = digits,
+                                         format = "f"))
           }
       }
     xx

diff --git 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)
 <!-- badges: end -->
 
-(Version 0.2.3.3, updated on 2024-09-27, [release history](https://sfcheung.github.io/manymome/news/index.html))
+(Version 0.2.3.5, 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" />
 

diff --git a/man/all_indirect_paths.Rd b/man/all_indirect_paths.Rd
diff --git a/man/check_path.Rd b/man/check_path.Rd
diff --git a/man/cond_indirect.Rd b/man/cond_indirect.Rd