Merge pull request #90 from sfcheung/devel

Update to 0.1.9.7

DESCRIPTION

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

NEWS.md

@@ -1,4 +1,4 @@
-# manymome 0.1.9.6
+# manymome 0.1.9.7
 
 - Updated badges in README.md. (0.1.9.1)
 - Updated pkgdown site. (0.1.9.2)
@@ -7,6 +7,12 @@
 - Used a more reliable test for Monte Carlo CIs. (0.1.9.6)
 - Fixed an error in pkgdown site. (0.1.9.6)
 - Updated the logo for readability. (0.1.9.6)
+- Some print methods support printing
+  asymmetric bootstrap
+  *p*-values using the method presented
+  in Asparouhov and Muthén (2021) if bootstrapping
+  confidence interval is requested. By
+  default, *p*-values are not printed. (0.1.9.7)
 
 # manymome 0.1.9
 

R/cond_indirect.R

@@ -634,6 +634,7 @@ cond_indirect <- function(x,
                                      format = "f"), "%")
         out0$boot_ci <- boot_ci1
         out0$level <- level
+        out0$boot_p <- est2p(out0$boot_indirect)
         if (save_boot_out) {
             out0$boot_out <- boot_out
           } else {

R/cond_indirect_diff.R

@@ -219,9 +219,11 @@ cond_indirect_diff <- function(output,
         names(boot_diff_ci) <- paste0(formatC(c(100 * (1 - level) / 2,
                                       100 * (1 - (1 - level) / 2)), 2,
                                       format = "f"), "%")
+        boot_diff_p <- est2p(boot_diff)
       } else {
         boot_diff <- NA
         boot_diff_ci <- c(NA, NA)
+        boot_diff_p <- NA
       }
     wlevels <- attr(output, "wlevels")
     wlevels_from <- wlevels[from, , drop = FALSE]
@@ -231,6 +233,7 @@ cond_indirect_diff <- function(output,
     if (has_boot) out_diff_ci <- boot_diff_ci
     out <- list(index = effect_diff,
                 ci = out_diff_ci,
+                pvalue = boot_diff_p,
                 level = level,
                 from = wlevels_from,
                 to = wlevels_to,
@@ -250,6 +253,27 @@ cond_indirect_diff <- function(output,
 #' @details The `print` method of the
 #' `cond_indirect_diff`-class object.
 #'
+#' If bootstrapping confidence interval
+#' was requested, this method has the
+#' option to print a
+#' *p*-value computed by the
+#' method presented in Asparouhov and Muthén (2021).
+#' Note that this *p*-value is asymmetric
+#' bootstrap *p*-value based on the
+#' distribution of the bootstrap estimates.
+#' It is not computed based on the
+#' distribution under the null hypothesis.
+#'
+#' For a *p*-value of *a*, it means that
+#' a 100(1 - *a*)% bootstrapping confidence
+#' interval
+#' will have one of its limits equal to
+#' 0. A confidence interval
+#' with a higher confidence level will
+#' include zero, while a confidence
+#' interval with a lower confidence level
+#' will exclude zero.
+#'
 #' @return It returns `x` invisibly.
 #' Called for its side effect.
 #'
@@ -259,14 +283,32 @@ cond_indirect_diff <- function(output,
 #' @param digits The number of decimal
 #' places in the printout.
 #'
+#' @param pvalue Logical. If `TRUE`,
+#' asymmetric *p*-value based on
+#' bootstrapping will be printed if
+#' available. Default is `FALSE.`
+#'
+#' @param pvalue_digits Number of decimal
+#' places to display for the *p*-value.
+#' Default is 3.
+#'
 #' @param ... Optional arguments.
 #' Ignored.
 #'
+#'
+#' @references
+#' Asparouhov, A., & Muthén, B. (2021). Bootstrap p-value computation.
+#' Retrieved from https://www.statmodel.com/download/FAQ-Bootstrap%20-%20Pvalue.pdf
+#'
 #' @seealso [cond_indirect_diff()]
 #'
 #' @export
 
-print.cond_indirect_diff <- function(x, digits = 3, ...) {
+print.cond_indirect_diff <- function(x,
+                                     digits = 3,
+                                     pvalue = FALSE,
+                                     pvalue_digits = 3,
+                                     ...) {
     full_output_attr <- attr(x$output, "full_output")[[1]]
     print(x$output, digits = digits, annotation = FALSE, ...)
     x_type <- x$type
@@ -316,6 +358,12 @@ print.cond_indirect_diff <- function(x, digits = 3, ...) {
     if (has_ci) {
         index_df$CI.lo <- formatC(x$ci[1], digits = digits, format = "f")
         index_df$CI.hi <- formatC(x$ci[2], digits = digits, format = "f")
+        if (!identical(NA, x$boot_diff) && !is.na(x$pvalue) &&
+            pvalue) {
+            index_df$pvalue <- formatC(x$pvalue,
+                                       digits = pvalue_digits,
+                                       format = "f")
+          }
       }
     if (!is.null(x_type)) {
         rownames(index_df) <- "Index"
@@ -336,6 +384,10 @@ print.cond_indirect_diff <- function(x, digits = 3, ...) {
                           x$level * 100,
                           "% percentile confidence interval."), exdent = 3),
                           sep = "\n")
+        if (!identical(NA, x$boot_diff) && !is.na(x$pvalue) &&
+            pvalue) {
+            cat(" - P-value is asymmetric bootstrap p-value.\n", sep = "")
+          }
       }
     if (full_output_attr$standardized_x) {
         cat(" - ", full_output_attr$x, " standardized.\n", sep = "")

R/cond_indirect_effects_math.R

@@ -162,8 +162,10 @@ plusminus <- function(e1, e2, op = c("+", "-")) {
                                       100 * (1 - (1 - level0) / 2)), 2,
                                       format = "f"), "%")
         bci0 <- boot_ci1
+        bp0 <- est2p(est0)
       } else {
         bci0 <- NULL
+        bp0 <- NULL
       }
     op1 <- e1$op
     op2 <- e2$op
@@ -189,12 +191,14 @@ plusminus <- function(e1, e2, op = c("+", "-")) {
                   "\n", op, "(", op2, ")")
     bind0_boot <- NULL
     bci0_boot <- NULL
+    bp0_boot <- NULL
     bind0_mc <- NULL
     bci0_mc <- NULL
     if (has_ci) {
         if (ci_type == "boot") {
             bind0_boot <- bind0
             bci0_boot <- bci0
+            bp0_boot <- bp0
           }
         if (ci_type == "mc") {
             bind0_mc <- bind0
@@ -219,6 +223,7 @@ plusminus <- function(e1, e2, op = c("+", "-")) {
                 op = op0,
                 boot_indirect = bind0_boot,
                 boot_ci = bci0_boot,
+                boot_p = bp0_boot,
                 mc_indirect = bind0_mc,
                 mc_ci = bci0_mc,
                 level = level0,

R/est2p.R

@@ -0,0 +1,56 @@
+#' @title Asymmetric Bootstrap p-Value
+#'
+#' @description Compute the asymmetric
+#' bootstrap *p*-value from a vector of
+#' bootstrap estimates.
+#'
+#' @details It computes the *p*-value
+#' based on the method presented in
+#' Asparouhov and Muthén (2021).
+#'
+#' @return
+#' Numeric. The *p*-value. `NA` if
+#' it cannot be computed.
+#'
+#' @param x A numeric vector. The
+#' bootstrap estimates.
+#'
+#' @param h0 The value for the null
+#' hypothesis. Default is zero.
+#'
+#' @param min_size Integer. The
+#' bootstrap *p*-value will be computed
+#' only if `x` has at least `min_size`
+#' valid values.
+#'
+#' @references
+#' Asparouhov, A., & Muthén, B. (2021). Bootstrap p-value computation.
+#' Retrieved from https://www.statmodel.com/download/FAQ-Bootstrap%20-%20Pvalue.pdf
+#'
+#' @examples
+#' x1 <- rnorm(n, 2, 4)
+#' est2p(x1)
+#'
+#' @noRd
+
+est2p <- function(x,
+                  h0 = 0,
+                  min_size = 100,
+                  warn = FALSE) {
+    # Based on the method in
+    # https://www.statmodel.com/download/FAQ-Bootstrap%20-%20Pvalue.pdf
+    x <- x[!is.na(x)]
+    if (length(x) == 0) return(NA)
+    if (length(x) < min_size) {
+        if (warn) {
+          warning(paste("Bootstrap p-value not computed. Less than ",
+                        min_size,
+                        "bootstrap estimates."))
+        }
+        return(NA)
+      }
+    b <- length(x)
+    m0 <- sum((x < h0))
+    out <- 2 * min(m0 / b, 1 - m0 / b)
+    out
+  }

R/index_mome.R

@@ -377,15 +377,18 @@ index_of_momome <- function(x,
         names(ind_boot_ci) <- paste0(formatC(c(100 * (1 - level) / 2,
                                       100 * (1 - (1 - level) / 2)), 2,
                                       format = "f"), "%")
+        ind_boot_p <- est2p(ind_boot)
       } else {
         ind_boot <- NA
         ind_boot_ci <- NA
+        ind_boot_p <- NA
       }
     ind_ci <- NA
     if (has_mc) ind_ci <- ind_mc_ci
     if (has_boot) ind_ci <- ind_boot_ci
     out <- list(index = ind,
                 ci = ind_ci,
+                pvalue = ind_boot_p,
                 level = level,
                 from = i0$from,
                 to = i0$to,

R/print_cond_indirect_effect.R

@@ -4,6 +4,30 @@
 #' @description Print the content of the
 #' output of [cond_indirect_effects()]
 #'
+#' @details The `print` method of the
+#' `cond_indirect_effects`-class object.
+#'
+#' If bootstrapping confidence intervals
+#' were requested, this method has the
+#' option to print
+#' *p*-values computed by the
+#' method presented in Asparouhov and Muthén (2021).
+#' Note that these *p*-values are asymmetric
+#' bootstrap *p*-values based on the
+#' distribution of the bootstrap estimates.
+#' They not computed based on the
+#' distribution under the null hypothesis.
+#'
+#' For a *p*-value of *a*, it means that
+#' a 100(1 - *a*)% bootstrapping confidence
+#' interval
+#' will have one of its limits equal to
+#' 0. A confidence interval
+#' with a higher confidence level will
+#' include zero, while a confidence
+#' interval with a lower confidence level
+#' will exclude zero.
+#'
 #' @return `x` is returned invisibly.
 #'  Called for its side effect.
 #'
@@ -18,10 +42,23 @@
 #' effects is to be printed. Default is
 #' `TRUE.`
 #'
+#' @param pvalue Logical. If `TRUE`,
+#' asymmetric *p*-values based on
+#' bootstrapping will be printed if
+#' available. Default is `FALSE.`
+#'
+#' @param pvalue_digits Number of decimal
+#' places to display for the *p*-values.
+#' Default is 3.
+#'
 #' @param ...  Other arguments. Not
 #' used.
 #'
 #'
+#' @references
+#' Asparouhov, A., & Muthén, B. (2021). Bootstrap p-value computation.
+#' Retrieved from https://www.statmodel.com/download/FAQ-Bootstrap%20-%20Pvalue.pdf
+#'
 #'
 #' @seealso [cond_indirect_effects()]
 #'
@@ -56,7 +93,10 @@
 #' @export
 
 print.cond_indirect_effects <- function(x, digits = 3,
-                                        annotation = TRUE, ...) {
+                                        annotation = TRUE,
+                                        pvalue = FALSE,
+                                        pvalue_digits = 3,
+                                        ...) {
   full_output <- attr(x, "full_output")
   x_i <- full_output[[1]]
   my_call <- attr(x, "call")
@@ -96,6 +136,20 @@ print.cond_indirect_effects <- function(x, digits = 3,
       i <- which(names(out) == "CI.hi")
       j <- length(out)
       out <- c(out[1:i], list(Sig = Sig), out[(i + 1):j])
+      if ((ci_type == "boot") && pvalue) {
+          boot_p <- sapply(attr(x, "full_output"), function(x) x$boot_p)
+          boot_p <- unname(boot_p)
+          boot_p1 <- sapply(boot_p, function(xx) {
+              if (!is.na(xx)) {
+                  return(formatC(xx, digits = pvalue_digits, format = "f"))
+                } else {
+                  return("NA")
+                }
+            })
+          i <- which(names(out) == "Sig")
+          j <- length(out)
+          out <- c(out[1:i], list(pvalue = boot_p1), out[(i + 1):j])
+        }
     }
   out1 <- data.frame(out, check.names = FALSE)
   wlevels <- attr(x, "wlevels")
@@ -134,6 +188,10 @@ print.cond_indirect_effects <- function(x, digits = 3,
                             level_str,
                             tmp1,
                             tmp2), exdent = 3), sep = "\n")
+          if (pvalue && (ci_type == "boot")) {
+              tmp1 <- " - [pvalue] are asymmetric bootstrap p-values."
+              cat(tmp1, sep = "\n")
+            }
         } else {
           cat("\n")
         }