From 8f11ab2f4a85782778ffe2758c827d7e9d6b1a94 Mon Sep 17 00:00:00 2001 From: Daniel Date: Mon, 8 Jan 2024 11:51:45 +0100 Subject: [PATCH 01/10] draft --- DESCRIPTION | 2 +- NAMESPACE | 3 +++ NEWS.md | 4 +++ R/mcdonalds_omega.r | 55 ++++++++++++++++++++++++++++++++++++++++++ _pkgdown.yaml | 1 + man/mcdonalds_omega.Rd | 39 ++++++++++++++++++++++++++++++ 6 files changed, 103 insertions(+), 1 deletion(-) create mode 100644 R/mcdonalds_omega.r create mode 100644 man/mcdonalds_omega.Rd diff --git a/DESCRIPTION b/DESCRIPTION index a4e31dc4d..276bb1a30 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: performance Title: Assessment of Regression Models Performance -Version: 0.10.8.9 +Version: 0.10.8.10 Authors@R: c(person(given = "Daniel", family = "Lüdecke", diff --git a/NAMESPACE b/NAMESPACE index 970895f14..e275cd740 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -136,6 +136,8 @@ S3method(logLik,iv_robust) S3method(logLik,ivreg) S3method(logLik,plm) S3method(logLik,svycoxph) +S3method(mcdonalds_omega,data.frame) +S3method(mcdonalds_omega,matrix) S3method(model_performance,Arima) S3method(model_performance,BFBayesFactor) S3method(model_performance,DirichletRegModel) @@ -542,6 +544,7 @@ export(item_reliability) export(item_split_half) export(looic) export(mae) +export(mcdonalds_omega) export(model_performance) export(mse) export(multicollinearity) diff --git a/NEWS.md b/NEWS.md index 5475776cc..c7d147d02 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,9 @@ # performance 0.10.9 +## New functions + +* `mcdonalds_omega()` to calculate McDonald's Omega for a scale. + ## Changes * `r2()` for models of class `glmmTMB` without random effects now returns the diff --git a/R/mcdonalds_omega.r b/R/mcdonalds_omega.r new file mode 100644 index 000000000..e1a8f9136 --- /dev/null +++ b/R/mcdonalds_omega.r @@ -0,0 +1,55 @@ +#' @title McDonald's Omega for Items or Scales +#' @name mcdonalds_omega +#' +#' @description Compute various measures of internal consistencies +#' for tests or item-scales of questionnaires. +#' +#' @param x A matrix or a data frame. +#' @param ... Currently not used. +#' +#' @return The McDonald's Omega value for `x`. +#' +#' @details The McDonald's Omega value for `x`. A value closer to 1 +#' indicates greater internal consistency, where usually following +#' rule of thumb is applied to interpret the results: +#' \ifelse{html}{\out{α}}{\eqn{\alpha}{alpha}} < 0.5 is unacceptable, +#' 0.5 < \ifelse{html}{\out{α}}{\eqn{\alpha}{alpha}} < 0.6 is poor, +#' 0.6 < \ifelse{html}{\out{α}}{\eqn{\alpha}{alpha}} < 0.7 is questionable, +#' 0.7 < \ifelse{html}{\out{α}}{\eqn{\alpha}{alpha}} < 0.8 is acceptable, +#' and everything > 0.8 is good or excellent. +#' +#' @references Bland, J. M., and Altman, D. G. Statistics notes: Cronbach's +#' alpha. BMJ 1997;314:572. 10.1136/bmj.314.7080.572 +#' +#' @examples +#' data(mtcars) +#' x <- mtcars[, c("cyl", "gear", "carb", "hp")] +#' mcdonalds_omega(x) +#' @export +mcdonalds_omega <- function(x, ...) { + UseMethod("mcdonalds_omega") +} + + +#' @export +mcdonalds_omega.data.frame <- function(x, verbose = TRUE, ...) { + # remove missings + .data <- stats::na.omit(x) + + # we need at least two columns for Cronach's Alpha + if (is.null(ncol(.data)) || ncol(.data) < 2) { + if (verbose) { + insight::format_warning("Too few columns in `x` to compute McDonald's Omega.") + } + return(NULL) + } + + # Compute Cronbach's Alpha + dim(.data)[2] / (dim(.data)[2] - 1) * (1 - sum(apply(.data, 2, stats::var)) / stats::var(rowSums(.data))) +} + + +#' @export +mcdonalds_omega.matrix <- function(x, verbose = TRUE, ...) { + mcdonalds_omega(as.data.frame(x), verbose = verbose, ...) +} diff --git a/_pkgdown.yaml b/_pkgdown.yaml index 71f444657..09320a14b 100644 --- a/_pkgdown.yaml +++ b/_pkgdown.yaml @@ -24,6 +24,7 @@ reference: contents: - check_itemscale - cronbachs_alpha + - mcdonalds_omega - starts_with("item_") - title: "Comparing and Testing Models" diff --git a/man/mcdonalds_omega.Rd b/man/mcdonalds_omega.Rd new file mode 100644 index 000000000..2ea01c02a --- /dev/null +++ b/man/mcdonalds_omega.Rd @@ -0,0 +1,39 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcdonalds_omega.r +\name{mcdonalds_omega} +\alias{mcdonalds_omega} +\title{McDonald's Omega for Items or Scales} +\usage{ +mcdonalds_omega(x, ...) +} +\arguments{ +\item{x}{A matrix or a data frame.} + +\item{...}{Currently not used.} +} +\value{ +The McDonald's Omega value for \code{x}. +} +\description{ +Compute various measures of internal consistencies +for tests or item-scales of questionnaires. +} +\details{ +The McDonald's Omega value for \code{x}. A value closer to 1 +indicates greater internal consistency, where usually following +rule of thumb is applied to interpret the results: +\ifelse{html}{\out{α}}{\eqn{\alpha}{alpha}} < 0.5 is unacceptable, +0.5 < \ifelse{html}{\out{α}}{\eqn{\alpha}{alpha}} < 0.6 is poor, +0.6 < \ifelse{html}{\out{α}}{\eqn{\alpha}{alpha}} < 0.7 is questionable, +0.7 < \ifelse{html}{\out{α}}{\eqn{\alpha}{alpha}} < 0.8 is acceptable, +and everything > 0.8 is good or excellent. +} +\examples{ +data(mtcars) +x <- mtcars[, c("cyl", "gear", "carb", "hp")] +mcdonalds_omega(x) +} +\references{ +Bland, J. M., and Altman, D. G. Statistics notes: Cronbach's +alpha. BMJ 1997;314:572. 10.1136/bmj.314.7080.572 +} From 2163bf9d4e5f10f4456df74df02a75e98e8b39bd Mon Sep 17 00:00:00 2001 From: Daniel Date: Mon, 8 Jan 2024 11:57:26 +0100 Subject: [PATCH 02/10] draft --- R/mcdonalds_omega.r | 61 +++++++++++++++++++++++++++++++++++---------- 1 file changed, 48 insertions(+), 13 deletions(-) diff --git a/R/mcdonalds_omega.r b/R/mcdonalds_omega.r index e1a8f9136..9090a5795 100644 --- a/R/mcdonalds_omega.r +++ b/R/mcdonalds_omega.r @@ -32,20 +32,55 @@ mcdonalds_omega <- function(x, ...) { #' @export -mcdonalds_omega.data.frame <- function(x, verbose = TRUE, ...) { - # remove missings - .data <- stats::na.omit(x) - - # we need at least two columns for Cronach's Alpha - if (is.null(ncol(.data)) || ncol(.data) < 2) { - if (verbose) { - insight::format_warning("Too few columns in `x` to compute McDonald's Omega.") - } - return(NULL) - } +mcdonalds_omega.data.frame <- function(x, ci = 0.95, verbose = TRUE, ...) { + varnames <- colnames(x) + q <- length(varnames) + N <- nrow(x) + loadingName <- paste0("a", 1:q) + errorName <- paste0("b", 1:q) + + model <- paste0("f1 =~ NA*", varnames[1], " + ") + loadingLine <- paste(paste0(loadingName, "*", varnames), collapse = " + ") + factorLine <- "f1 ~~ 1*f1\n" + errorLine <- paste(paste0(varnames, " ~~ ", errorName, "*", varnames), collapse = "\n") + sumLoading <- paste("loading :=", paste(loadingName, collapse = " + "), "\n") + sumError <- paste("error :=", paste(errorName, collapse = " + "), "\n") + relia <- "relia := (loading^2) / ((loading^2) + error) \n" + model <- paste0( + model, + loadingLine, + "\n", + factorLine, + errorLine, + "\n", + sumLoading, + sumError, + relia + ) + + fit <- lavaan::cfa(model, + data = attitude[, -1], missing = "ml", estimator = "mlr", se = "default" + ) + + lavaan::parameterEstimates(fit) - # Compute Cronbach's Alpha - dim(.data)[2] / (dim(.data)[2] - 1) * (1 - sum(apply(.data, 2, stats::var)) / stats::var(rowSums(.data))) + est <- 0.8274243 + se <- 0.05258224 + + crit <- stats::qnorm((1 + ci) / 2) + + logest <- log(est / (1 - est)) + logse <- se / (est * (1 - est)) + loglower <- logest - crit * logse + logupper <- logest + crit * logse + if (logupper < loglower) { + temp <- loglower + loglower <- logupper + loguppper <- temp + } + lower <- 1 / (1 + exp(-loglower)) + upper <- 1 / (1 + exp(-logupper)) + c(lower, upper) } From 527efcee78b767049a024ce2e25856d16548c4e9 Mon Sep 17 00:00:00 2001 From: Daniel Date: Mon, 8 Jan 2024 12:05:37 +0100 Subject: [PATCH 03/10] fix --- R/mcdonalds_omega.r | 71 +++++++++++++++++++++++---------------------- 1 file changed, 37 insertions(+), 34 deletions(-) diff --git a/R/mcdonalds_omega.r b/R/mcdonalds_omega.r index 9090a5795..6690c1079 100644 --- a/R/mcdonalds_omega.r +++ b/R/mcdonalds_omega.r @@ -34,53 +34,56 @@ mcdonalds_omega <- function(x, ...) { #' @export mcdonalds_omega.data.frame <- function(x, ci = 0.95, verbose = TRUE, ...) { varnames <- colnames(x) - q <- length(varnames) - N <- nrow(x) - loadingName <- paste0("a", 1:q) - errorName <- paste0("b", 1:q) + n_params <- length(varnames) + name_loadings <- paste0("a", 1:n_params) + name_error <- paste0("b", 1:n_params) model <- paste0("f1 =~ NA*", varnames[1], " + ") - loadingLine <- paste(paste0(loadingName, "*", varnames), collapse = " + ") - factorLine <- "f1 ~~ 1*f1\n" - errorLine <- paste(paste0(varnames, " ~~ ", errorName, "*", varnames), collapse = "\n") - sumLoading <- paste("loading :=", paste(loadingName, collapse = " + "), "\n") - sumError <- paste("error :=", paste(errorName, collapse = " + "), "\n") - relia <- "relia := (loading^2) / ((loading^2) + error) \n" + formula_loadings <- paste(paste0(name_loadings, "*", varnames), collapse = " + ") + formula_factors <- "f1 ~~ 1*f1\n" + formula_error <- paste(paste0(varnames, " ~~ ", name_error, "*", varnames), collapse = "\n") + formula_sum_loadings <- paste("loading :=", paste(name_loadings, collapse = " + "), "\n") + formula_sum_error <- paste("error :=", paste(name_error, collapse = " + "), "\n") + formula_reliability <- "relia := (loading^2) / ((loading^2) + error) \n" + model <- paste0( model, - loadingLine, + formula_loadings, "\n", - factorLine, - errorLine, + formula_factors, + formula_error, "\n", - sumLoading, - sumError, - relia + formula_sum_loadings, + formula_sum_error, + formula_reliability ) - fit <- lavaan::cfa(model, - data = attitude[, -1], missing = "ml", estimator = "mlr", se = "default" - ) + insight::check_if_installed("lavaan") - lavaan::parameterEstimates(fit) + fit <- lavaan::cfa(model, data = x, missing = "ml", estimator = "mlr", se = "default") + out <- lavaan::parameterEstimates(fit) - est <- 0.8274243 - se <- 0.05258224 + estimate <- as.vector(out$est[out$label == "relia"]) + se <- as.vector(out$se[out$label == "relia"]) - crit <- stats::qnorm((1 + ci) / 2) + if (!is.null(ci) && !is.na(ci)) { + crit <- stats::qnorm((1 + ci) / 2) - logest <- log(est / (1 - est)) - logse <- se / (est * (1 - est)) - loglower <- logest - crit * logse - logupper <- logest + crit * logse - if (logupper < loglower) { - temp <- loglower - loglower <- logupper - loguppper <- temp + logest <- log(estimate / (1 - estimate)) + logse <- se / (estimate * (1 - estimate)) + loglower <- logest - crit * logse + logupper <- logest + crit * logse + if (logupper < loglower) { + temp <- loglower + loglower <- logupper + loguppper <- temp + } + ci_low <- 1 / (1 + exp(-loglower)) + ci_high <- 1 / (1 + exp(-logupper)) + } else { + ci_low <- NA + ci_high <- NA } - lower <- 1 / (1 + exp(-loglower)) - upper <- 1 / (1 + exp(-logupper)) - c(lower, upper) } From ab95e73bac5250c35638d679ff1c555204ee4d49 Mon Sep 17 00:00:00 2001 From: Daniel Date: Mon, 8 Jan 2024 14:55:23 +0100 Subject: [PATCH 04/10] draft --- NAMESPACE | 2 + R/cronbachs_alpha.R | 5 +- R/mcdonalds_omega.r | 108 ++++++++++++++++++++++++++++++++++++----- man/cronbachs_alpha.Rd | 3 +- man/mcdonalds_omega.Rd | 6 ++- 5 files changed, 106 insertions(+), 18 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index e275cd740..a35ccca91 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -138,6 +138,7 @@ S3method(logLik,plm) S3method(logLik,svycoxph) S3method(mcdonalds_omega,data.frame) S3method(mcdonalds_omega,matrix) +S3method(mcdonalds_omega,parameters_pca) S3method(model_performance,Arima) S3method(model_performance,BFBayesFactor) S3method(model_performance,DirichletRegModel) @@ -293,6 +294,7 @@ S3method(print,icc_decomposed) S3method(print,item_difficulty) S3method(print,item_discrimination) S3method(print,looic) +S3method(print,mcdonalds_omega) S3method(print,performance_accuracy) S3method(print,performance_cv) S3method(print,performance_hosmer) diff --git a/R/cronbachs_alpha.R b/R/cronbachs_alpha.R index 6d4547b40..d3da86b15 100644 --- a/R/cronbachs_alpha.R +++ b/R/cronbachs_alpha.R @@ -4,7 +4,8 @@ #' @description Compute various measures of internal consistencies #' for tests or item-scales of questionnaires. #' -#' @param x A matrix or a data frame. +#' @param x A matrix or a data frame, or an object returned by +#' `[parameters::principal_components()]`. #' @param ... Currently not used. #' #' @return The Cronbach's Alpha value for `x`. @@ -50,14 +51,12 @@ cronbachs_alpha.data.frame <- function(x, verbose = TRUE, ...) { } - #' @export cronbachs_alpha.matrix <- function(x, verbose = TRUE, ...) { cronbachs_alpha(as.data.frame(x), verbose = verbose, ...) } - #' @export cronbachs_alpha.parameters_pca <- function(x, verbose = TRUE, ...) { # fetch data used for the PCA diff --git a/R/mcdonalds_omega.r b/R/mcdonalds_omega.r index 6690c1079..f9b926c1f 100644 --- a/R/mcdonalds_omega.r +++ b/R/mcdonalds_omega.r @@ -4,8 +4,9 @@ #' @description Compute various measures of internal consistencies #' for tests or item-scales of questionnaires. #' -#' @param x A matrix or a data frame. -#' @param ... Currently not used. +#' @param ci Confidence interval for the reliability estimate. If `NULL`, +#' no confidence interval is computed. +#' @inheritParams cronbachs_alpha #' #' @return The McDonald's Omega value for `x`. #' @@ -33,11 +34,24 @@ mcdonalds_omega <- function(x, ...) { #' @export mcdonalds_omega.data.frame <- function(x, ci = 0.95, verbose = TRUE, ...) { - varnames <- colnames(x) - n_params <- length(varnames) - name_loadings <- paste0("a", 1:n_params) - name_error <- paste0("b", 1:n_params) + # remove missings + .data <- stats::na.omit(x) + # we need at least two columns for Cronach's Alpha + if (is.null(ncol(.data)) || ncol(.data) < 2) { + if (verbose) { + insight::format_warning("Too few columns in `x` to compute McDonald's Omega.") + } + return(NULL) + } + + # prepare names and formulas for lavaan + varnames <- colnames(.data) + name_loadings <- paste0("a", seq_len(ncol(.data))) + name_error <- paste0("b", seq_len(ncol(.data))) + + # we need this specific formulation for lavaan to get the omega reliability estimate + # see code in MBESS model <- paste0("f1 =~ NA*", varnames[1], " + ") formula_loadings <- paste(paste0(name_loadings, "*", varnames), collapse = " + ") formula_factors <- "f1 ~~ 1*f1\n" @@ -60,12 +74,15 @@ mcdonalds_omega.data.frame <- function(x, ci = 0.95, verbose = TRUE, ...) { insight::check_if_installed("lavaan") - fit <- lavaan::cfa(model, data = x, missing = "ml", estimator = "mlr", se = "default") + # fit CFA to get reliability estimate + fit <- lavaan::cfa(model, data = .data, missing = "ml", estimator = "mlr", se = "default") out <- lavaan::parameterEstimates(fit) + # extract omega and related standard error estimate <- as.vector(out$est[out$label == "relia"]) se <- as.vector(out$se[out$label == "relia"]) + # if user requested CI, return data frame with omega and CI if (!is.null(ci) && !is.na(ci)) { crit <- stats::qnorm((1 + ci) / 2) @@ -73,21 +90,86 @@ mcdonalds_omega.data.frame <- function(x, ci = 0.95, verbose = TRUE, ...) { logse <- se / (estimate * (1 - estimate)) loglower <- logest - crit * logse logupper <- logest + crit * logse + if (logupper < loglower) { temp <- loglower loglower <- logupper loguppper <- temp } - ci_low <- 1 / (1 + exp(-loglower)) - ci_high <- 1 / (1 + exp(-logupper)) + + omega <- data.frame( + Omega = estimate, + CI_low = 1 / (1 + exp(-loglower)), + CI_high = 1 / (1 + exp(-logupper)), + stringsAsFactors = FALSE + ) + class(omega) <- c("mcdonalds_omega", "data.frame") } else { - ci_low <- NA - ci_high <- NA + omega <- estimate } + + omega } #' @export -mcdonalds_omega.matrix <- function(x, verbose = TRUE, ...) { - mcdonalds_omega(as.data.frame(x), verbose = verbose, ...) +mcdonalds_omega.matrix <- function(x, ci = 0.95, verbose = TRUE, ...) { + mcdonalds_omega(as.data.frame(x), ci = ci, verbose = verbose, ...) +} + + +#' @export +mcdonalds_omega.parameters_pca <- function(x, verbose = TRUE, ...) { + # fetch data used for the PCA + pca_data <- attributes(x)$dataset + + # if NULL, can we get from environment? + if (is.null(pca_data)) { + pca_data <- attr(x, "data") + if (is.null(pca_data)) { + if (verbose) { + insight::format_warning("Could not find data frame that was used for the PCA.") + } + return(NULL) + } + pca_data <- get(pca_data, envir = parent.frame()) + } + + # get assignment of columns to extracted components, based on the max loading + factor_assignment <- attributes(x)$closest_component + + # sort and get unique IDs so we only get data from relevant columns + unique_factors <- sort(unique(factor_assignment)) + + # apply cronbach's alpha for each component, + # only for variables with max loading + omegas <- sapply(unique_factors, function(i) { + mcdonalds_omega( + pca_data[, as.vector(x$Variable[factor_assignment == i]), drop = FALSE], + ci = NULL, + verbose = verbose, + ... + ) + }) + + names(omegas) <- paste0("PC", unique_factors) + unlist(omegas) +} + + +# methods --------------------------------------------------------------------- + +#' @export +print.mcdonalds_omega <- function(x, digits = 3, ...) { + # print regular R2 + out <- sprintf( + "Omega: %.*f %s", + digits, + x$omega, + insight::format_ci(ci_low, ci_high, digits = digits, ci = NULL) + ) + + cat(out) + cat("\n") + invisible(x) } diff --git a/man/cronbachs_alpha.Rd b/man/cronbachs_alpha.Rd index 74517c1fb..c9d6b0c31 100644 --- a/man/cronbachs_alpha.Rd +++ b/man/cronbachs_alpha.Rd @@ -7,7 +7,8 @@ cronbachs_alpha(x, ...) } \arguments{ -\item{x}{A matrix or a data frame.} +\item{x}{A matrix or a data frame, or an object returned by +\verb{[parameters::principal_components()]}.} \item{...}{Currently not used.} } diff --git a/man/mcdonalds_omega.Rd b/man/mcdonalds_omega.Rd index 2ea01c02a..7f1cd2f68 100644 --- a/man/mcdonalds_omega.Rd +++ b/man/mcdonalds_omega.Rd @@ -7,9 +7,13 @@ mcdonalds_omega(x, ...) } \arguments{ -\item{x}{A matrix or a data frame.} +\item{x}{A matrix or a data frame, or an object returned by +\verb{[parameters::principal_components()]}.} \item{...}{Currently not used.} + +\item{ci}{Confidence interval for the reliability estimate. If \code{NULL}, +no confidence interval is computed.} } \value{ The McDonald's Omega value for \code{x}. From 2427ef949cde499963962e11f6663b57aab7d173 Mon Sep 17 00:00:00 2001 From: Daniel Date: Mon, 8 Jan 2024 15:53:10 +0100 Subject: [PATCH 05/10] add test, docs --- R/mcdonalds_omega.r | 58 ++++++++++++++++----- man/mcdonalds_omega.Rd | 25 ++++++--- tests/testthat/test-mcdonalds_omega.R | 74 +++++++++++++++++++++++++++ 3 files changed, 135 insertions(+), 22 deletions(-) create mode 100644 tests/testthat/test-mcdonalds_omega.R diff --git a/R/mcdonalds_omega.r b/R/mcdonalds_omega.r index f9b926c1f..9925a0bdd 100644 --- a/R/mcdonalds_omega.r +++ b/R/mcdonalds_omega.r @@ -13,18 +13,26 @@ #' @details The McDonald's Omega value for `x`. A value closer to 1 #' indicates greater internal consistency, where usually following #' rule of thumb is applied to interpret the results: -#' \ifelse{html}{\out{α}}{\eqn{\alpha}{alpha}} < 0.5 is unacceptable, -#' 0.5 < \ifelse{html}{\out{α}}{\eqn{\alpha}{alpha}} < 0.6 is poor, -#' 0.6 < \ifelse{html}{\out{α}}{\eqn{\alpha}{alpha}} < 0.7 is questionable, -#' 0.7 < \ifelse{html}{\out{α}}{\eqn{\alpha}{alpha}} < 0.8 is acceptable, +#' \ifelse{html}{\out{ω}}{\eqn{\omega}{omega}} < 0.5 is unacceptable, +#' 0.5 < \ifelse{html}{\out{ω}}{\eqn{\omega}{omega}} < 0.6 is poor, +#' 0.6 < \ifelse{html}{\out{ω}}{\eqn{\omega}{omega}} < 0.7 is questionable, +#' 0.7 < \ifelse{html}{\out{ω}}{\eqn{\omega}{omega}} < 0.8 is acceptable, #' and everything > 0.8 is good or excellent. #' -#' @references Bland, J. M., and Altman, D. G. Statistics notes: Cronbach's -#' alpha. BMJ 1997;314:572. 10.1136/bmj.314.7080.572 +#' `mcdonalds_omega()` is a simplified implementation of the `MBESS::ci.reliability()` +#' function. Currently, it only computes the simple McDonald's Omega estimate +#' (not hierarchical, not for categorical data) and should return the same +#' results as the default `MBESS::ci.reliability()` call. +#' +#' @note The code is based on the `MBESS::ci.reliability()` function, which +#' is licensed under the GPL-2|GPL-3 license. Credits go to Sunthud Pornprasertmanit +#' and Ken Kelley. +#' +#' @references McDonald, R.P. (1999). Test theory: A unified treatment. Hillsdale: Erlbaum. #' #' @examples -#' data(mtcars) -#' x <- mtcars[, c("cyl", "gear", "carb", "hp")] +#' data(iris) +#' x <- iris[1:4] #' mcdonalds_omega(x) #' @export mcdonalds_omega <- function(x, ...) { @@ -75,13 +83,35 @@ mcdonalds_omega.data.frame <- function(x, ci = 0.95, verbose = TRUE, ...) { insight::check_if_installed("lavaan") # fit CFA to get reliability estimate - fit <- lavaan::cfa(model, data = .data, missing = "ml", estimator = "mlr", se = "default") - out <- lavaan::parameterEstimates(fit) + fit <- .safe(suppressWarnings(lavaan::cfa(model, data = .data, missing = "ml", estimator = "mlr", se = "default"))) + if (is.null(fit)) { + if (verbose) { + insight::format_warning("Could not compute McDonald's Omega.") + } + return(NULL) + } + out <- suppressWarnings(lavaan::parameterEstimates(fit)) # extract omega and related standard error estimate <- as.vector(out$est[out$label == "relia"]) se <- as.vector(out$se[out$label == "relia"]) + # check if omega is in range + if ((estimate < 0 || estimate > 1)) { + if (!is.null(ci) && !is.na(ci)) { + if (verbose) { + insight::format_warning("McDonald's Omega is not in range [0, 1]. Estimate is not reliable. Furthermore, can't compute confidence intervals.") # nolint + } + ci <- NULL + } else if (verbose) { + if (estimate < 0) { + insight::format_warning("McDonald's Omega is negativ. Estimate is not reliable.") + } else { + insight::format_warning("McDonald's Omega is greater than 1. Estimate is not reliable.") + } + } + } + # if user requested CI, return data frame with omega and CI if (!is.null(ci) && !is.na(ci)) { crit <- stats::qnorm((1 + ci) / 2) @@ -141,7 +171,7 @@ mcdonalds_omega.parameters_pca <- function(x, verbose = TRUE, ...) { # sort and get unique IDs so we only get data from relevant columns unique_factors <- sort(unique(factor_assignment)) - # apply cronbach's alpha for each component, + # apply mcdonalds_omega for each component, # only for variables with max loading omegas <- sapply(unique_factors, function(i) { mcdonalds_omega( @@ -163,10 +193,10 @@ mcdonalds_omega.parameters_pca <- function(x, verbose = TRUE, ...) { print.mcdonalds_omega <- function(x, digits = 3, ...) { # print regular R2 out <- sprintf( - "Omega: %.*f %s", + "McDonald's Omega: %.*f %s", digits, - x$omega, - insight::format_ci(ci_low, ci_high, digits = digits, ci = NULL) + x$Omega, + insight::format_ci(x$CI_low, x$CI_high, digits = digits, ci = NULL) ) cat(out) diff --git a/man/mcdonalds_omega.Rd b/man/mcdonalds_omega.Rd index 7f1cd2f68..ed89425ef 100644 --- a/man/mcdonalds_omega.Rd +++ b/man/mcdonalds_omega.Rd @@ -26,18 +26,27 @@ for tests or item-scales of questionnaires. The McDonald's Omega value for \code{x}. A value closer to 1 indicates greater internal consistency, where usually following rule of thumb is applied to interpret the results: -\ifelse{html}{\out{α}}{\eqn{\alpha}{alpha}} < 0.5 is unacceptable, -0.5 < \ifelse{html}{\out{α}}{\eqn{\alpha}{alpha}} < 0.6 is poor, -0.6 < \ifelse{html}{\out{α}}{\eqn{\alpha}{alpha}} < 0.7 is questionable, -0.7 < \ifelse{html}{\out{α}}{\eqn{\alpha}{alpha}} < 0.8 is acceptable, +\ifelse{html}{\out{ω}}{\eqn{\omega}{omega}} < 0.5 is unacceptable, +0.5 < \ifelse{html}{\out{ω}}{\eqn{\omega}{omega}} < 0.6 is poor, +0.6 < \ifelse{html}{\out{ω}}{\eqn{\omega}{omega}} < 0.7 is questionable, +0.7 < \ifelse{html}{\out{ω}}{\eqn{\omega}{omega}} < 0.8 is acceptable, and everything > 0.8 is good or excellent. + +\code{mcdonalds_omega()} is a simplified implementation of the \code{MBESS::ci.reliability()} +function. Currently, it only computes the simple McDonald's Omega estimate +(not hierarchical, not for categorical data) and should return the same +results as the default \code{MBESS::ci.reliability()} call. +} +\note{ +The code is based on the \code{MBESS::ci.reliability()} function, which +is licensed under the GPL-2|GPL-3 license. Credits go to Sunthud Pornprasertmanit +and Ken Kelley. } \examples{ -data(mtcars) -x <- mtcars[, c("cyl", "gear", "carb", "hp")] +data(iris) +x <- iris[1:4] mcdonalds_omega(x) } \references{ -Bland, J. M., and Altman, D. G. Statistics notes: Cronbach's -alpha. BMJ 1997;314:572. 10.1136/bmj.314.7080.572 +McDonald, R.P. (1999). Test theory: A unified treatment. Hillsdale: Erlbaum. } diff --git a/tests/testthat/test-mcdonalds_omega.R b/tests/testthat/test-mcdonalds_omega.R new file mode 100644 index 000000000..1061a8c64 --- /dev/null +++ b/tests/testthat/test-mcdonalds_omega.R @@ -0,0 +1,74 @@ +test_that("mcdonalds_omega, data frame", { + data(mtcars) + x <- mtcars[, c("cyl", "gear", "carb", "hp")] + expect_warning(mcdonalds_omega(x), regex = "is not in range [0, 1]") + expect_warning(mcdonalds_omega(x, ci = NULL), regex = "is greater than 1") + expect_equal(mcdonalds_omega(x, verbose = FALSE), 1.156718, tolerance = 1e-3) + + data(iris) + x <- iris[1:4] + expect_equal( + mcdonalds_omega(x), + data.frame( + Omega = 0.984746012592052, + CI_low = 0.969115091775479, + CI_high = 0.992527090611996 + ), + tolerance = 1e-4, + ignore_attr = TRUE + ) + expect_equal( + mcdonalds_omega(x, ci = NULL), + 0.984746012592052, + tolerance = 1e-4, + ignore_attr = TRUE + ) + expect_equal( + mcdonalds_omega(x, ci = 0.8), + data.frame( + Omega = 0.984746012592052, + CI_low = 0.97577453015612, + CI_high = 0.990427655221259 + ), + tolerance = 1e-4, + ignore_attr = TRUE + ) +}) + +test_that("mcdonalds_omega", { + expect_warning(expect_null(mcdonalds_omega(mtcars[1])), regex = "Too few columns") +}) + + +test_that("mcdonalds_omega, principal_components", { + skip_if_not_installed("parameters", minimum_version = "0.21.3") + pca <- parameters::principal_components(iris[1:4], n = 2) + expect_equal(mcdonalds_omega(pca, verbose = FALSE), c(PC1 = 0.9855684), tolerance = 1e-3) + expect_warning(mcdonalds_omega(pca), regex = "Too few columns") + + pca <- parameters::principal_components(iris[1:4], n = 1) + expect_equal(mcdonalds_omega(pca, verbose = FALSE), c(PC1 = 0.984746), tolerance = 1e-3) + expect_silent(mcdonalds_omega(pca)) +}) + + +test_that("mcdonalds_omega, principal_components", { + skip_if_not_installed("parameters", minimum_version = "0.20.3") + pca <- parameters::principal_components(mtcars, n = 2) + expect_equal(mcdonalds_omega(pca), c(PC1 = 0.91522, PC2 = 0.0086), tolerance = 1e-3) +}) + + +test_that("mcdonalds_omega, matrix", { + m <- as.matrix(iris[1:4]) + expect_equal( + mcdonalds_omega(x), + data.frame( + Omega = 0.984746012592052, + CI_low = 0.969115091775479, + CI_high = 0.992527090611996 + ), + tolerance = 1e-4, + ignore_attr = TRUE + ) +}) From dda289405b497bad1a7dec854f0ff53cf101a104 Mon Sep 17 00:00:00 2001 From: Daniel Date: Mon, 8 Jan 2024 16:39:53 +0100 Subject: [PATCH 06/10] fix tests --- R/mcdonalds_omega.r | 15 ++++++--------- man/mcdonalds_omega.Rd | 2 ++ tests/testthat/test-mcdonalds_omega.R | 7 +++++-- 3 files changed, 13 insertions(+), 11 deletions(-) diff --git a/R/mcdonalds_omega.r b/R/mcdonalds_omega.r index 9925a0bdd..c5632b407 100644 --- a/R/mcdonalds_omega.r +++ b/R/mcdonalds_omega.r @@ -30,7 +30,7 @@ #' #' @references McDonald, R.P. (1999). Test theory: A unified treatment. Hillsdale: Erlbaum. #' -#' @examples +#' @examplesIf requireNamespace("lavaan", quietly = TRUE) #' data(iris) #' x <- iris[1:4] #' mcdonalds_omega(x) @@ -42,11 +42,8 @@ mcdonalds_omega <- function(x, ...) { #' @export mcdonalds_omega.data.frame <- function(x, ci = 0.95, verbose = TRUE, ...) { - # remove missings - .data <- stats::na.omit(x) - # we need at least two columns for Cronach's Alpha - if (is.null(ncol(.data)) || ncol(.data) < 2) { + if (is.null(ncol(x)) || ncol(x) < 2) { if (verbose) { insight::format_warning("Too few columns in `x` to compute McDonald's Omega.") } @@ -54,9 +51,9 @@ mcdonalds_omega.data.frame <- function(x, ci = 0.95, verbose = TRUE, ...) { } # prepare names and formulas for lavaan - varnames <- colnames(.data) - name_loadings <- paste0("a", seq_len(ncol(.data))) - name_error <- paste0("b", seq_len(ncol(.data))) + varnames <- colnames(x) + name_loadings <- paste0("a", seq_len(ncol(x))) + name_error <- paste0("b", seq_len(ncol(x))) # we need this specific formulation for lavaan to get the omega reliability estimate # see code in MBESS @@ -83,7 +80,7 @@ mcdonalds_omega.data.frame <- function(x, ci = 0.95, verbose = TRUE, ...) { insight::check_if_installed("lavaan") # fit CFA to get reliability estimate - fit <- .safe(suppressWarnings(lavaan::cfa(model, data = .data, missing = "ml", estimator = "mlr", se = "default"))) + fit <- .safe(suppressWarnings(lavaan::cfa(model, data = x, missing = "ml", estimator = "mlr", se = "default"))) if (is.null(fit)) { if (verbose) { insight::format_warning("Could not compute McDonald's Omega.") diff --git a/man/mcdonalds_omega.Rd b/man/mcdonalds_omega.Rd index ed89425ef..e591a139c 100644 --- a/man/mcdonalds_omega.Rd +++ b/man/mcdonalds_omega.Rd @@ -43,9 +43,11 @@ is licensed under the GPL-2|GPL-3 license. Credits go to Sunthud Pornprasertmani and Ken Kelley. } \examples{ +\dontshow{if (requireNamespace("lavaan", quietly = TRUE)) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} data(iris) x <- iris[1:4] mcdonalds_omega(x) +\dontshow{\}) # examplesIf} } \references{ McDonald, R.P. (1999). Test theory: A unified treatment. Hillsdale: Erlbaum. diff --git a/tests/testthat/test-mcdonalds_omega.R b/tests/testthat/test-mcdonalds_omega.R index 1061a8c64..3cb36ff43 100644 --- a/tests/testthat/test-mcdonalds_omega.R +++ b/tests/testthat/test-mcdonalds_omega.R @@ -1,7 +1,7 @@ test_that("mcdonalds_omega, data frame", { data(mtcars) x <- mtcars[, c("cyl", "gear", "carb", "hp")] - expect_warning(mcdonalds_omega(x), regex = "is not in range [0, 1]") + expect_warning(mcdonalds_omega(x), regex = "is not in range") expect_warning(mcdonalds_omega(x, ci = NULL), regex = "is greater than 1") expect_equal(mcdonalds_omega(x, verbose = FALSE), 1.156718, tolerance = 1e-3) @@ -35,10 +35,13 @@ test_that("mcdonalds_omega, data frame", { ) }) + test_that("mcdonalds_omega", { expect_warning(expect_null(mcdonalds_omega(mtcars[1])), regex = "Too few columns") }) +# save time on CRAN +skip_on_cran() test_that("mcdonalds_omega, principal_components", { skip_if_not_installed("parameters", minimum_version = "0.21.3") @@ -62,7 +65,7 @@ test_that("mcdonalds_omega, principal_components", { test_that("mcdonalds_omega, matrix", { m <- as.matrix(iris[1:4]) expect_equal( - mcdonalds_omega(x), + mcdonalds_omega(m), data.frame( Omega = 0.984746012592052, CI_low = 0.969115091775479, From 4eefe737a05d46e74695b6b5e8d0644207126d37 Mon Sep 17 00:00:00 2001 From: Daniel Date: Mon, 8 Jan 2024 17:25:53 +0100 Subject: [PATCH 07/10] add omega option --- NEWS.md | 5 +++ R/check_itemscale.R | 59 +++++++++++++++++++------- R/item_reliability.R | 58 +++++++++++++++++-------- man/check_itemscale.Rd | 17 +++++--- man/item_reliability.Rd | 22 +++++++--- tests/testthat/test-item_reliability.R | 38 +++++++++++------ 6 files changed, 140 insertions(+), 59 deletions(-) diff --git a/NEWS.md b/NEWS.md index c7d147d02..6c29b63f5 100644 --- a/NEWS.md +++ b/NEWS.md @@ -16,6 +16,11 @@ * `check_itemscale()` gets a `print_html()` method. +* `check_itemscale()` and `item_reliability()` gain a `type` argument, to + specify the type of reliability to be computed. The default is `"alpha"`, + which computes Cronbach's alpha, the other option is `"omega"` (McDonald's + Omega). + * Clarification in the documentation of the `estimator` argument for `performance_aic()`. diff --git a/R/check_itemscale.R b/R/check_itemscale.R index fda758d24..c64bd43f0 100644 --- a/R/check_itemscale.R +++ b/R/check_itemscale.R @@ -10,19 +10,19 @@ #' @param factor_index If `x` is a data frame, `factor_index` must be specified. #' It must be a numeric vector of same length as number of columns in `x`, where #' each element is the index of the factor to which the respective column in `x`. +#' @inheritParams item_reliability #' #' @return A list of data frames, with related measures of internal #' consistencies of each subscale. #' #' @details -#' -#' `check_itemscale()` calculates various measures of internal -#' consistencies, such as Cronbach's alpha, item difficulty or discrimination +#' `check_itemscale()` calculates various measures of internal consistencies, +#' such as Cronbach's Alpha (or McDonald's Omega), item difficulty or discrimination #' etc. on subscales which were built from several items. Subscales are #' retrieved from the results of [`parameters::principal_components()`], i.e. -#' based on how many components were extracted from the PCA, -#' `check_itemscale()` retrieves those variables that belong to a component -#' and calculates the above mentioned measures. +#' based on how many components were extracted from the PCA, `check_itemscale()` +#' retrieves those variables that belong to a component and calculates the above +#' mentioned measures. #' #' @note #' - *Item difficulty* should range between 0.2 and 0.8. Ideal value @@ -65,7 +65,7 @@ #' factor_index = parameters::closest_component(pca) #' ) #' @export -check_itemscale <- function(x, factor_index = NULL) { +check_itemscale <- function(x, factor_index = NULL, type = "alpha") { # check for valid input if (!inherits(x, c("parameters_pca", "data.frame"))) { insight::format_error( @@ -89,6 +89,9 @@ check_itemscale <- function(x, factor_index = NULL) { } } + # alpha or omega? + type <- match.arg(type, c("alpha", "omega")) + # assign data and factor index if (inherits(x, "parameters_pca")) { insight::check_if_installed("parameters") @@ -102,12 +105,15 @@ check_itemscale <- function(x, factor_index = NULL) { out <- lapply(sort(unique(subscales)), function(.subscale) { columns <- names(subscales)[subscales == .subscale] items <- dataset[columns] - reliability <- item_reliability(items) + reliability <- item_reliability(items, type = type) .item_discr <- reliability$item_discrimination if (is.null(.item_discr)) .item_discr <- NA - .item_alpha <- reliability$alpha_if_deleted - if (is.null(.item_alpha)) .item_alpha <- NA + .item_rel_estimate <- switch(type, + alpha = reliability$alpha_if_deleted, + omega = reliability$omega_if_deleted + ) + if (is.null(.item_rel_estimate)) .item_rel_estimate <- NA s_out <- data.frame( Item = columns, @@ -117,13 +123,22 @@ check_itemscale <- function(x, factor_index = NULL) { Skewness = vapply(items, function(i) as.numeric(datawizard::skewness(i)), numeric(1)), Difficulty = item_difficulty(items)$Difficulty, Discrimination = .item_discr, - `alpha if deleted` = .item_alpha, + reliability_if_deleted = .item_rel_estimate, stringsAsFactors = FALSE, check.names = FALSE ) + # fix column name + colnames(s_out)[8] <- switch(type, + alpha = "alpha if deleted", + omega = "omega if deleted" + ) + attr(s_out, "item_intercorrelation") <- item_intercor(items) attr(s_out, "cronbachs_alpha") <- cronbachs_alpha(items) + if (type == "omega") { + attr(s_out, "mcdonalds_omega") <- mcdonalds_omega(items) + } s_out }) @@ -144,12 +159,17 @@ print.check_itemscale <- function(x, digits = 2, ...) { lapply(seq_along(x), function(i) { out <- x[[i]] attr(out, "table_caption") <- c(sprintf("\nComponent %i", i), "red") + if (!is.null(attributes(out)$mcdonalds_omega)) { + omega <- sprintf(" McDonald's omega = %.3f", attributes(out)$mcdonalds_omega) + } else { + omega <- "" + } attr(out, "table_footer") <- c(sprintf( - "\nMean inter-item-correlation = %.3f Cronbach's alpha = %.3f", + "\nMean inter-item-correlation = %.3f Cronbach's alpha = %.3f%s", attributes(out)$item_intercorrelation, - attributes(out)$cronbachs_alpha + attributes(out)$cronbachs_alpha, + omega ), "yellow") - out }), digits = digits, @@ -157,6 +177,7 @@ print.check_itemscale <- function(x, digits = 2, ...) { missing = "", zap_small = TRUE )) + cat("\n") } @@ -164,11 +185,17 @@ print.check_itemscale <- function(x, digits = 2, ...) { print_html.check_itemscale <- function(x, digits = 2, ...) { x <- lapply(seq_along(x), function(i) { out <- x[[i]] + if (!is.null(attributes(out)$mcdonalds_omega)) { + omega <- sprintf(", McDonald's omega = %.3f", attributes(out)$mcdonalds_omega) + } else { + omega <- "" + } attr(out, "table_caption") <- sprintf( - "Component %i: Mean inter-item-correlation = %.3f, Cronbach's alpha = %.3f", + "Component %i: Mean inter-item-correlation = %.3f, Cronbach's alpha = %.3f%s", i, attributes(out)$item_intercorrelation, - attributes(out)$cronbachs_alpha + attributes(out)$cronbachs_alpha, + omega ) out }) diff --git a/R/item_reliability.R b/R/item_reliability.R index ce3517ca1..743958b76 100644 --- a/R/item_reliability.R +++ b/R/item_reliability.R @@ -5,21 +5,25 @@ #' for tests or item-scales of questionnaires. #' #' @param x A matrix or a data frame. +#' @param type Type of reliability estimate. Either `"alpha"` (default, see +#' [`cronbachs_alpha()`]) or `"omega"` (see [`mcdonalds_omega()`]). Note that +#' computing McDonald's Omega is more computationally intensive than Cronbach's +#' Alpha. #' @param standardize Logical, if `TRUE`, the data frame's vectors will be #' standardized. Recommended when the variables have different measures / #' scales. #' @param digits Amount of digits for returned values. #' #' @return A data frame with the corrected item-total correlations (*item -#' discrimination*, column `item_discrimination`) and Cronbach's Alpha -#' (if item deleted, column `alpha_if_deleted`) for each item -#' of the scale, or `NULL` if data frame had too less columns. +#' discrimination*, column `item_discrimination`) and Cronbach's Alpha +#' (if item deleted, column `alpha_if_deleted`) resp. McDonald's Omega for each +#' item of the scale, or `NULL` if data frame had too few columns. #' #' @details -#' #' This function calculates the item discriminations (corrected item-total #' correlations for each item of `x` with the remaining items) and the -#' Cronbach's alpha for each item, if it was deleted from the scale. The +#' Cronbach's alpha (when `type = "alpha"`) resp. McDonald's Omega (when +#' `type = "omega"`) for each item, if it was deleted from the scale. The #' absolute value of the item discrimination indices should be above 0.2. An #' index between 0.2 and 0.4 is considered as "fair", while an index above 0.4 #' (or below -0.4) is "good". The range of satisfactory values is from 0.4 to @@ -28,18 +32,23 @@ #' determine why a negative value was obtained (e.g. reversed answer categories #' regarding positive and negative poles). #' -#' @examples +#' @examplesIf requireNamespace("lavaan", quietly = TRUE) #' data(mtcars) -#' x <- mtcars[, c("cyl", "gear", "carb", "hp")] -#' item_reliability(x) +#' item_reliability(mtcars[, c("cyl", "gear", "carb", "hp")]) +#' +#' data(iris) +#' item_reliability(iris[1:4], type = "omega") #' @export -item_reliability <- function(x, standardize = FALSE, digits = 3) { +item_reliability <- function(x, type = "alpha", standardize = FALSE, digits = 3) { # check param if (!is.matrix(x) && !is.data.frame(x)) { insight::format_alert("`x` needs to be a data frame or matrix.") return(NULL) } + # alpha or omega? + type <- match.arg(type, c("alpha", "omega")) + # remove missings, so correlation works x <- stats::na.omit(x) @@ -58,20 +67,33 @@ item_reliability <- function(x, standardize = FALSE, digits = 3) { # when items have different measures / scales if (standardize) x <- .std(x) - # calculate cronbach-if-deleted - cronbachDeleted <- vapply(seq_len(ncol(x)), function(i) cronbachs_alpha(x[, -i]), numeric(1L)) - # calculate corrected total-item correlation totalCorr <- vapply(seq_len(ncol(x)), function(i) { stats::cor(x[, i], rowSums(x[, -i]), use = "pairwise.complete.obs") }, numeric(1L)) - ret.df <- data.frame( - term = df.names, - alpha_if_deleted = round(cronbachDeleted, digits), - item_discrimination = round(totalCorr, digits), - stringsAsFactors = FALSE - ) + # reliability estimate alpha or omega? + if (type == "alpha") { + # calculate cronbach-if-deleted + cronbachDeleted <- vapply(seq_len(ncol(x)), function(i) cronbachs_alpha(x[, -i]), numeric(1L)) + + ret.df <- data.frame( + term = df.names, + alpha_if_deleted = round(cronbachDeleted, digits), + item_discrimination = round(totalCorr, digits), + stringsAsFactors = FALSE + ) + } else { + # calculate omega-if-deleted + omegaDeleted <- vapply(seq_len(ncol(x)), function(i) mcdonalds_omega(x[, -i], ci = NULL), numeric(1L)) + + ret.df <- data.frame( + term = df.names, + omega_if_deleted = round(omegaDeleted, digits), + item_discrimination = round(totalCorr, digits), + stringsAsFactors = FALSE + ) + } } else { insight::format_warning("Data frame needs at least three columns for reliability-test.") } diff --git a/man/check_itemscale.Rd b/man/check_itemscale.Rd index a5ada3875..8b04c6798 100644 --- a/man/check_itemscale.Rd +++ b/man/check_itemscale.Rd @@ -4,7 +4,7 @@ \alias{check_itemscale} \title{Describe Properties of Item Scales} \usage{ -check_itemscale(x, factor_index = NULL) +check_itemscale(x, factor_index = NULL, type = "alpha") } \arguments{ \item{x}{An object of class \code{parameters_pca}, as returned by @@ -13,6 +13,11 @@ check_itemscale(x, factor_index = NULL) \item{factor_index}{If \code{x} is a data frame, \code{factor_index} must be specified. It must be a numeric vector of same length as number of columns in \code{x}, where each element is the index of the factor to which the respective column in \code{x}.} + +\item{type}{Type of reliability estimate. Either \code{"alpha"} (default, see +\code{\link[=cronbachs_alpha]{cronbachs_alpha()}}) or \code{"omega"} (see \code{\link[=mcdonalds_omega]{mcdonalds_omega()}}). Note that +computing McDonald's Omega is more computationally intensive than Cronbach's +Alpha.} } \value{ A list of data frames, with related measures of internal @@ -24,13 +29,13 @@ applied to (sub)scales, which items were extracted using \code{parameters::principal_components()}. } \details{ -\code{check_itemscale()} calculates various measures of internal -consistencies, such as Cronbach's alpha, item difficulty or discrimination +\code{check_itemscale()} calculates various measures of internal consistencies, +such as Cronbach's Alpha (or McDonald's Omega), item difficulty or discrimination etc. on subscales which were built from several items. Subscales are retrieved from the results of \code{\link[parameters:principal_components]{parameters::principal_components()}}, i.e. -based on how many components were extracted from the PCA, -\code{check_itemscale()} retrieves those variables that belong to a component -and calculates the above mentioned measures. +based on how many components were extracted from the PCA, \code{check_itemscale()} +retrieves those variables that belong to a component and calculates the above +mentioned measures. } \note{ \itemize{ diff --git a/man/item_reliability.Rd b/man/item_reliability.Rd index cc2bcf400..7be001760 100644 --- a/man/item_reliability.Rd +++ b/man/item_reliability.Rd @@ -4,11 +4,16 @@ \alias{item_reliability} \title{Reliability Test for Items or Scales} \usage{ -item_reliability(x, standardize = FALSE, digits = 3) +item_reliability(x, type = "alpha", standardize = FALSE, digits = 3) } \arguments{ \item{x}{A matrix or a data frame.} +\item{type}{Type of reliability estimate. Either \code{"alpha"} (default, see +\code{\link[=cronbachs_alpha]{cronbachs_alpha()}}) or \code{"omega"} (see \code{\link[=mcdonalds_omega]{mcdonalds_omega()}}). Note that +computing McDonald's Omega is more computationally intensive than Cronbach's +Alpha.} + \item{standardize}{Logical, if \code{TRUE}, the data frame's vectors will be standardized. Recommended when the variables have different measures / scales.} @@ -18,8 +23,8 @@ scales.} \value{ A data frame with the corrected item-total correlations (\emph{item discrimination}, column \code{item_discrimination}) and Cronbach's Alpha -(if item deleted, column \code{alpha_if_deleted}) for each item -of the scale, or \code{NULL} if data frame had too less columns. +(if item deleted, column \code{alpha_if_deleted}) resp. McDonald's Omega for each +item of the scale, or \code{NULL} if data frame had too few columns. } \description{ Compute various measures of internal consistencies @@ -28,7 +33,8 @@ for tests or item-scales of questionnaires. \details{ This function calculates the item discriminations (corrected item-total correlations for each item of \code{x} with the remaining items) and the -Cronbach's alpha for each item, if it was deleted from the scale. The +Cronbach's alpha (when \code{type = "alpha"}) resp. McDonald's Omega (when +\code{type = "omega"}) for each item, if it was deleted from the scale. The absolute value of the item discrimination indices should be above 0.2. An index between 0.2 and 0.4 is considered as "fair", while an index above 0.4 (or below -0.4) is "good". The range of satisfactory values is from 0.4 to @@ -38,7 +44,11 @@ determine why a negative value was obtained (e.g. reversed answer categories regarding positive and negative poles). } \examples{ +\dontshow{if (requireNamespace("lavaan", quietly = TRUE)) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} data(mtcars) -x <- mtcars[, c("cyl", "gear", "carb", "hp")] -item_reliability(x) +item_reliability(mtcars[, c("cyl", "gear", "carb", "hp")]) + +data(iris) +item_reliability(iris[1:4], type = "omega") +\dontshow{\}) # examplesIf} } diff --git a/tests/testthat/test-item_reliability.R b/tests/testthat/test-item_reliability.R index 5b4e5bc1e..8f45c6327 100644 --- a/tests/testthat/test-item_reliability.R +++ b/tests/testthat/test-item_reliability.R @@ -1,20 +1,32 @@ test_that("item_reliability", { data(iris) - x <- iris[, 1:4] expect_equal( - item_reliability(x), - structure( - list( - term = c( - "Sepal.Length", "Sepal.Width", "Petal.Length", - "Petal.Width" - ), - alpha_if_deleted = c(0.454, 0.877, 0.489, 0.467), - item_discrimination = c(0.894, -0.349, 0.863, 0.921) + item_reliability(iris[1:4]), + data.frame( + term = c( + "Sepal.Length", "Sepal.Width", "Petal.Length", + "Petal.Width" ), - class = "data.frame", - row.names = c(NA, -4L) + alpha_if_deleted = c(0.454, 0.877, 0.489, 0.467), + item_discrimination = c(0.894, -0.349, 0.863, 0.921), + stringsAsFactors = FALSE ), - tolerance = 1e-3 + tolerance = 1e-3, + ignore_attr = TRUE + ) +}) + +test_that("item_reliability, omega", { + data(iris) + expect_equal( + item_reliability(iris[1:3], type = "omega"), + data.frame( + term = c("Sepal.Length", "Sepal.Width", "Petal.Length"), + omega_if_deleted = c(0.029, 0.82, 0.367), + item_discrimination = c(0.914, -0.339, 0.602), + stringsAsFactors = FALSE + ), + tolerance = 1e-3, + ignore_attr = TRUE ) }) From 8e3bdb2e87c4698e7a40fc88a7d9826e2a663756 Mon Sep 17 00:00:00 2001 From: Daniel Date: Mon, 8 Jan 2024 17:28:38 +0100 Subject: [PATCH 08/10] fix --- R/check_itemscale.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/check_itemscale.R b/R/check_itemscale.R index c64bd43f0..5f0ea9560 100644 --- a/R/check_itemscale.R +++ b/R/check_itemscale.R @@ -137,7 +137,7 @@ check_itemscale <- function(x, factor_index = NULL, type = "alpha") { attr(s_out, "item_intercorrelation") <- item_intercor(items) attr(s_out, "cronbachs_alpha") <- cronbachs_alpha(items) if (type == "omega") { - attr(s_out, "mcdonalds_omega") <- mcdonalds_omega(items) + attr(s_out, "mcdonalds_omega") <- mcdonalds_omega(items, ci = NULL) } s_out From b42408999c0db37e31716f9e9d98326bae27ffeb Mon Sep 17 00:00:00 2001 From: Daniel Date: Mon, 8 Jan 2024 21:41:00 +0100 Subject: [PATCH 09/10] fix RD --- R/mcdonalds_omega.r | 1 + man/mcdonalds_omega.Rd | 3 +++ 2 files changed, 4 insertions(+) diff --git a/R/mcdonalds_omega.r b/R/mcdonalds_omega.r index c5632b407..628bf150b 100644 --- a/R/mcdonalds_omega.r +++ b/R/mcdonalds_omega.r @@ -40,6 +40,7 @@ mcdonalds_omega <- function(x, ...) { } +#' @rdname mcdonalds_omega #' @export mcdonalds_omega.data.frame <- function(x, ci = 0.95, verbose = TRUE, ...) { # we need at least two columns for Cronach's Alpha diff --git a/man/mcdonalds_omega.Rd b/man/mcdonalds_omega.Rd index e591a139c..4d68199f3 100644 --- a/man/mcdonalds_omega.Rd +++ b/man/mcdonalds_omega.Rd @@ -2,9 +2,12 @@ % Please edit documentation in R/mcdonalds_omega.r \name{mcdonalds_omega} \alias{mcdonalds_omega} +\alias{mcdonalds_omega.data.frame} \title{McDonald's Omega for Items or Scales} \usage{ mcdonalds_omega(x, ...) + +\method{mcdonalds_omega}{data.frame}(x, ci = 0.95, verbose = TRUE, ...) } \arguments{ \item{x}{A matrix or a data frame, or an object returned by From f057e476a9ee75b7d200ddb1752b5f22a7bd211a Mon Sep 17 00:00:00 2001 From: Daniel Date: Mon, 8 Jan 2024 21:42:30 +0100 Subject: [PATCH 10/10] wordlist --- R/mcdonalds_omega.r | 2 +- inst/WORDLIST | 3 +++ 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/R/mcdonalds_omega.r b/R/mcdonalds_omega.r index 628bf150b..2e12de4c7 100644 --- a/R/mcdonalds_omega.r +++ b/R/mcdonalds_omega.r @@ -32,7 +32,7 @@ #' #' @examplesIf requireNamespace("lavaan", quietly = TRUE) #' data(iris) -#' x <- iris[1:4] +#' x <- iris[1:3] #' mcdonalds_omega(x) #' @export mcdonalds_omega <- function(x, ...) { diff --git a/inst/WORDLIST b/inst/WORDLIST index fbef7c991..88ad8d39d 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -81,6 +81,7 @@ HJ Hastie Herron Hesketh +Hillsdale Hoaglin Hoboken Holger @@ -156,6 +157,7 @@ Olkin PNFI Pek Petrov +Pornprasertmanit Postestimation Pre Psychol @@ -189,6 +191,7 @@ Sphericity Springer Stata Subscales +Sunthud TLI Technometrics Testtheorie