Merge pull request #122 from sfcheung/devel

Update to 0.2.10
sfcheung · Feb 22, 2024 · f7a44ec · f7a44ec
2 parents dd13c12 + 7f76e8d
commit f7a44ec
Show file tree

Hide file tree

Showing 10 changed files with 245 additions and 46 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: stdmod
 Title: Standardized Moderation Effect and Its Confidence Interval
-Version: 0.2.9.1
+Version: 0.2.10
 Authors@R:
     c(person(given = "Shu Fai",
            family = "Cheung",
@@ -23,7 +23,7 @@ License: GPL-3
 Encoding: UTF-8
 LazyData: true
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1
 Suggests:
     testthat,
     knitr,

diff --git a/NEWS.md b/NEWS.md
@@ -1,10 +1,9 @@
-# stdmod 0.2.9.1
+# stdmod 0.2.10
 
-- Revised `update.std_selected()`. Though
-  still not recommended, it should now
-  work more reliably if it needs to be
-  called. (0.2.9.1)
-- Improved the printout of the `summary()` of `std_selected()`
+## New Features
+
+- Improved the printout of the `summary()`
+  of `std_selected()`
   and `std_selected_boot()` outputs.
   It now prints the R-squared increase
   of the highest order term, as well as
@@ -13,6 +12,20 @@
   order term (e.g., an interaction
   term). (0.2.9.1)
 
+- Added the argument `w_values` to
+  `cond_effect()` and `plolmod()`.
+  Users can specify the
+  values of the moderator (`w`)
+  to be used to compute the conditional
+  effects. (0.2.9.2)
+
+## Miscellaneous
+
+- Revised `update.std_selected()`. Though
+  still not recommended, it should now
+  work more reliably if it needs to be
+  called. (0.2.9.1)
+
 # stdmod 0.2.9
 
 - Fixed the issue with `stdmod-package`. (0.2.8.9001)

diff --git a/R/condeff.R b/R/condeff.R
@@ -102,6 +102,19 @@
 #'                          "high" for the moderator. Default is 1.
 #'                          Ignored if `w` is categorical.
 #'
+#' @param w_values The values of `w` to
+#' be used. Default is `NULL`. If a
+#' numeric vector is supplied, these
+#' values will be used to compute the
+#' conditional effects. Other arguments
+#' on generating levels are ignored.
+#' Note that, if `w` has been standardized
+#' or centered, these values are for
+#' the standardized or centered `w`.
+#' The values will always be sorted.
+#' This argument is ignored if `w` is
+#' categorical.
+#'
 #' @author Shu Fai Cheung <https://orcid.org/0000-0002-9871-9448>
 #'
 #'
@@ -133,7 +146,8 @@ cond_effect <- function(output,
                       w_method = c("sd", "percentile"),
                       w_percentiles = c(.16, .50, .84),
                       w_sd_to_percentiles = NA,
-                      w_from_mean_in_sd = 1
+                      w_from_mean_in_sd = 1,
+                      w_values = NULL
                       ) {
     mf0 <- stats::model.frame(output)
     w_method <- match.arg(w_method)
@@ -165,15 +179,20 @@ cond_effect <- function(output,
         class(output0) <- tmp[!(tmp %in% "std_selected")]
       }
     if (w_numeric) {
-        w_levels <- gen_levels(mf0[, w],
-                              method = w_method,
-                              from_mean_in_sd = w_from_mean_in_sd,
-                              levels = c(-1, 0, 1),
-                              sd_levels = c(-1, 0, 1),
-                              sd_to_percentiles = w_sd_to_percentiles,
-                              percentiles = w_percentiles)
-        w_levels <- sort(w_levels, decreasing = TRUE)
-        w_levels_labels <- c("High", "Medium", "Low")
+        if (is.numeric(w_values)) {
+            w_levels <- sort(w_values, decreasing = TRUE)
+            w_levels_labels <- as.character(w_levels)
+          } else {
+            w_levels <- gen_levels(mf0[, w],
+                                  method = w_method,
+                                  from_mean_in_sd = w_from_mean_in_sd,
+                                  levels = c(-1, 0, 1),
+                                  sd_levels = c(-1, 0, 1),
+                                  sd_to_percentiles = w_sd_to_percentiles,
+                                  percentiles = w_percentiles)
+            w_levels <- sort(w_levels, decreasing = TRUE)
+            w_levels_labels <- c("High", "Medium", "Low")
+          }
       } else {
         w_levels <- levels(as.factor(mf0[, w]))
         w_levels_labels <- w_levels

diff --git a/R/plotmod.R b/R/plotmod.R
@@ -117,6 +117,20 @@
 #'                            `x_sd_to_percentiles` is set to 1, then the lower
 #'                            and upper percentiles are 16th and 84th,
 #'                            respectively. Default is `NA`.
+#'
+#' @param w_values The values of `w` to
+#' be used. Default is `NULL`. If a
+#' numeric vector is supplied, these
+#' values will be used to compute the
+#' conditional effects. Other arguments
+#' on generating levels are ignored.
+#' Note that, if `w` has been standardized
+#' or centered, these values are for
+#' the standardized or centered `w`.
+#' The values will always be sorted.
+#' This argument is ignored if `w` is
+#' categorical.
+#'
 #' @param note_standardized If `TRUE`, will check whether a variable has SD
 #'                          nearly equal to one. If yes, will report this in the
 #'                          plot.
@@ -192,6 +206,7 @@ plotmod <- function(output, x, w,
                             x_percentiles = c(.16, .84),
                             w_sd_to_percentiles = NA,
                             x_sd_to_percentiles= NA,
+                            w_values = NULL,
                             note_standardized = TRUE,
                             no_title = FALSE,
                             line_width = 1,
@@ -225,32 +240,37 @@ plotmod <- function(output, x, w,
         stop("x variable must be a numeric variable.")
       }
     if (w_numeric) {
-        w_levels <- gen_levels(mf0[, w],
-                              method = w_method,
-                              from_mean_in_sd = w_from_mean_in_sd,
-                              levels = c(-1, 1),
-                              sd_levels = c(-1, 1),
-                              sd_to_percentiles = w_sd_to_percentiles,
-                              percentiles = w_percentiles)
-        tmp <- length(w_levels)
-        if (tmp == 2) {
-          w_levels_labels <- c("Low", "High")
-        }
-        if (tmp == 3) {
-          w_levels_labels <- c("Low", "Medium", "High")
-        }
-        if (tmp > 3) {
-          if (w_method == "percentile") {
-              w_levels_labels <- paste0(formatC(w_percentiles * 100,
-                                                digits = 0,
-                                                format = "f"),
-                                        "%")
-            } else {
-              w_levels_labels <- formatC(w_levels,
-                                         digits = 2,
-                                         format = "f")
+        if (is.numeric(w_values)) {
+            w_levels <- sort(w_values, decreasing = TRUE)
+            w_levels_labels <- as.character(w_levels)
+          } else {
+            w_levels <- gen_levels(mf0[, w],
+                                  method = w_method,
+                                  from_mean_in_sd = w_from_mean_in_sd,
+                                  levels = c(-1, 1),
+                                  sd_levels = c(-1, 1),
+                                  sd_to_percentiles = w_sd_to_percentiles,
+                                  percentiles = w_percentiles)
+            tmp <- length(w_levels)
+            if (tmp == 2) {
+              w_levels_labels <- c("Low", "High")
+            }
+            if (tmp == 3) {
+              w_levels_labels <- c("Low", "Medium", "High")
             }
-        }
+            if (tmp > 3) {
+              if (w_method == "percentile") {
+                  w_levels_labels <- paste0(formatC(w_percentiles * 100,
+                                                    digits = 0,
+                                                    format = "f"),
+                                            "%")
+                } else {
+                  w_levels_labels <- formatC(w_levels,
+                                            digits = 2,
+                                            format = "f")
+                }
+            }
+          }
       } else {
         w_lo <- NA
         w_hi <- NA

diff --git a/README.md b/README.md
@@ -13,7 +13,7 @@
 
 # stdmod: Standardized Moderation <img src="man/figures/logo.png" align="right" height="150" />
 
-(Version 0.2.9.1, updated on 2023-11-14, [release history](https://sfcheung.github.io/stdmod/news/index.html))
+(Version 0.2.10, updated on 2024-02-22, [release history](https://sfcheung.github.io/stdmod/news/index.html))
 
 (Important changes since 0.2.0.0: Bootstrap confidence intervals and
 variance-covariance matrix of estimates are the defaults of `confint()`

diff --git a/man/cond_effect.Rd b/man/cond_effect.Rd
diff --git a/man/plotmod.Rd b/man/plotmod.Rd
diff --git a/man/stdmod-package.Rd b/man/stdmod-package.Rd
diff --git a/tests/testthat/test_condeff_user_value.R b/tests/testthat/test_condeff_user_value.R
@@ -0,0 +1,63 @@
+library(testthat)
+library(stdmod)
+
+dat <- sleep_emo_con
+lm_out <- lm(sleep_duration ~ age + gender + emotional_stability*conscientiousness, dat)
+lm_std <- std_selected(lm_out,
+                      to_center = ~ .,
+                      to_scale = ~ .)
+out_ustd <- cond_effect(lm_out, x = "emotional_stability", w = "conscientiousness",
+                        w_values = c(20, 3, 54, -4))
+out_std <- cond_effect(lm_std, x = "emotional_stability", w = "conscientiousness",
+                       w_values = c(-1.5, 23))
+
+dat$w_a <- dat$conscientiousness - 54
+dat$w_b <- dat$conscientiousness - 20
+dat$w_c <- dat$conscientiousness - 3
+dat$w_d <- dat$conscientiousness - -4
+lm_out_a <-  lm(sleep_duration ~ age + gender + emotional_stability*w_a, dat)
+lm_out_b <-  lm(sleep_duration ~ age + gender + emotional_stability*w_b, dat)
+lm_out_c <-  lm(sleep_duration ~ age + gender + emotional_stability*w_c, dat)
+lm_out_d <-  lm(sleep_duration ~ age + gender + emotional_stability*w_d, dat)
+out_ustd_check <- c(coef(lm_out_a)["emotional_stability"],
+                    coef(lm_out_b)["emotional_stability"],
+                    coef(lm_out_c)["emotional_stability"],
+                    coef(lm_out_d)["emotional_stability"])
+out_ustd[, 3]
+
+dat_std <- data.frame(scale(dat[, 2:5]), gender = dat$gender)
+dat_std$w_a <- dat_std$conscientiousness - 23
+dat_std$w_b <- dat_std$conscientiousness - (-1.5)
+lm_std_a <-  lm(sleep_duration ~ age + gender + emotional_stability*w_a, dat_std)
+lm_std_b <-  lm(sleep_duration ~ age + gender + emotional_stability*w_b, dat_std)
+out_std_check <- c(coef(lm_std_a)["emotional_stability"],
+                   coef(lm_std_b)["emotional_stability"])
+out_std[, 3]
+
+test_that("Check ustd", {
+    expect_equivalent(
+        out_ustd_check, out_ustd[, 3]
+      )
+  })
+
+test_that("Check std", {
+    expect_equivalent(
+        out_std_check, out_std[, 3]
+      )
+  })
+
+# Test cond_effect_boot with do_boot = FALSE
+
+out_nb_ustd <- cond_effect_boot(lm_out, x = "emotional_stability", w = "conscientiousness",
+                                w_values = c(20, 3, 54, -4), do_boot = FALSE)
+out_nb_std <- cond_effect_boot(lm_std, x = "emotional_stability", w = "conscientiousness",,
+                               w_values = c(-1.5, 23), do_boot = FALSE)
+
+test_that("cond_effect_boot with do_boot = FALSE", {
+    expect_equivalent(
+        out_nb_ustd, out_ustd
+      )
+    expect_equivalent(
+        out_nb_std, out_std
+      )
+  })