From 1020d37c07090d25b47ac91ee5049699323fd638 Mon Sep 17 00:00:00 2001 From: Joseph Luchman Date: Sun, 18 Aug 2024 10:41:10 -0500 Subject: [PATCH 1/6] Adding `r2_mlm`, update to `r2()`, supporting methods, tests, and documentation. --- DESCRIPTION | 6 ++- NAMESPACE | 2 + R/print-methods.R | 32 ++++++++----- R/r2.R | 39 +++++++++------- R/r2_mlm.R | 87 ++++++++++++++++++++++++++++++++++++ man/performance-package.Rd | 1 + man/r2.Rd | 8 +++- man/r2_mlm.Rd | 74 ++++++++++++++++++++++++++++++ tests/testthat/test-r2_mlm.R | 9 ++++ 9 files changed, 229 insertions(+), 29 deletions(-) create mode 100644 R/r2_mlm.R create mode 100644 man/r2_mlm.Rd create mode 100644 tests/testthat/test-r2_mlm.R diff --git a/DESCRIPTION b/DESCRIPTION index aa64c172c..a121dede4 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -52,7 +52,11 @@ Authors@R: "Bacher", , "etienne.bacher@protonmail.com", role = "ctb", - comment = c(ORCID = "0000-0002-9271-5075"))) + comment = c(ORCID = "0000-0002-9271-5075")), + person(given = "Joseph", + family = "Luchman", + role = "ctb", + comment = c(ORCID = "0000-0002-8886-9717"))) Maintainer: Daniel Lüdecke Description: Utilities for computing measures to assess model quality, which are not directly provided by R's 'base' or 'stats' packages. diff --git a/NAMESPACE b/NAMESPACE index 0827931d6..e3b7637d7 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -484,6 +484,7 @@ S3method(r2_mcfadden,serp) S3method(r2_mcfadden,truncreg) S3method(r2_mcfadden,vglm) S3method(r2_mckelvey,default) +S3method(r2_mlm,mlm) S3method(r2_nagelkerke,BBreg) S3method(r2_nagelkerke,DirichletRegModel) S3method(r2_nagelkerke,bife) @@ -606,6 +607,7 @@ export(r2_loo) export(r2_loo_posterior) export(r2_mcfadden) export(r2_mckelvey) +export(r2_mlm) export(r2_nagelkerke) export(r2_nakagawa) export(r2_posterior) diff --git a/R/print-methods.R b/R/print-methods.R index e3cdbbfed..e87b0e7ae 100644 --- a/R/print-methods.R +++ b/R/print-methods.R @@ -68,22 +68,32 @@ print.r2_pseudo <- function(x, digits = 3, ...) { #' @export print.r2_mlm <- function(x, digits = 3, ...) { model_type <- attr(x, "model_type") - if (!is.null(model_type)) { + is_multivar_r2 <- all(names(x) == c("Symmetric Rxy", "Asymmetric Pxy")) + if (!is.null(model_type) && !is_multivar_r2) { insight::print_color(sprintf("# R2 for %s Regression\n\n", model_type), "blue") + } else if (!is.null(model_type) && is_multivar_r2) { + insight::print_color(sprintf("# Multivariate R2 for %s Regression\n", model_type), "blue") } else { insight::print_color("# R2\n\n", "blue") } - for (i in names(x)) { - insight::print_color(sprintf("## %s\n", i), "cyan") - out <- paste0( - c( - sprintf(" R2: %.*f", digits, x[[i]]$R2), - sprintf(" adj. R2: %.*f", digits, x[[i]]$R2_adjusted) - ), - collapse = "\n" - ) - cat(out) + if (!is_multivar_r2) { + for (i in names(x)) { + insight::print_color(sprintf("## %s\n", i), "cyan") + out <- paste0( + c( + sprintf(" R2: %.*f", digits, x[[i]]$R2), + sprintf(" adj. R2: %.*f", digits, x[[i]]$R2_adjusted) + ), + collapse = "\n" + ) + cat(out) + cat("\n\n") + } + } else { + cat(sprintf(" Symmetric Rxy: %.*f", digits, x[["Symmetric Rxy"]])) + cat("\n") + cat(sprintf("Asymmetric Pxy: %.*f", digits, x[["Asymmetric Pxy"]])) cat("\n\n") } invisible(x) diff --git a/R/r2.R b/R/r2.R index dbfc437fc..88b80fa2b 100644 --- a/R/r2.R +++ b/R/r2.R @@ -10,6 +10,8 @@ #' (`TRUE`) or not (`FALSE`)? #' @param ci Confidence interval level, as scalar. If `NULL` (default), no #' confidence intervals for R2 are calculated. +#' @param multivariate Logical. Should R2 reported to be by response (FALSE) +#' or across responses as computed by [`r2_mlm`] (TRUE). #' @param ... Arguments passed down to the related r2-methods. #' @inheritParams r2_nakagawa #' @@ -31,7 +33,7 @@ #' @seealso #' [`r2_bayes()`], [`r2_coxsnell()`], [`r2_kullback()`], [`r2_loo()`], #' [`r2_mcfadden()`], [`r2_nagelkerke()`], [`r2_nakagawa()`], [`r2_tjur()`], -#' [`r2_xu()`] and [`r2_zeroinflated()`]. +#' [`r2_xu()`], [`r2_zeroinflated()`], and [`r2_mlm()`]. #' #' @examplesIf require("lme4") #' # Pseudo r-quared for GLM @@ -245,24 +247,29 @@ r2.aov <- function(model, ci = NULL, ...) { structure(class = "r2_generic", out) } - +#' @rdname r2 #' @export -r2.mlm <- function(model, ...) { - model_summary <- summary(model) +r2.mlm <- function(model, multivariate = FALSE, ...) { - out <- lapply(names(model_summary), function(i) { - tmp <- list( - R2 = model_summary[[i]]$r.squared, - R2_adjusted = model_summary[[i]]$adj.r.squared, - Response = sub("Response ", "", i, fixed = TRUE) - ) - names(tmp$R2) <- "R2" - names(tmp$R2_adjusted) <- "adjusted R2" - names(tmp$Response) <- "Response" - tmp - }) + if (!multivariate) { + model_summary <- summary(model) - names(out) <- names(model_summary) + out <- lapply(names(model_summary), function(i) { + tmp <- list( + R2 = model_summary[[i]]$r.squared, + R2_adjusted = model_summary[[i]]$adj.r.squared, + Response = sub("Response ", "", i, fixed = TRUE) + ) + names(tmp$R2) <- "R2" + names(tmp$R2_adjusted) <- "adjusted R2" + names(tmp$Response) <- "Response" + tmp + }) + + names(out) <- names(model_summary) + } else { + out <- r2_mlm(model) + } attr(out, "model_type") <- "Multivariate Linear" structure(class = "r2_mlm", out) diff --git a/R/r2_mlm.R b/R/r2_mlm.R new file mode 100644 index 000000000..6ae1c1712 --- /dev/null +++ b/R/r2_mlm.R @@ -0,0 +1,87 @@ +#' @title Multivariate R2 +#' @name r2_mlm +#' +#' @description +#' Calculates two multivariate R2 values for multivariate linear regression. +#' +#' @param model Multivariate linear regression model. +#' @param ... Currently not used. +#' +#' @details +#' The two indexes returned summarize model fit for the set of predictors +#' given the system of responses. As compared to the default +#' [r2][performance::r2] index, the indexes returned provide a single +#' fit value for all responses. +#' +#' The two returned indexes were proposed by *Van den Burg and Lewis (1988)* +#' as an extension of *Cramer and Nicewander (1979)*. Of the numerous indexes +#' proposed across these two papers, and number of other metrics proposed +#' elsewhere, only two metrics, the \eqn{R_{xy}} and \eqn{P_{xy}}, are +#' recommended for use by *Azen and Budescu (2006)*. +#' +#' For a multivariate linear regression with \eqn{p} predictors and +#' \eqn{q} responses where \eqn{p > q}, the \eqn{R_{xy}} index is +#' computed as: +#' +#' \deqn{R_{xy} = 1 - \prod_{i=1}^p (1 - \rho_i^2)} +#' +#' Where \eqn{\rho} is a canonical variate from a +#' [canonical correlation][cancor] between the predictors and responses. +#' This metric is symmetric and its value does not change when the roles of +#' the variables as predictors or responses are swapped. +#' +#' The \eqn{P_{xy}} is computed as: +#' +#' \deqn{P_{xy} = \frac{q - trace(\bf{S}_{\bf{YY}}^{-1}\bf{S}_{\bf{YY|X}})}{q}} +#' +#' Where \eqn{\bf{S}_{\bf{YY}}} is the matrix of response covariances and +#' \eqn{\bf{S}_{\bf{YY|X}}} is the matrix of residual covariances given +#' the predictors. This metric is asymmetric and can change +#' depending on which variables are considered predictors versus responses. +#' +#' @return A named vector with the R2 values. +#' +#' @examples +#' model <- lm(cbind(qsec, drat) ~ wt + mpg + cyl, data = mtcars) +#' r2(model) +#' r2_mlm(model) +#' +#' model_swap <- lm(cbind(wt, mpg, cyl) ~ qsec + drat, data = mtcars) +#' r2_mlm(model_swap) +#' +#' @references +#' - Azen, R., & Budescu, D. V. (2006). Comparing predictors in +#' multivariate regression models: An extension of dominance analysis. +#' Journal of Educational and Behavioral Statistics, 31(2), 157-180. +#'- Cramer, E. M., & Nicewander, W. A. (1979). Some symmetric, +#' invariant measures of multivariate association. Psychometrika, 44, 43-54. +#' - Van den Burg, W., & Lewis, C. (1988). Some properties of two +#' measures of multivariate association. Psychometrika, 53, 109-122. +#' +#' @author Joseph Luchman +#' +#' @export +r2_mlm <- function(model, ...) { + UseMethod("r2_mlm") +} + +# methods --------------------------- + +#' @export +r2_mlm.mlm <- function(model, verbose = TRUE, ...) { + + rho2_vec <- + 1 - stats::cancor(insight::get_predictors(model), insight::get_response(model))$cor^2 + R_xy <- 1 - Reduce(`*`, rho2_vec, 1) + + resid_cov <- stats::cov(residuals(model)) + resp_cov <- stats::cov(insight::get_response(model)) + q <- ncol(insight::get_response(model)) + V_xy <- q - sum(diag(solve(resp_cov) %*% resid_cov)) + P_xy <- V_xy/q + + c( + "Symmetric Rxy" = R_xy, + "Asymmetric Pxy" = P_xy + ) +} \ No newline at end of file diff --git a/man/performance-package.Rd b/man/performance-package.Rd index b3f1d5a3f..f7a05c369 100644 --- a/man/performance-package.Rd +++ b/man/performance-package.Rd @@ -52,6 +52,7 @@ Other contributors: \item Martin Jullum [reviewer] \item gjo11 [reviewer] \item Etienne Bacher \email{etienne.bacher@protonmail.com} (\href{https://orcid.org/0000-0002-9271-5075}{ORCID}) [contributor] + \item Joseph Luchman (\href{https://orcid.org/0000-0002-8886-9717}{ORCID}) [contributor] } } diff --git a/man/r2.Rd b/man/r2.Rd index bf783e8d9..df4138884 100644 --- a/man/r2.Rd +++ b/man/r2.Rd @@ -3,6 +3,7 @@ \name{r2} \alias{r2} \alias{r2.default} +\alias{r2.mlm} \alias{r2.merMod} \title{Compute the model's R2} \usage{ @@ -10,6 +11,8 @@ r2(model, ...) \method{r2}{default}(model, ci = NULL, verbose = TRUE, ...) +\method{r2}{mlm}(model, multivariate = FALSE, ...) + \method{r2}{merMod}(model, ci = NULL, tolerance = 1e-05, ...) } \arguments{ @@ -23,6 +26,9 @@ confidence intervals for R2 are calculated.} \item{verbose}{Logical. Should details about R2 and CI methods be given (\code{TRUE}) or not (\code{FALSE})?} +\item{multivariate}{Logical. Should R2 reported to be by response (FALSE) +or across responses as computed by \code{\link{r2_mlm}} (TRUE).} + \item{tolerance}{Tolerance for singularity check of random effects, to decide whether to compute random effect variances for the conditional r-squared or not. Indicates up to which value the convergence result is accepted. When @@ -70,5 +76,5 @@ r2(model) \seealso{ \code{\link[=r2_bayes]{r2_bayes()}}, \code{\link[=r2_coxsnell]{r2_coxsnell()}}, \code{\link[=r2_kullback]{r2_kullback()}}, \code{\link[=r2_loo]{r2_loo()}}, \code{\link[=r2_mcfadden]{r2_mcfadden()}}, \code{\link[=r2_nagelkerke]{r2_nagelkerke()}}, \code{\link[=r2_nakagawa]{r2_nakagawa()}}, \code{\link[=r2_tjur]{r2_tjur()}}, -\code{\link[=r2_xu]{r2_xu()}} and \code{\link[=r2_zeroinflated]{r2_zeroinflated()}}. +\code{\link[=r2_xu]{r2_xu()}}, \code{\link[=r2_zeroinflated]{r2_zeroinflated()}}, and \code{\link[=r2_mlm]{r2_mlm()}}. } diff --git a/man/r2_mlm.Rd b/man/r2_mlm.Rd new file mode 100644 index 000000000..15aa9560c --- /dev/null +++ b/man/r2_mlm.Rd @@ -0,0 +1,74 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/r2_mlm.R +\name{r2_mlm} +\alias{r2_mlm} +\title{Multivariate R2} +\usage{ +r2_mlm(model, ...) +} +\arguments{ +\item{model}{Multivariate linear regression model.} + +\item{...}{Currently not used.} +} +\value{ +A named vector with the R2 values. +} +\description{ +Calculates two multivariate R2 values for multivariate linear regression. +} +\details{ +The two indexes returned summarize model fit for the set of predictors +given the system of responses. As compared to the default +\link[=r2]{r2} index, the indexes returned provide a single +fit value for all responses. + +The two returned indexes were proposed by \emph{Van den Burg and Lewis (1988)} +as an extension of \emph{Cramer and Nicewander (1979)}. Of the numerous indexes +proposed across these two papers, and number of other metrics proposed +elsewhere, only two metrics, the \eqn{R_{xy}} and \eqn{P_{xy}}, are +recommended for use by \emph{Azen and Budescu (2006)}. + +For a multivariate linear regression with \eqn{p} predictors and +\eqn{q} responses where \eqn{p > q}, \eqn{R_{xy}} index is +computed as: + +\deqn{R_{xy} = 1 - \prod_{i=1}^p (1 - \rho_i^2)} + +Where \eqn{\rho} is a canonical variate from a +\link[=cancor]{canonical correlations} between the predictors and responses. +This metric is symmetric and its value does not change when the roles of +the variables as predictors or responses are swapped. + +The \eqn{P_{xy}} is computed as: + +\deqn{P_{xy} = \frac{q - trace(\bf{S}_{\bf{YY}}^{-1}\bf{S}_{\bf{YY|X}})}{q}} + +Where \eqn{\bf{S}_{\bf{YY}}} is the matrix of response covariances and +\eqn{\bf{S}_{\bf{YY|X}}} is the matrix of residual covariances given +the predictors. This metric is asymmetric and can change +depending on which variables are considered predictors versus responses. +} +\examples{ +model <- lm(cbind(qsec, drat) ~ wt + mpg + cyl, data = mtcars) +r2(model) +r2_mlm(model) + +model_swap <- lm(cbind(wt, mpg, cyl) ~ qsec + drat, data = mtcars) +r2_mlm(model_swap) + +} +\references{ +\itemize{ +\item Azen, R., & Budescu, D. V. (2006). Comparing predictors in +multivariate regression models: An extension of dominance analysis. +Journal of Educational and Behavioral Statistics, 31(2), 157-180. +\item Cramer, E. M., & Nicewander, W. A. (1979). Some symmetric, +invariant measures of multivariate association. Psychometrika, 44, 43-54. +\item Van den Burg, W., & Lewis, C. (1988). Some properties of two +measures of multivariate association. Psychometrika, 53, 109-122. +} +} +\author{ +Joseph Luchman +} diff --git a/tests/testthat/test-r2_mlm.R b/tests/testthat/test-r2_mlm.R new file mode 100644 index 000000000..70076296d --- /dev/null +++ b/tests/testthat/test-r2_mlm.R @@ -0,0 +1,9 @@ +test_that("r2_mlm_Rxy", { + model <- lm(cbind(qsec, drat) ~ wt + mpg, data = mtcars) + expect_equal(r2_mlm(model)[["Symmetric Rxy"]], c(0.68330688076502), tolerance = 1e-3) +}) + +test_that("r2_mlm_Pxy", { + model <- lm(cbind(qsec, drat) ~ wt + mpg, data = mtcars) + expect_equal(r2_mlm(model)[["Asymmetric Pxy"]], c(0.407215267524997), tolerance = 1e-3) +}) From f215eb2bf12add556a3dae7f4d0d28568563b4cd Mon Sep 17 00:00:00 2001 From: Joseph Luchman Date: Sun, 18 Aug 2024 18:43:11 -0500 Subject: [PATCH 2/6] Spelling fixes --- inst/WORDLIST | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/inst/WORDLIST b/inst/WORDLIST index e5e90d844..37fd8d876 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -9,6 +9,7 @@ Ankerst Archimbaud Arel Asq +Azen BCI BFBayesFactor BMJ @@ -27,6 +28,7 @@ Breunig Breusch BRM Bryk +Budescu Bundock Burnham Byrne @@ -39,6 +41,7 @@ Chisq CochransQ CompQuadForm Concurvity +Cramer Cribari Cronbach's Crujeiras @@ -160,6 +163,7 @@ Neto's Nondegenerate Nordhausen Normed +Nicewander ORCID OSF Olkin From aa93d88bb5a422cea645c151b76b5028d222f312 Mon Sep 17 00:00:00 2001 From: Joseph Luchman Date: Sun, 18 Aug 2024 19:08:59 -0500 Subject: [PATCH 3/6] Documentation fixes --- R/r2.R | 5 +++-- R/r2_mlm.R | 13 +++++++------ man/r2.Rd | 5 +++-- man/r2_mlm.Rd | 17 +++++++++-------- 4 files changed, 22 insertions(+), 18 deletions(-) diff --git a/R/r2.R b/R/r2.R index 88b80fa2b..2af825304 100644 --- a/R/r2.R +++ b/R/r2.R @@ -10,8 +10,9 @@ #' (`TRUE`) or not (`FALSE`)? #' @param ci Confidence interval level, as scalar. If `NULL` (default), no #' confidence intervals for R2 are calculated. -#' @param multivariate Logical. Should R2 reported to be by response (FALSE) -#' or across responses as computed by [`r2_mlm`] (TRUE). +#' @param multivariate Logical. Should R2 reported be by separated by +#' response (FALSE) or combined across responses as computed by +#' [`r2_mlm`] (TRUE). #' @param ... Arguments passed down to the related r2-methods. #' @inheritParams r2_nakagawa #' diff --git a/R/r2_mlm.R b/R/r2_mlm.R index 6ae1c1712..c8d2dee95 100644 --- a/R/r2_mlm.R +++ b/R/r2_mlm.R @@ -10,14 +10,15 @@ #' @details #' The two indexes returned summarize model fit for the set of predictors #' given the system of responses. As compared to the default -#' [r2][performance::r2] index, the indexes returned provide a single -#' fit value for all responses. +#' [r2][performance::r2] index for multivariate linear models, the indexes +#' returned by this function provide a single fit value collapsed across +#' all responses. #' #' The two returned indexes were proposed by *Van den Burg and Lewis (1988)* -#' as an extension of *Cramer and Nicewander (1979)*. Of the numerous indexes -#' proposed across these two papers, and number of other metrics proposed -#' elsewhere, only two metrics, the \eqn{R_{xy}} and \eqn{P_{xy}}, are -#' recommended for use by *Azen and Budescu (2006)*. +#' as an extension of the metrics proposed by *Cramer and Nicewander (1979)*. +#' Of the numerous indexes proposed across these two papers, only two metrics, +#' the \eqn{R_{xy}} and \eqn{P_{xy}}, are recommended for use +#' by *Azen and Budescu (2006)*. #' #' For a multivariate linear regression with \eqn{p} predictors and #' \eqn{q} responses where \eqn{p > q}, the \eqn{R_{xy}} index is diff --git a/man/r2.Rd b/man/r2.Rd index df4138884..5fd16577b 100644 --- a/man/r2.Rd +++ b/man/r2.Rd @@ -26,8 +26,9 @@ confidence intervals for R2 are calculated.} \item{verbose}{Logical. Should details about R2 and CI methods be given (\code{TRUE}) or not (\code{FALSE})?} -\item{multivariate}{Logical. Should R2 reported to be by response (FALSE) -or across responses as computed by \code{\link{r2_mlm}} (TRUE).} +\item{multivariate}{Logical. Should R2 reported be by separated by +response (FALSE) or combined across responses as computed by +\code{\link{r2_mlm}} (TRUE).} \item{tolerance}{Tolerance for singularity check of random effects, to decide whether to compute random effect variances for the conditional r-squared diff --git a/man/r2_mlm.Rd b/man/r2_mlm.Rd index 15aa9560c..a9bc41b5a 100644 --- a/man/r2_mlm.Rd +++ b/man/r2_mlm.Rd @@ -20,23 +20,24 @@ Calculates two multivariate R2 values for multivariate linear regression. \details{ The two indexes returned summarize model fit for the set of predictors given the system of responses. As compared to the default -\link[=r2]{r2} index, the indexes returned provide a single -fit value for all responses. +\link[=r2]{r2} index for multivariate linear models, the indexes +returned by this function provide a single fit value collapsed across +all responses. The two returned indexes were proposed by \emph{Van den Burg and Lewis (1988)} -as an extension of \emph{Cramer and Nicewander (1979)}. Of the numerous indexes -proposed across these two papers, and number of other metrics proposed -elsewhere, only two metrics, the \eqn{R_{xy}} and \eqn{P_{xy}}, are -recommended for use by \emph{Azen and Budescu (2006)}. +as an extension of the metrics proposed by \emph{Cramer and Nicewander (1979)}. +Of the numerous indexes proposed across these two papers, only two metrics, +the \eqn{R_{xy}} and \eqn{P_{xy}}, are recommended for use +by \emph{Azen and Budescu (2006)}. For a multivariate linear regression with \eqn{p} predictors and -\eqn{q} responses where \eqn{p > q}, \eqn{R_{xy}} index is +\eqn{q} responses where \eqn{p > q}, the \eqn{R_{xy}} index is computed as: \deqn{R_{xy} = 1 - \prod_{i=1}^p (1 - \rho_i^2)} Where \eqn{\rho} is a canonical variate from a -\link[=cancor]{canonical correlations} between the predictors and responses. +\link[=cancor]{canonical correlation} between the predictors and responses. This metric is symmetric and its value does not change when the roles of the variables as predictors or responses are swapped. From f708a175789d892bf44dfb7b8e0839f2c4d6c5ec Mon Sep 17 00:00:00 2001 From: Joseph Luchman Date: Sat, 24 Aug 2024 09:24:27 -0500 Subject: [PATCH 4/6] Multivariate is default for `r2()`'s 'mlm' method; linter suggestion edits; minor documentation edit --- R/print-methods.R | 24 +++++++++++++++--------- R/r2.R | 14 +++++++------- R/r2_mlm.R | 9 ++++----- man/r2.Rd | 8 ++++---- man/r2_mlm.Rd | 1 - tests/testthat/test-r2_mlm.R | 4 ++-- 6 files changed, 32 insertions(+), 28 deletions(-) diff --git a/R/print-methods.R b/R/print-methods.R index e87b0e7ae..1509188fa 100644 --- a/R/print-methods.R +++ b/R/print-methods.R @@ -70,17 +70,28 @@ print.r2_mlm <- function(x, digits = 3, ...) { model_type <- attr(x, "model_type") is_multivar_r2 <- all(names(x) == c("Symmetric Rxy", "Asymmetric Pxy")) if (!is.null(model_type) && !is_multivar_r2) { - insight::print_color(sprintf("# R2 for %s Regression\n\n", model_type), "blue") + insight::print_color( + sprintf("# R2 for %s Regression\n\n", model_type), + "blue" + ) } else if (!is.null(model_type) && is_multivar_r2) { - insight::print_color(sprintf("# Multivariate R2 for %s Regression\n", model_type), "blue") + insight::print_color( + sprintf("# Multivariate R2 for %s Regression\n", model_type), + "blue" + ) } else { insight::print_color("# R2\n\n", "blue") } - if (!is_multivar_r2) { + if (is_multivar_r2) { + cat(sprintf(" Symmetric Rxy: %.*f", digits, x[["Symmetric Rxy"]])) + cat("\n") + cat(sprintf("Asymmetric Pxy: %.*f", digits, x[["Asymmetric Pxy"]])) + cat("\n\n") + } else { for (i in names(x)) { insight::print_color(sprintf("## %s\n", i), "cyan") - out <- paste0( + out <- paste( c( sprintf(" R2: %.*f", digits, x[[i]]$R2), sprintf(" adj. R2: %.*f", digits, x[[i]]$R2_adjusted) @@ -90,11 +101,6 @@ print.r2_mlm <- function(x, digits = 3, ...) { cat(out) cat("\n\n") } - } else { - cat(sprintf(" Symmetric Rxy: %.*f", digits, x[["Symmetric Rxy"]])) - cat("\n") - cat(sprintf("Asymmetric Pxy: %.*f", digits, x[["Asymmetric Pxy"]])) - cat("\n\n") } invisible(x) } diff --git a/R/r2.R b/R/r2.R index 2af825304..aeddd56ce 100644 --- a/R/r2.R +++ b/R/r2.R @@ -10,9 +10,9 @@ #' (`TRUE`) or not (`FALSE`)? #' @param ci Confidence interval level, as scalar. If `NULL` (default), no #' confidence intervals for R2 are calculated. -#' @param multivariate Logical. Should R2 reported be by separated by -#' response (FALSE) or combined across responses as computed by -#' [`r2_mlm`] (TRUE). +#' @param multivariate Logical. Should multiple R2 values be reported as +#' separated by response (FALSE) or should a single R2 be reported as +#' combined across responses computed by [`r2_mlm`] (TRUE). #' @param ... Arguments passed down to the related r2-methods. #' @inheritParams r2_nakagawa #' @@ -250,9 +250,11 @@ r2.aov <- function(model, ci = NULL, ...) { #' @rdname r2 #' @export -r2.mlm <- function(model, multivariate = FALSE, ...) { +r2.mlm <- function(model, multivariate = TRUE, ...) { - if (!multivariate) { + if (multivariate) { + out <- r2_mlm(model) + } else { model_summary <- summary(model) out <- lapply(names(model_summary), function(i) { @@ -268,8 +270,6 @@ r2.mlm <- function(model, multivariate = FALSE, ...) { }) names(out) <- names(model_summary) - } else { - out <- r2_mlm(model) } attr(out, "model_type") <- "Multivariate Linear" diff --git a/R/r2_mlm.R b/R/r2_mlm.R index c8d2dee95..e6b6c243b 100644 --- a/R/r2_mlm.R +++ b/R/r2_mlm.R @@ -44,7 +44,6 @@ #' #' @examples #' model <- lm(cbind(qsec, drat) ~ wt + mpg + cyl, data = mtcars) -#' r2(model) #' r2_mlm(model) #' #' model_swap <- lm(cbind(wt, mpg, cyl) ~ qsec + drat, data = mtcars) @@ -77,12 +76,12 @@ r2_mlm.mlm <- function(model, verbose = TRUE, ...) { resid_cov <- stats::cov(residuals(model)) resp_cov <- stats::cov(insight::get_response(model)) - q <- ncol(insight::get_response(model)) - V_xy <- q - sum(diag(solve(resp_cov) %*% resid_cov)) - P_xy <- V_xy/q + qq <- ncol(insight::get_response(model)) + V_xy <- qq - sum(diag(solve(resp_cov) %*% resid_cov)) + P_xy <- V_xy / qq c( "Symmetric Rxy" = R_xy, "Asymmetric Pxy" = P_xy ) -} \ No newline at end of file +} diff --git a/man/r2.Rd b/man/r2.Rd index 5fd16577b..a8d514908 100644 --- a/man/r2.Rd +++ b/man/r2.Rd @@ -11,7 +11,7 @@ r2(model, ...) \method{r2}{default}(model, ci = NULL, verbose = TRUE, ...) -\method{r2}{mlm}(model, multivariate = FALSE, ...) +\method{r2}{mlm}(model, multivariate = TRUE, ...) \method{r2}{merMod}(model, ci = NULL, tolerance = 1e-05, ...) } @@ -26,9 +26,9 @@ confidence intervals for R2 are calculated.} \item{verbose}{Logical. Should details about R2 and CI methods be given (\code{TRUE}) or not (\code{FALSE})?} -\item{multivariate}{Logical. Should R2 reported be by separated by -response (FALSE) or combined across responses as computed by -\code{\link{r2_mlm}} (TRUE).} +\item{multivariate}{Logical. Should multiple R2 values be reported as +separated by response (FALSE) or should a single R2 be reported as +combined across responses computed by \code{\link{r2_mlm}} (TRUE).} \item{tolerance}{Tolerance for singularity check of random effects, to decide whether to compute random effect variances for the conditional r-squared diff --git a/man/r2_mlm.Rd b/man/r2_mlm.Rd index a9bc41b5a..50b5389fd 100644 --- a/man/r2_mlm.Rd +++ b/man/r2_mlm.Rd @@ -52,7 +52,6 @@ depending on which variables are considered predictors versus responses. } \examples{ model <- lm(cbind(qsec, drat) ~ wt + mpg + cyl, data = mtcars) -r2(model) r2_mlm(model) model_swap <- lm(cbind(wt, mpg, cyl) ~ qsec + drat, data = mtcars) diff --git a/tests/testthat/test-r2_mlm.R b/tests/testthat/test-r2_mlm.R index 70076296d..a532b57a7 100644 --- a/tests/testthat/test-r2_mlm.R +++ b/tests/testthat/test-r2_mlm.R @@ -1,9 +1,9 @@ test_that("r2_mlm_Rxy", { model <- lm(cbind(qsec, drat) ~ wt + mpg, data = mtcars) - expect_equal(r2_mlm(model)[["Symmetric Rxy"]], c(0.68330688076502), tolerance = 1e-3) + expect_equal(r2_mlm(model)[["Symmetric Rxy"]], 0.68330688076502, tolerance = 1e-3) }) test_that("r2_mlm_Pxy", { model <- lm(cbind(qsec, drat) ~ wt + mpg, data = mtcars) - expect_equal(r2_mlm(model)[["Asymmetric Pxy"]], c(0.407215267524997), tolerance = 1e-3) + expect_equal(r2_mlm(model)[["Asymmetric Pxy"]], 0.407215267524997, tolerance = 1e-3) }) From 4cfaacbf627d04bad571788c5d1eb28d749a1296 Mon Sep 17 00:00:00 2001 From: Daniel Date: Wed, 28 Aug 2024 12:41:30 +0200 Subject: [PATCH 5/6] minor code style --- R/r2_mlm.R | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/R/r2_mlm.R b/R/r2_mlm.R index e6b6c243b..0f08ad235 100644 --- a/R/r2_mlm.R +++ b/R/r2_mlm.R @@ -69,9 +69,10 @@ r2_mlm <- function(model, ...) { #' @export r2_mlm.mlm <- function(model, verbose = TRUE, ...) { - - rho2_vec <- - 1 - stats::cancor(insight::get_predictors(model), insight::get_response(model))$cor^2 + rho2_vec <- 1 - stats::cancor( + insight::get_predictors(model), + insight::get_response(model) + )$cor^2 R_xy <- 1 - Reduce(`*`, rho2_vec, 1) resid_cov <- stats::cov(residuals(model)) @@ -80,8 +81,5 @@ r2_mlm.mlm <- function(model, verbose = TRUE, ...) { V_xy <- qq - sum(diag(solve(resp_cov) %*% resid_cov)) P_xy <- V_xy / qq - c( - "Symmetric Rxy" = R_xy, - "Asymmetric Pxy" = P_xy - ) + c("Symmetric Rxy" = R_xy, "Asymmetric Pxy" = P_xy) } From 09599f4d10ef896f3e886a916e1a6d3dca69d172 Mon Sep 17 00:00:00 2001 From: Daniel Date: Wed, 28 Aug 2024 12:42:12 +0200 Subject: [PATCH 6/6] version bump --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index c37a26032..593afc5b1 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: performance Title: Assessment of Regression Models Performance -Version: 0.12.2.12 +Version: 0.12.2.13 Authors@R: c(person(given = "Daniel", family = "Lüdecke",