0.0.1.14: Draft vignette for glm_betaselect()

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: betaselectr
 Title: Selective Standardization in Structural Equation Models
-Version: 0.0.1.12
+Version: 0.0.1.14
 Authors@R:
     c(person(given = "Shu Fai",
              family = "Cheung",

NEWS.md

@@ -1,4 +1,4 @@
-# betaselectr 0.0.1.12
+# betaselectr 0.0.1.14
 
 - Added `lm_betaselect()` and related
   methods and helper functions.
@@ -59,12 +59,22 @@
 
 - Updated `summary.lm_betaselect()`
   to allow including the estimates
-  before standardization. (0.0.1.11
+  before standardization. (0.0.1.11)
 
 - Updated `print.summary.lm_betaselect()`
   to print confidence intervals by
   default, if available. (0.0.1.11)
 
 - Fixed a bug in printing the bootstrap
   *p*-values for `summary.lm_betaselect()`.
-  (0.0.1.12)
+  (0.0.1.13)
+
+- Updated `summary.glm_betaselect()`
+  to allow including the estimates
+  before standardization. (0.0.1.13)
+
+- Updated `print.summary.glm_betaselect()`
+  to print confidence intervals by
+  default, if available. (0.0.1.13)
+
+

R/data_test.R

@@ -69,7 +69,7 @@
 #' Similar to `data_test_mod_cat` but
 #' generated from another population.
 #'
-#' @format A data frame with 500 rows
+#' @format A data frame with 300 rows
 #' and five variables:
 #' \describe{
 #'   \item{dv}{Dependent variable, continuous}
@@ -85,4 +85,29 @@
 #' summary(lm_out)
 #'
 #'
-"data_test_mod_cat2"
+"data_test_mod_cat2"
+
+#' @title Test Dataset with a Binary Outcome Variable
+#'
+#' @description This dataset has one
+#' predictor, one moderator, one
+#' control variable, one binary dependent
+#' variable, and a categorical variable.
+#'
+#' @format A data frame with 300 rows
+#' and five variables:
+#' \describe{
+#'   \item{dv}{Dependent variable, binary: 0, 1}
+#'   \item{iv}{Independent variable, continuous}
+#'   \item{mod}{Moderator, continuous}
+#'   \item{cov1}{Control variable, continuous}
+#'   \item{cat1}{String variable with these values: "gp1", "gp2", and "gp3"}
+#' }
+#'
+#' @examples
+#'
+#' glm_out <- glm(dv ~ iv * mod + cov1 + cat1, data_test_mod_cat_binary, family = binomial())
+#' summary(glm_out)
+#'
+#'
+"data_test_mod_cat_binary"

R/lm_betaselect_methods.R

@@ -1361,6 +1361,21 @@ print_fstatistic <- function(fstatistic,
 #' variables standardized are returned.
 #' Default is `"beta"`.
 #'
+#' @param print_raw Control whether
+#' the estimates before selected
+#' standardization are printed when
+#' `type` is `"beta"` or `"standardized"`.
+#' If `"none"`, the default, then it
+#' will not be printed. If set to `"before_ci"`
+#' and `ci` is `TRUE`, then will be
+#' inserted to the left of the confidence
+#' intervals. If set to "after_ci"` and `ci`
+#' is `TRUE`, then will
+#' be printed to the right of the confidence
+#' intervals. If `ci` is `FALSE`, then will
+#' be printed to the right of the
+#' standardized estimates.
+#'
 #' @param ...  Additional arguments
 #' passed to other methods.
 #'
@@ -1400,17 +1415,19 @@ summary.glm_betaselect <- function(object,
                                    test = c("LRT", "Rao"),
                                    se_method = c("boot", "bootstrap",
                                                  "z", "glm", "default"),
-                                   ci = FALSE,
+                                   ci = TRUE,
                                    level = .95,
                                    boot_type = c("perc", "bc"),
                                    boot_pvalue_type = c("asymmetric", "norm"),
                                    type = c("beta",
                                             "standardized",
                                             "raw",
                                             "unstandardized"),
+                                   print_raw = c("none", "before_ci", "after_ci"),
                                    ...) {
     se_method <- match.arg(se_method)
     type <- match.arg(type)
+    print_raw <- match.arg(print_raw)
     se_method <- switch(se_method,
                         boot = "boot",
                         bootstrap = "boot",
@@ -1463,7 +1480,7 @@ summary.glm_betaselect <- function(object,
         colnames(out$coefficients)[i] <- "z value"
         if (boot_pvalue_type == "asymmetric") {
             boot_est_list <- split(boot_est, rownames(boot_est))
-            boot_est_list <- boot_est_list[names(boot_est_list)]
+            boot_est_list <- boot_est_list[rownames(boot_est)]
             boot_pvalues <- sapply(boot_est_list,
                                    est2p,
                                    h0 = 0)
@@ -1498,6 +1515,21 @@ summary.glm_betaselect <- function(object,
                           out_coef[, -seq_len(i), drop = FALSE])
         out$coefficients <- out_coef
       }
+    if (print_raw != "none") {
+        b_ustd <- stats::coef(object$lm_betaselect$ustd)
+        if (ci) {
+            i <- switch(print_raw,
+                        before_ci = which(colnames(out$coefficients) == "CI.Lower") - 1,
+                        after_ci = which(colnames(out$coefficients) == "CI.Upper"))
+          } else {
+            i <- which(colnames(out$coefficients) == "Estimate")
+          }
+        out_coef <- out$coefficients
+        out_coef <- cbind(out_coef[, seq_len(i), drop = FALSE],
+                          "Raw" = b_ustd,
+                          out_coef[, -seq_len(i), drop = FALSE])
+        out$coefficients <- out_coef
+      }
     out
   }
 
@@ -1613,6 +1645,11 @@ print.summary.glm_betaselect <- function(x,
                 beta = "- Results *after* standardization are reported.",
                 raw = "- Results *before* standardization are reported."),
                 exdent = 2))
+    if ("Raw" %in% colnames(x$coefficients)) {
+        tmp <- c(tmp,
+                strwrap("- 'Raw' shows the estimates *before* standardization.",
+                        exdent = 2))
+      }
     if (x$lm_betaselect$se_method == "boot") {
         tmp <- c(tmp,
                  strwrap("- Nonparametric bootstrapping conducted.",

README.md

@@ -12,7 +12,7 @@ Not ready for use.
 
 # betaselectr: Do selective standardization in structural equation models and regression models
 
-(Version 0.0.1.12, updated on 2024-10-29, [release history](https://sfcheung.github.io/betaselectr/news/index.html))
+(Version 0.0.1.14, updated on 2024-10-30, [release history](https://sfcheung.github.io/betaselectr/news/index.html))
 
 It computes Beta_Select, standardization
 in structural equation models with only

data-raw/data_test_04.R

@@ -0,0 +1,58 @@
+# Adapted from stdmod
+
+set.seed(5415431)
+n <- 300
+x <- rnorm(n)
+w <- .4 * x + sqrt(1 - .4^2) * rnorm(n)
+v1 <- rnorm(n)
+cat1 <- sample(c("gp1", "gp2", "gp3"), n, replace = TRUE, prob = c(.2, .3, .5))
+y <- .2 * x + .3 * w + .35 * x * w + .12 * v1 +
+      sapply(cat1,
+             switch,
+             gp1 = 0,
+             gp2 = .4,
+             gp3 = .6) +
+      rnorm(n, 0, 1.4)
+dat <- data.frame(dv = y,
+                  iv = x,
+                  mod = w,
+                  cov1 = v1,
+                  cat1,
+                  stringsAsFactors = FALSE)
+out <- lm(dv ~ iv * mod + cov1 + cat1,
+          dat)
+summary(out)
+dat$dv <- ifelse(dat$dv > mean(dat$dv), 1, 0)
+apply(dat[, 1:4], 2, sd)
+colMeans(dat[, 1:4])
+b <- 1 / c(5, 2, 4, 2)
+a <- c(20, 15, 50, 20) * -b
+dat0 <- scale(dat[, 1:4],
+              center = a,
+              scale = b)
+dat0 <- round(dat0, 2)
+apply(dat0, 2, sd)
+colMeans(dat0)
+apply(dat0, 2, range)
+dat1 <- data.frame(dat0, cat1 = dat$cat1)
+dat1$dv <- dat$dv
+head(dat1)
+out <- glm(dv ~ iv * mod + cov1 + cat1,
+           dat1,
+           family = binomial())
+summary(out)
+dat1z <- dat1
+dat1z$cat1gp2 <- ifelse(dat1z$cat1 == "gp2", 1, 0)
+dat1z$cat1gp3 <- ifelse(dat1z$cat1 == "gp3", 1, 0)
+dat1z$cat1 <- NULL
+dat1z$iv_x_mod <- dat1z$iv * dat1z$mod
+dat1z <- as.data.frame(scale(dat1z))
+dat1z$dv <- dat$dv
+head(dat1z)
+outz <- glm(dv ~ iv + mod + cov1 + cat1gp2 + cat1gp3 + iv_x_mod,
+            dat1z,
+            family = binomial())
+summary(outz)
+summary(out)
+data_test_mod_cat_binary <- dat1
+usethis::use_data(data_test_mod_cat_binary, overwrite = TRUE)

rebuild_vignettes.R

@@ -5,7 +5,7 @@ base_dir <- getwd()
 setwd("vignettes/")
 knitr::knit("betaselectr_lav.Rmd.original", output = "betaselectr_lav.Rmd")
 knitr::knit("betaselectr_lm.Rmd.original", output = "betaselectr_lm.Rmd")
-
+knitr::knit("betaselectr_glm.Rmd.original", output = "betaselectr_glm.Rmd")
 setwd(base_dir)
 
 # For articles