Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

0.0.1.17 #25

Merged
merged 4 commits into from
Oct 30, 2024
Merged

0.0.1.17 #25

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
35bb70f
Add apply_to_cells
sfcheung Oct 30, 2024
9e0d333
0.0.1.16: Add transform_b, along with other fixes
sfcheung Oct 30, 2024
b885009
Update the two vignettes (lm and glm)
sfcheung Oct 30, 2024
a3a0ad2
Merge pull request #24 from sfcheung/expB
sfcheung Oct 30, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion DESCRIPTION
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
Package: betaselectr
Title: Selective Standardization in Structural Equation Models
Version: 0.0.1.15
Version: 0.0.1.17
Authors@R:
c(person(given = "Shu Fai",
family = "Cheung",
Expand Down
17 changes: 16 additions & 1 deletion NEWS.md
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
# betaselectr 0.0.1.15
# betaselectr 0.0.1.17

- Added `lm_betaselect()` and related
methods and helper functions.
Expand Down Expand Up @@ -82,3 +82,18 @@
as a convenient way to skip standardizing
the response variables. (0.0.1.15)

- Added `transform_b` to `summary.glm_betaselect()`
for transforming
the coefficients and their confidence
limits. Intended to compute exponentiated
coefficients but can be used for other
purposes. (0.0.1.16)

- Removed some warnings in the methods
for `lm_betaselect()` and `glm_betaselect()`.
Not necessary because the notes in
the print method can already alert the
users. (0.0.1.16)

- Updated the vignettes and the `pkgdown`
site. (0.0.1.17)
21 changes: 21 additions & 0 deletions R/lm_betaselect_helpers.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -119,3 +119,24 @@ find_categorical_lm <- function(object) {
tmp <- tmp[tmp != "numeric"]
names(tmp)
}

#' @noRd
# For functions not vectorized
apply_to_cells <- function(x, cell_fun) {
if (is.null(dim(x))) {
for (i in seq_along(x)) {
x[i] <- do.call(cell_fun, list(x[i]))
}
return(x)
} else if (length(dim(x)) == 2) {
p <- nrow(x)
q <- ncol(x)
for (i in seq_len(p)) {
for (j in seq_len(q)) {
x[i, j] <- do.call(cell_fun, list(x[i, j]))
}
}
return(x)
}
stop("x must be either one-dimensional or two-dimensional.")
}
136 changes: 115 additions & 21 deletions R/lm_betaselect_methods.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -212,8 +212,9 @@ vcov.lm_betaselect <- function(object,
raw = "raw",
unstandardized = "raw")
if (identical(method, "boot") && is.null(object$lm_betaselect$boot_out)) {
warning("Bootstrap estimates not available; ",
"'method' changed to 'ls'.")
# This warning is not necessary
# warning("Bootstrap estimates not available; ",
# "'method' changed to 'ls'.")
method <- "ls"
}
if (type == "beta") {
Expand All @@ -227,7 +228,7 @@ vcov.lm_betaselect <- function(object,
} else {
if (warn) {
warning("With standardization, the variance-covariance matrix ",
"from 'lm()' or 'glm()' should not be used.")
"from 'lm()' or 'glm()' should be used with caution.")
}
NextMethod()
}
Expand Down Expand Up @@ -406,8 +407,9 @@ confint.lm_betaselect <- function(object,
raw = "raw",
unstandardized = "raw")
if (identical(method, "boot") && is.null(object$lm_betaselect$boot_out)) {
warning("Bootstrap estimates not available; ",
"'method' changed to 'ls'.")
# # This warning is not necessary.
# warning("Bootstrap estimates not available; ",
# "'method' changed to 'ls'.")
method <- "ls"
}
if (type == "beta") {
Expand All @@ -434,7 +436,7 @@ confint.lm_betaselect <- function(object,
} else {
if (warn) {
warning("With standardization, the variance-covariance matrix ",
"using OLS or WLS should not be used.")
"using OLS or WLS should be used with caution.")
}
class(object) <- "lm"
out <- stats::confint(object,
Expand Down Expand Up @@ -485,6 +487,17 @@ confint.lm_betaselect <- function(object,
#' ignored if `method` is `"boot"` or
#' `"bootstrap"`.
#'
#' @param transform_b The function
#' to be used to transform the
#' confidence limits. For example,
#' if set to `exp`, the confidence
#' limits will be exponentiated. Users
#' need to decide whether the transformed
#' limits are meaningful. Default is
#' `NULL`.
#'
#'
#'
#' @examples
#'
#' data_test_mod_cat$p <- scale(data_test_mod_cat$dv)[, 1]
Expand Down Expand Up @@ -519,6 +532,7 @@ confint.glm_betaselect <- function(object,
"unstandardized"),
warn = TRUE,
boot_type = c("perc", "bc"),
transform_b = NULL,
...) {
test <- match.arg(test)
method <- match.arg(method)
Expand All @@ -538,12 +552,13 @@ confint.glm_betaselect <- function(object,
raw = "raw",
unstandardized = "raw")
if (identical(method, "boot") && is.null(object$lm_betaselect$boot_out)) {
warning("Bootstrap estimates not available; ",
"'method' changed to 'ls' or 'default'.")
# # This warning is not necessary.
# warning("Bootstrap estimates not available; ",
# "'method' changed to 'ls' or 'default'.")
method <- "ls"
}
if (type == "beta") {
if (method == "boot") {1
if (method == "boot") {
boot_out <- object$lm_betaselect$boot_out
boot_idx <- attr(boot_out, "boot_idx")
boot_est <- lapply(parm, function(y) {
Expand All @@ -554,6 +569,14 @@ confint.glm_betaselect <- function(object,
})
est <- stats::coef(object,
type = type)[parm]
if (is.function(transform_b)) {
est <- apply_to_cells(est, cell_fun = transform_b)
boot_est <- lapply(boot_est,
apply_to_cells,
cell_fun = transform_b)
# est <- do.call(transform_b, list(est))
# boot_est <- do.call(transform_b, list(boot_est))
}
out <- mapply(boot_ci_internal,
t0 = est,
t = boot_est,
Expand All @@ -565,8 +588,8 @@ confint.glm_betaselect <- function(object,
return(out)
} else {
if (warn) {
warning("With standardization, the confidence interval",
"from 'lm()' or 'glm()' should not be used.")
warning("With standardization, the non-bootstrap confidence interval ",
"from 'lm()' or 'glm()' should be used with caution.")
}
class(object) <- "glm"
out <- stats::confint(object,
Expand All @@ -575,6 +598,10 @@ confint.glm_betaselect <- function(object,
trace = trace,
test = test,
...)
if (is.function(transform_b)) {
out <- apply_to_cells(out, cell_fun = transform_b)
# out <- do.call(transform_b, list(out))
}
return(out)
}
} else {
Expand All @@ -589,6 +616,12 @@ confint.glm_betaselect <- function(object,
})
est <- stats::coef(object,
type = type)[parm]
if (is.function(transform_b)) {
est <- apply_to_cells(est, cell_fun = transform_b)
boot_est <- lapply(boot_est,
apply_to_cells,
cell_fun = transform_b)
}
out <- mapply(boot_ci_internal,
t0 = est,
t = boot_est,
Expand All @@ -604,6 +637,10 @@ confint.glm_betaselect <- function(object,
level = level,
trace = trace,
test = test)
if (is.function(transform_b)) {
out <- apply_to_cells(out, cell_fun = transform_b)
# out <- do.call(transform_b, list(out))
}
return(out)
}
}
Expand Down Expand Up @@ -791,9 +828,7 @@ anova.glm_betaselect <- function(object,
#' is set to `"t"`, `"lm"`, or `"ls"`,
#' then the usual `lm`
#' standard errors are
#' returned, with a warning raised
#' unless `type` is `"raw"` or
#' `"unstandardized".`
#' returned.
#' Default is `"boot"`.
#'
#' @param ci Logical. Whether
Expand Down Expand Up @@ -912,8 +947,9 @@ summary.lm_betaselect <- function(object,
boot_type <- match.arg(boot_type)
boot_pvalue_type <- match.arg(boot_pvalue_type)
if (identical(se_method, "boot") && is.null(object$lm_betaselect$boot_out)) {
warning("Bootstrap estimates not available; ",
"'se_method' changed to 'ls'.")
# # This warning is not necessary.
# warning("Bootstrap estimates not available; ",
# "'se_method' changed to 'ls'.")
se_method <- "ls"
}
if (type == "beta") {
Expand Down Expand Up @@ -1319,9 +1355,7 @@ print_fstatistic <- function(fstatistic,
#' is set to `"z"`, `"glm"`, or `"default"`,
#' then the usual `glm`
#' standard errors are
#' returned, with a warning raised
#' unless `type` is `"raw"` or
#' `"unstandardized".`
#' returned.
#' Default is `"boot"`.
#'
#' @param ci Logical. Whether
Expand Down Expand Up @@ -1376,6 +1410,21 @@ print_fstatistic <- function(fstatistic,
#' be printed to the right of the
#' standardized estimates.
#'
#' @param transform_b The function
#' to be used to transform the
#' confidence limits. For example,
#' if set to `exp`, the confidence
#' limits will be exponentiated. Users
#' need to decide whether the transformed
#' limits are meaningful. Default is
#' `NULL`.
#'
#' @param transform_b_name If
#' `transform_b` is a function, then
#' this is the name of the transformed
#' coefficients. Default is
#' `"Estimate(Transformed)"`
#'
#' @param ... Additional arguments
#' passed to other methods.
#'
Expand Down Expand Up @@ -1424,7 +1473,18 @@ summary.glm_betaselect <- function(object,
"raw",
"unstandardized"),
print_raw = c("none", "before_ci", "after_ci"),
transform_b = NULL,
transform_b_name = NULL,
...) {
# If logistic regression is likely conducted:
if (isTRUE(object$family$family == "binomial")) {
if (isTRUE(object$family$link == "logit")) {
if (is.null(transform_b)) {
transform_b <- exp
transform_b_name <- "Exp(B)"
}
}
}
se_method <- match.arg(se_method)
type <- match.arg(type)
print_raw <- match.arg(print_raw)
Expand All @@ -1442,8 +1502,9 @@ summary.glm_betaselect <- function(object,
boot_type <- match.arg(boot_type)
boot_pvalue_type <- match.arg(boot_pvalue_type)
if (identical(se_method, "boot") && is.null(object$lm_betaselect$boot_out)) {
warning("Bootstrap estimates not available; ",
"'se_method' changed to 'default'.")
# # This warning is not necessary
# warning("Bootstrap estimates not available; ",
# "'se_method' changed to 'default'.")
se_method <- "default"
}
if (type == "beta") {
Expand Down Expand Up @@ -1530,6 +1591,32 @@ summary.glm_betaselect <- function(object,
out_coef[, -seq_len(i), drop = FALSE])
out$coefficients <- out_coef
}
if (!is.null(transform_b)) {
i <- intersect(c("Estimate", "CI.Lower", "CI.Upper"),
colnames(out$coefficients))
tmp1 <- as.matrix(out$coefficients[, i])
tmp2 <- apply_to_cells(tmp1,
cell_fun = transform_b)
if (is.null(transform_b_name)) {
transform_b_name <- "Estimate(Transformed)"
}
colnames(tmp2)[match("Estimate", colnames(tmp2))] <- transform_b_name
if (ci) {
out_ci_t <- suppressMessages(confint.glm_betaselect(object,
level = level,
trace = trace,
test = test,
method = se_method,
type = type,
warn = FALSE,
boot_type = boot_type,
transform_b = transform_b))
tmp2[, c("CI.Lower", "CI.Upper")] <- out_ci_t
}
out$coefficients_transformed <- tmp2
} else {
out$coefficients_transformed <- NULL
}
out
}

Expand Down Expand Up @@ -1636,6 +1723,13 @@ print.summary.glm_betaselect <- function(x,
eps.Pvalue = pvalue_less_than,
dig.tst = z_digits)

if (!is.null(x$coefficients_transformed)) {
coef_transformed <- x$coefficients_transformed
coef_transformed <- round(coef_transformed, est_digits)
cat("Transformed Parameter Estimates:\n")
print(coef_transformed)
}

cat("\n")

tmp <- character(0)
Expand Down
2 changes: 1 addition & 1 deletion README.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -12,7 +12,7 @@ Not ready for use.

# betaselectr: Do selective standardization in structural equation models and regression models

(Version 0.0.1.15, updated on 2024-10-30, [release history](https://sfcheung.github.io/betaselectr/news/index.html))
(Version 0.0.1.17, 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
Expand Down
15 changes: 15 additions & 0 deletions _pkgdown.yml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -28,6 +28,21 @@ navbar:
structure:
left: [intro, articles, reference, tutorials, news]
right: [search, github]
components:
articles:
text: Articles
menu:
- text: "<Structural Equation Models>"
- text: Beta-Select Demonstration - SEM by 'lavaan'
href: articles/betaselectr_lav.html
- text: -------
- text: "<Multiple Regression>"
- text: Beta-Select Demonstration - Regression by 'lm()'
href: articles/betaselectr_lm.html
- text: -------
- text: "<Generalized Linear Models>"
- text: Beta-Select Demonstration - Logistic Regression by 'glm()'
href: articles/betaselectr_glm.html

reference:
- title: Main Functions
Expand Down
10 changes: 10 additions & 0 deletions man/confint.lm_betaselect.Rd
View file
Open in desktop

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

Loading
Loading