From 9805166fd62044b9bab0a17239db824c2f695064 Mon Sep 17 00:00:00 2001 From: Daniel Date: Thu, 14 Sep 2023 18:48:03 +0200 Subject: [PATCH 01/11] use examplesIf --- R/check_distribution.R | 14 +++++-------- R/check_itemscale.R | 11 +++++----- R/check_multimodal.R | 42 +++++++++++++++++-------------------- R/check_predictions.R | 29 +++++++++++--------------- R/check_sphericity.R | 15 +++++++------ R/icc.R | 36 ++++++++++++++------------------ R/r2_nakagawa.R | 10 ++++----- man/check_distribution.Rd | 14 ++++++------- man/check_itemscale.Rd | 11 +++++----- man/check_multimodal.Rd | 44 +++++++++++++++++++-------------------- man/check_predictions.Rd | 30 ++++++++++++-------------- man/check_sphericity.Rd | 15 ++++++------- man/icc.Rd | 38 ++++++++++++++++----------------- man/r2_nakagawa.Rd | 10 ++++----- 14 files changed, 145 insertions(+), 174 deletions(-) diff --git a/R/check_distribution.R b/R/check_distribution.R index 976fedf7c..77cc19db6 100644 --- a/R/check_distribution.R +++ b/R/check_distribution.R @@ -48,15 +48,11 @@ NULL #' There is a `plot()` method, which shows the probabilities of all predicted #' distributions, however, only if the probability is greater than zero. #' -#' @examples -#' if (require("lme4") && require("parameters") && -#' require("see") && require("patchwork") && require("randomForest")) { -#' data(sleepstudy) -#' -#' model <<- lmer(Reaction ~ Days + (Days | Subject), sleepstudy) -#' check_distribution(model) -#' plot(check_distribution(model)) -#' } +#' @examplesIf require("lme4") && require("parameters") && require("see") && require("patchwork") && require("randomForest") +#' data(sleepstudy, package = "lme4") +#' model <<- lme4::lmer(Reaction ~ Days + (Days | Subject), sleepstudy) +#' check_distribution(model) +#' plot(check_distribution(model)) #' @export check_distribution <- function(model) { UseMethod("check_distribution") diff --git a/R/check_itemscale.R b/R/check_itemscale.R index 182b681bc..8d8b71082 100644 --- a/R/check_itemscale.R +++ b/R/check_itemscale.R @@ -43,17 +43,16 @@ #' - Trochim WMK (2008) Types of Reliability. #' ([web](https://conjointly.com/kb/types-of-reliability/)) #' -#' @examples +#' @examplesIf require("parameters") && require("psych") #' # data generation from '?prcomp', slightly modified #' C <- chol(S <- toeplitz(0.9^(0:15))) #' set.seed(17) #' X <- matrix(rnorm(1600), 100, 16) #' Z <- X %*% C -#' if (require("parameters") && require("psych")) { -#' pca <- principal_components(as.data.frame(Z), rotation = "varimax", n = 3) -#' pca -#' check_itemscale(pca) -#' } +#' +#' pca <- principal_components(as.data.frame(Z), rotation = "varimax", n = 3) +#' pca +#' check_itemscale(pca) #' @export check_itemscale <- function(x) { if (!inherits(x, "parameters_pca")) { diff --git a/R/check_multimodal.R b/R/check_multimodal.R index 9223ee59a..6285af02f 100644 --- a/R/check_multimodal.R +++ b/R/check_multimodal.R @@ -10,33 +10,29 @@ #' @param x A numeric vector or a data frame. #' @param ... Arguments passed to or from other methods. #' -#' @examples +#' @examplesIf require("multimode") && require("mclust") #' \dontrun{ -#' if (require("multimode")) { -#' # Univariate -#' x <- rnorm(1000) -#' check_multimodal(x) -#' } +#' # Univariate +#' x <- rnorm(1000) +#' check_multimodal(x) #' -#' if (require("multimode") && require("mclust")) { -#' x <- c(rnorm(1000), rnorm(1000, 2)) -#' check_multimodal(x) +#' x <- c(rnorm(1000), rnorm(1000, 2)) +#' check_multimodal(x) #' -#' # Multivariate -#' m <- data.frame( -#' x = rnorm(200), -#' y = rbeta(200, 2, 1) -#' ) -#' plot(m$x, m$y) -#' check_multimodal(m) +#' # Multivariate +#' m <- data.frame( +#' x = rnorm(200), +#' y = rbeta(200, 2, 1) +#' ) +#' plot(m$x, m$y) +#' check_multimodal(m) #' -#' m <- data.frame( -#' x = c(rnorm(100), rnorm(100, 4)), -#' y = c(rbeta(100, 2, 1), rbeta(100, 1, 4)) -#' ) -#' plot(m$x, m$y) -#' check_multimodal(m) -#' } +#' m <- data.frame( +#' x = c(rnorm(100), rnorm(100, 4)), +#' y = c(rbeta(100, 2, 1), rbeta(100, 1, 4)) +#' ) +#' plot(m$x, m$y) +#' check_multimodal(m) #' } #' @references #' - Ameijeiras-Alonso, J., Crujeiras, R. M., and Rodríguez-Casal, A. (2019). diff --git a/R/check_predictions.R b/R/check_predictions.R index 2e3bc6462..d52b8378a 100644 --- a/R/check_predictions.R +++ b/R/check_predictions.R @@ -66,26 +66,21 @@ #' - Gelman, A., Hill, J., and Vehtari, A. (2020). Regression and Other Stories. #' Cambridge University Press. #' -#' @examples -#' library(performance) +#' @examplesIf require("see") #' # linear model -#' if (require("see")) { -#' model <- lm(mpg ~ disp, data = mtcars) -#' check_predictions(model) -#' } +#' model <- lm(mpg ~ disp, data = mtcars) +#' check_predictions(model) #' #' # discrete/integer outcome -#' if (require("see")) { -#' set.seed(99) -#' d <- iris -#' d$skewed <- rpois(150, 1) -#' model <- glm( -#' skewed ~ Species + Petal.Length + Petal.Width, -#' family = poisson(), -#' data = d -#' ) -#' check_predictions(model, type = "discrete_both") -#' } +#' set.seed(99) +#' d <- iris +#' d$skewed <- rpois(150, 1) +#' model <- glm( +#' skewed ~ Species + Petal.Length + Petal.Width, +#' family = poisson(), +#' data = d +#' ) +#' check_predictions(model, type = "discrete_both") #' #' @export check_predictions <- function(object, ...) { diff --git a/R/check_sphericity.R b/R/check_sphericity.R index 5a9ebba95..a087a1a5f 100644 --- a/R/check_sphericity.R +++ b/R/check_sphericity.R @@ -10,15 +10,14 @@ #' @return Invisibly returns the p-values of the test statistics. A p-value < #' 0.05 indicates a violation of sphericity. #' -#' @examples -#' if (require("car")) { -#' soils.mod <- lm( -#' cbind(pH, N, Dens, P, Ca, Mg, K, Na, Conduc) ~ Block + Contour * Depth, -#' data = Soils -#' ) +#' @examplesIf require("car") && require("carData") +#' data(Soils, package = "carData") +#' soils.mod <- lm( +#' cbind(pH, N, Dens, P, Ca, Mg, K, Na, Conduc) ~ Block + Contour * Depth, +#' data = Soils +#' ) #' -#' check_sphericity(Manova(soils.mod)) -#' } +#' check_sphericity(Manova(soils.mod)) #' @export check_sphericity <- function(x, ...) { UseMethod("check_sphericity") diff --git a/R/icc.R b/R/icc.R index 8ce19288e..9155a7f40 100644 --- a/R/icc.R +++ b/R/icc.R @@ -143,29 +143,25 @@ #' very large, the variance ratio in the output makes no sense, e.g. because #' it is negative. In such cases, it might help to use `robust = TRUE`. #' -#' @examples -#' if (require("lme4")) { -#' model <- lmer(Sepal.Length ~ Petal.Length + (1 | Species), data = iris) -#' icc(model) -#' } +#' @examplesIf require("lme4") +#' model <- lme4::lmer(Sepal.Length ~ Petal.Length + (1 | Species), data = iris) +#' icc(model) #' #' # ICC for specific group-levels -#' if (require("lme4")) { -#' data(sleepstudy) -#' set.seed(12345) -#' sleepstudy$grp <- sample(1:5, size = 180, replace = TRUE) -#' sleepstudy$subgrp <- NA -#' for (i in 1:5) { -#' filter_group <- sleepstudy$grp == i -#' sleepstudy$subgrp[filter_group] <- -#' sample(1:30, size = sum(filter_group), replace = TRUE) -#' } -#' model <- lmer( -#' Reaction ~ Days + (1 | grp / subgrp) + (1 | Subject), -#' data = sleepstudy -#' ) -#' icc(model, by_group = TRUE) +#' data(sleepstudy, package = "lme4") +#' set.seed(12345) +#' sleepstudy$grp <- sample(1:5, size = 180, replace = TRUE) +#' sleepstudy$subgrp <- NA +#' for (i in 1:5) { +#' filter_group <- sleepstudy$grp == i +#' sleepstudy$subgrp[filter_group] <- +#' sample(1:30, size = sum(filter_group), replace = TRUE) #' } +#' model <- lme4::lmer( +#' Reaction ~ Days + (1 | grp / subgrp) + (1 | Subject), +#' data = sleepstudy +#' ) +#' icc(model, by_group = TRUE) #' @export icc <- function(model, by_group = FALSE, diff --git a/R/r2_nakagawa.R b/R/r2_nakagawa.R index cdf1c8e02..9b751c843 100644 --- a/R/r2_nakagawa.R +++ b/R/r2_nakagawa.R @@ -46,12 +46,10 @@ #' generalized linear mixed-effects models revisited and expanded. Journal of #' The Royal Society Interface, 14(134), 20170213. #' -#' @examples -#' if (require("lme4")) { -#' model <- lmer(Sepal.Length ~ Petal.Length + (1 | Species), data = iris) -#' r2_nakagawa(model) -#' r2_nakagawa(model, by_group = TRUE) -#' } +#' @examplesIf require("lme4") +#' model <- lme4::lmer(Sepal.Length ~ Petal.Length + (1 | Species), data = iris) +#' r2_nakagawa(model) +#' r2_nakagawa(model, by_group = TRUE) #' @export r2_nakagawa <- function(model, by_group = FALSE, diff --git a/man/check_distribution.Rd b/man/check_distribution.Rd index 83ece551a..9ccc8ccc1 100644 --- a/man/check_distribution.Rd +++ b/man/check_distribution.Rd @@ -45,12 +45,10 @@ implemented in the \href{https://easystats.github.io/see/}{\pkg{see}-package}. } \examples{ -if (require("lme4") && require("parameters") && - require("see") && require("patchwork") && require("randomForest")) { - data(sleepstudy) - - model <<- lmer(Reaction ~ Days + (Days | Subject), sleepstudy) - check_distribution(model) - plot(check_distribution(model)) -} +\dontshow{if (require("lme4") && require("parameters") && require("see") && require("patchwork") && require("randomForest")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +data(sleepstudy, package = "lme4") +model <<- lme4::lmer(Reaction ~ Days + (Days | Subject), sleepstudy) +check_distribution(model) +plot(check_distribution(model)) +\dontshow{\}) # examplesIf} } diff --git a/man/check_itemscale.Rd b/man/check_itemscale.Rd index dc6128bbf..7fa487ab5 100644 --- a/man/check_itemscale.Rd +++ b/man/check_itemscale.Rd @@ -44,16 +44,17 @@ acceptability. Satisfactory range lies between 0.2 and 0.4. See also } } \examples{ +\dontshow{if (require("parameters") && require("psych")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} # data generation from '?prcomp', slightly modified C <- chol(S <- toeplitz(0.9^(0:15))) set.seed(17) X <- matrix(rnorm(1600), 100, 16) Z <- X \%*\% C -if (require("parameters") && require("psych")) { - pca <- principal_components(as.data.frame(Z), rotation = "varimax", n = 3) - pca - check_itemscale(pca) -} + +pca <- principal_components(as.data.frame(Z), rotation = "varimax", n = 3) +pca +check_itemscale(pca) +\dontshow{\}) # examplesIf} } \references{ \itemize{ diff --git a/man/check_multimodal.Rd b/man/check_multimodal.Rd index 43153734a..a53546a28 100644 --- a/man/check_multimodal.Rd +++ b/man/check_multimodal.Rd @@ -19,33 +19,31 @@ it always returns a significant result (suggesting that the distribution is multimodal). A better method might be needed here. } \examples{ +\dontshow{if (require("multimode") && require("mclust")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} \dontrun{ -if (require("multimode")) { - # Univariate - x <- rnorm(1000) - check_multimodal(x) -} +# Univariate +x <- rnorm(1000) +check_multimodal(x) -if (require("multimode") && require("mclust")) { - x <- c(rnorm(1000), rnorm(1000, 2)) - check_multimodal(x) +x <- c(rnorm(1000), rnorm(1000, 2)) +check_multimodal(x) - # Multivariate - m <- data.frame( - x = rnorm(200), - y = rbeta(200, 2, 1) - ) - plot(m$x, m$y) - check_multimodal(m) +# Multivariate +m <- data.frame( + x = rnorm(200), + y = rbeta(200, 2, 1) +) +plot(m$x, m$y) +check_multimodal(m) - m <- data.frame( - x = c(rnorm(100), rnorm(100, 4)), - y = c(rbeta(100, 2, 1), rbeta(100, 1, 4)) - ) - plot(m$x, m$y) - check_multimodal(m) -} -} +m <- data.frame( + x = c(rnorm(100), rnorm(100, 4)), + y = c(rbeta(100, 2, 1), rbeta(100, 1, 4)) +) +plot(m$x, m$y) +check_multimodal(m) +} +\dontshow{\}) # examplesIf} } \references{ \itemize{ diff --git a/man/check_predictions.Rd b/man/check_predictions.Rd index a2a15ab50..591c813da 100644 --- a/man/check_predictions.Rd +++ b/man/check_predictions.Rd @@ -86,26 +86,22 @@ package that imports \strong{bayesplot} such as \strong{rstanarm} or \strong{brm is loaded, \code{pp_check()} is also available as an alias for \code{check_predictions()}. } \examples{ -library(performance) +\dontshow{if (require("see")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} # linear model -if (require("see")) { - model <- lm(mpg ~ disp, data = mtcars) - check_predictions(model) -} +model <- lm(mpg ~ disp, data = mtcars) +check_predictions(model) # discrete/integer outcome -if (require("see")) { - set.seed(99) - d <- iris - d$skewed <- rpois(150, 1) - model <- glm( - skewed ~ Species + Petal.Length + Petal.Width, - family = poisson(), - data = d - ) - check_predictions(model, type = "discrete_both") -} - +set.seed(99) +d <- iris +d$skewed <- rpois(150, 1) +model <- glm( + skewed ~ Species + Petal.Length + Petal.Width, + family = poisson(), + data = d +) +check_predictions(model, type = "discrete_both") +\dontshow{\}) # examplesIf} } \references{ \itemize{ diff --git a/man/check_sphericity.Rd b/man/check_sphericity.Rd index 531b745a2..6aaa53b3b 100644 --- a/man/check_sphericity.Rd +++ b/man/check_sphericity.Rd @@ -20,12 +20,13 @@ Check model for violation of sphericity. For \link[=check_factorstructure]{Bartl (used for correlation matrices and factor analyses), see \link{check_sphericity_bartlett}. } \examples{ -if (require("car")) { - soils.mod <- lm( - cbind(pH, N, Dens, P, Ca, Mg, K, Na, Conduc) ~ Block + Contour * Depth, - data = Soils - ) +\dontshow{if (require("car") && require("carData")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +data(Soils, package = "carData") +soils.mod <- lm( + cbind(pH, N, Dens, P, Ca, Mg, K, Na, Conduc) ~ Block + Contour * Depth, + data = Soils +) - check_sphericity(Manova(soils.mod)) -} +check_sphericity(Manova(soils.mod)) +\dontshow{\}) # examplesIf} } diff --git a/man/icc.Rd b/man/icc.Rd index facc40653..d25004e07 100644 --- a/man/icc.Rd +++ b/man/icc.Rd @@ -176,28 +176,26 @@ it is negative. In such cases, it might help to use \code{robust = TRUE}. } } \examples{ -if (require("lme4")) { - model <- lmer(Sepal.Length ~ Petal.Length + (1 | Species), data = iris) - icc(model) -} +\dontshow{if (require("lme4")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +model <- lme4::lmer(Sepal.Length ~ Petal.Length + (1 | Species), data = iris) +icc(model) # ICC for specific group-levels -if (require("lme4")) { - data(sleepstudy) - set.seed(12345) - sleepstudy$grp <- sample(1:5, size = 180, replace = TRUE) - sleepstudy$subgrp <- NA - for (i in 1:5) { - filter_group <- sleepstudy$grp == i - sleepstudy$subgrp[filter_group] <- - sample(1:30, size = sum(filter_group), replace = TRUE) - } - model <- lmer( - Reaction ~ Days + (1 | grp / subgrp) + (1 | Subject), - data = sleepstudy - ) - icc(model, by_group = TRUE) -} +data(sleepstudy, package = "lme4") +set.seed(12345) +sleepstudy$grp <- sample(1:5, size = 180, replace = TRUE) +sleepstudy$subgrp <- NA +for (i in 1:5) { + filter_group <- sleepstudy$grp == i + sleepstudy$subgrp[filter_group] <- + sample(1:30, size = sum(filter_group), replace = TRUE) +} +model <- lme4::lmer( + Reaction ~ Days + (1 | grp / subgrp) + (1 | Subject), + data = sleepstudy +) +icc(model, by_group = TRUE) +\dontshow{\}) # examplesIf} } \references{ \itemize{ diff --git a/man/r2_nakagawa.Rd b/man/r2_nakagawa.Rd index 3bfa31fed..357c2a3e9 100644 --- a/man/r2_nakagawa.Rd +++ b/man/r2_nakagawa.Rd @@ -74,11 +74,11 @@ The contribution of random effects can be deduced by subtracting the marginal R2 from the conditional R2 or by computing the \code{\link[=icc]{icc()}}. } \examples{ -if (require("lme4")) { - model <- lmer(Sepal.Length ~ Petal.Length + (1 | Species), data = iris) - r2_nakagawa(model) - r2_nakagawa(model, by_group = TRUE) -} +\dontshow{if (require("lme4")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +model <- lme4::lmer(Sepal.Length ~ Petal.Length + (1 | Species), data = iris) +r2_nakagawa(model) +r2_nakagawa(model, by_group = TRUE) +\dontshow{\}) # examplesIf} } \references{ \itemize{ From 12bd32c9adca692de073370fd8b8df558ad819e4 Mon Sep 17 00:00:00 2001 From: Daniel Date: Thu, 14 Sep 2023 18:50:35 +0200 Subject: [PATCH 02/11] examplesIf --- R/model_performance.mixed.R | 8 +++----- R/performance_rmse.R | 15 +++++++-------- R/performance_score.R | 20 +++++++++----------- man/model_performance.merMod.Rd | 8 ++++---- man/performance_rmse.Rd | 15 ++++++++------- man/performance_score.Rd | 20 ++++++++++---------- 6 files changed, 41 insertions(+), 45 deletions(-) diff --git a/R/model_performance.mixed.R b/R/model_performance.mixed.R index 2c9d0ea1b..499196dab 100644 --- a/R/model_performance.mixed.R +++ b/R/model_performance.mixed.R @@ -35,11 +35,9 @@ #' on returned indices. #' } #' -#' @examples -#' if (require("lme4")) { -#' model <- lmer(Petal.Length ~ Sepal.Length + (1 | Species), data = iris) -#' model_performance(model) -#' } +#' @examplesIf require("lme4") +#' model <- lme4::lmer(Petal.Length ~ Sepal.Length + (1 | Species), data = iris) +#' model_performance(model) #' @export model_performance.merMod <- function(model, metrics = "all", diff --git a/R/performance_rmse.R b/R/performance_rmse.R index b5044044f..0cc5eac90 100644 --- a/R/performance_rmse.R +++ b/R/performance_rmse.R @@ -20,16 +20,15 @@ #' #' @return Numeric, the root mean squared error. #' -#' @examples -#' if (require("nlme")) { -#' m <- lme(distance ~ age, data = Orthodont) +#' @examplesIf require("nlme") +#' data(Orthodont, package = "nlme") +#' m <- nlme::lme(distance ~ age, data = Orthodont) #' -#' # RMSE -#' performance_rmse(m, normalized = FALSE) +#' # RMSE +#' performance_rmse(m, normalized = FALSE) #' -#' # normalized RMSE -#' performance_rmse(m, normalized = TRUE) -#' } +#' # normalized RMSE +#' performance_rmse(m, normalized = TRUE) #' @export performance_rmse <- function(model, normalized = FALSE, verbose = TRUE) { tryCatch( diff --git a/R/performance_score.R b/R/performance_score.R index 7c606c71f..58a701069 100644 --- a/R/performance_score.R +++ b/R/performance_score.R @@ -32,7 +32,7 @@ #' #' @seealso [`performance_logloss()`] #' -#' @examples +#' @examplesIf require("glmmTMB") #' ## Dobson (1990) Page 93: Randomized Controlled Trial : #' counts <- c(18, 17, 15, 20, 10, 20, 25, 13, 12) #' outcome <- gl(3, 1, 9) @@ -41,17 +41,15 @@ #' #' performance_score(model) #' \dontrun{ -#' if (require("glmmTMB")) { -#' data(Salamanders) -#' model <- glmmTMB( -#' count ~ spp + mined + (1 | site), -#' zi = ~ spp + mined, -#' family = nbinom2(), -#' data = Salamanders -#' ) +#' data(Salamanders, package = "glmmTMB") +#' model <- glmmTMB::glmmTMB( +#' count ~ spp + mined + (1 | site), +#' zi = ~ spp + mined, +#' family = nbinom2(), +#' data = Salamanders +#' ) #' -#' performance_score(model) -#' } +#' performance_score(model) #' } #' @export performance_score <- function(model, verbose = TRUE, ...) { diff --git a/man/model_performance.merMod.Rd b/man/model_performance.merMod.Rd index 2145ec379..519f1ee0a 100644 --- a/man/model_performance.merMod.Rd +++ b/man/model_performance.merMod.Rd @@ -58,8 +58,8 @@ on returned indices. } } \examples{ -if (require("lme4")) { - model <- lmer(Petal.Length ~ Sepal.Length + (1 | Species), data = iris) - model_performance(model) -} +\dontshow{if (require("lme4")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +model <- lme4::lmer(Petal.Length ~ Sepal.Length + (1 | Species), data = iris) +model_performance(model) +\dontshow{\}) # examplesIf} } diff --git a/man/performance_rmse.Rd b/man/performance_rmse.Rd index cd9b84e87..bea4534b5 100644 --- a/man/performance_rmse.Rd +++ b/man/performance_rmse.Rd @@ -35,13 +35,14 @@ range of the response variable. Hence, lower values indicate less residual variance. } \examples{ -if (require("nlme")) { - m <- lme(distance ~ age, data = Orthodont) +\dontshow{if (require("nlme")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +data(Orthodont, package = "nlme") +m <- nlme::lme(distance ~ age, data = Orthodont) - # RMSE - performance_rmse(m, normalized = FALSE) +# RMSE +performance_rmse(m, normalized = FALSE) - # normalized RMSE - performance_rmse(m, normalized = TRUE) -} +# normalized RMSE +performance_rmse(m, normalized = TRUE) +\dontshow{\}) # examplesIf} } diff --git a/man/performance_score.Rd b/man/performance_score.Rd index 2dc85faf5..162f3ed13 100644 --- a/man/performance_score.Rd +++ b/man/performance_score.Rd @@ -38,6 +38,7 @@ Code is partially based on \href{https://drizopoulos.github.io/GLMMadaptive/reference/scoring_rules.html}{GLMMadaptive::scoring_rules()}. } \examples{ +\dontshow{if (require("glmmTMB")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} ## Dobson (1990) Page 93: Randomized Controlled Trial : counts <- c(18, 17, 15, 20, 10, 20, 25, 13, 12) outcome <- gl(3, 1, 9) @@ -46,18 +47,17 @@ model <- glm(counts ~ outcome + treatment, family = poisson()) performance_score(model) \dontrun{ -if (require("glmmTMB")) { - data(Salamanders) - model <- glmmTMB( - count ~ spp + mined + (1 | site), - zi = ~ spp + mined, - family = nbinom2(), - data = Salamanders - ) +data(Salamanders, package = "glmmTMB") +model <- glmmTMB::glmmTMB( + count ~ spp + mined + (1 | site), + zi = ~ spp + mined, + family = nbinom2(), + data = Salamanders +) - performance_score(model) -} +performance_score(model) } +\dontshow{\}) # examplesIf} } \references{ Carvalho, A. (2016). An overview of applications of proper scoring rules. From cf2f2f525c9ee2dfb4c0afd407b53dac2051f213 Mon Sep 17 00:00:00 2001 From: Daniel Date: Thu, 14 Sep 2023 18:51:34 +0200 Subject: [PATCH 03/11] typo --- R/check_convergence.R | 2 +- man/check_convergence.Rd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/check_convergence.R b/R/check_convergence.R index 25faa7277..0aeb51c82 100644 --- a/R/check_convergence.R +++ b/R/check_convergence.R @@ -52,7 +52,7 @@ #' cbpp$x <- rnorm(nrow(cbpp)) #' cbpp$x2 <- runif(nrow(cbpp)) #' -#' model <- lm4::glmer( +#' model <- lme4::glmer( #' cbind(incidence, size - incidence) ~ period + x + x2 + (1 + x | herd), #' data = cbpp, #' family = binomial() diff --git a/man/check_convergence.Rd b/man/check_convergence.Rd index b5d42cc64..c5e556f09 100644 --- a/man/check_convergence.Rd +++ b/man/check_convergence.Rd @@ -69,7 +69,7 @@ set.seed(1) cbpp$x <- rnorm(nrow(cbpp)) cbpp$x2 <- runif(nrow(cbpp)) -model <- lm4::glmer( +model <- lme4::glmer( cbind(incidence, size - incidence) ~ period + x + x2 + (1 + x | herd), data = cbpp, family = binomial() From c602602439b82891a0119ad4298a9b15b8a284ad Mon Sep 17 00:00:00 2001 From: Daniel Date: Thu, 14 Sep 2023 18:56:32 +0200 Subject: [PATCH 04/11] examplesIf --- R/looic.R | 14 +++++++---- R/model_performance.bayesian.R | 41 ++++++++++++++++---------------- man/looic.Rd | 14 +++++++---- man/model_performance.stanreg.Rd | 41 +++++++++++++++++--------------- 4 files changed, 62 insertions(+), 48 deletions(-) diff --git a/R/looic.R b/R/looic.R index 040d2d410..d1c7fc49a 100644 --- a/R/looic.R +++ b/R/looic.R @@ -11,11 +11,15 @@ #' #' @return A list with four elements, the ELPD, LOOIC and their standard errors. #' -#' @examples -#' if (require("rstanarm")) { -#' model <- stan_glm(mpg ~ wt + cyl, data = mtcars, chains = 1, iter = 500, refresh = 0) -#' looic(model) -#' } +#' @examplesIf require("rstanarm") +#' model <- rstanarm::stan_glm( +#' mpg ~ wt + cyl, +#' data = mtcars, +#' chains = 1, +#' iter = 500, +#' refresh = 0 +#' ) +#' looic(model) #' @export looic <- function(model, verbose = TRUE) { insight::check_if_installed("loo") diff --git a/R/model_performance.bayesian.R b/R/model_performance.bayesian.R index 66b5f936c..64b227011 100644 --- a/R/model_performance.bayesian.R +++ b/R/model_performance.bayesian.R @@ -40,30 +40,31 @@ #' #' - **PCP**: percentage of correct predictions, see [performance_pcp()]. #' -#' @examples +#' @examplesIf require("rstanarm") && require("rstantools") && require("BayesFactor") #' \dontrun{ -#' if (require("rstanarm") && require("rstantools")) { -#' model <- stan_glm(mpg ~ wt + cyl, data = mtcars, chains = 1, iter = 500, refresh = 0) -#' model_performance(model) +#' model <- rstanarm::stan_glm( +#' mpg ~ wt + cyl, +#' data = mtcars, +#' chains = 1, +#' iter = 500, +#' refresh = 0 +#' ) +#' model_performance(model) #' -#' model <- stan_glmer( -#' mpg ~ wt + cyl + (1 | gear), -#' data = mtcars, -#' chains = 1, -#' iter = 500, -#' refresh = 0 -#' ) -#' model_performance(model) -#' } -#' -#' if (require("BayesFactor") && require("rstantools")) { -#' model <- generalTestBF(carb ~ am + mpg, mtcars) +#' model <- stan_glmer( +#' mpg ~ wt + cyl + (1 | gear), +#' data = mtcars, +#' chains = 1, +#' iter = 500, +#' refresh = 0 +#' ) +#' model_performance(model) #' -#' model_performance(model) -#' model_performance(model[3]) +#' model <- generalTestBF(carb ~ am + mpg, mtcars) #' -#' model_performance(model, average = TRUE) -#' } +#' model_performance(model) +#' model_performance(model[3]) +#' model_performance(model, average = TRUE) #' } #' @seealso [r2_bayes] #' @references Gelman, A., Goodrich, B., Gabry, J., and Vehtari, A. (2018). diff --git a/man/looic.Rd b/man/looic.Rd index c1893b06d..3285be1fc 100644 --- a/man/looic.Rd +++ b/man/looic.Rd @@ -21,8 +21,14 @@ regressions. For LOOIC and ELPD, smaller and larger values are respectively indicative of a better fit. } \examples{ -if (require("rstanarm")) { - model <- stan_glm(mpg ~ wt + cyl, data = mtcars, chains = 1, iter = 500, refresh = 0) - looic(model) -} +\dontshow{if (require("rstanarm")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +model <- rstanarm::stan_glm( + mpg ~ wt + cyl, + data = mtcars, + chains = 1, + iter = 500, + refresh = 0 +) +looic(model) +\dontshow{\}) # examplesIf} } diff --git a/man/model_performance.stanreg.Rd b/man/model_performance.stanreg.Rd index 1b1a421e7..4c26214a5 100644 --- a/man/model_performance.stanreg.Rd +++ b/man/model_performance.stanreg.Rd @@ -60,30 +60,33 @@ values mean better fit. See \code{?loo::waic}. } } \examples{ +\dontshow{if (require("rstanarm") && require("rstantools") && require("BayesFactor")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} \dontrun{ -if (require("rstanarm") && require("rstantools")) { - model <- stan_glm(mpg ~ wt + cyl, data = mtcars, chains = 1, iter = 500, refresh = 0) - model_performance(model) - - model <- stan_glmer( - mpg ~ wt + cyl + (1 | gear), - data = mtcars, - chains = 1, - iter = 500, - refresh = 0 - ) - model_performance(model) -} +model <- rstanarm::stan_glm( + mpg ~ wt + cyl, + data = mtcars, + chains = 1, + iter = 500, + refresh = 0 +) +model_performance(model) -if (require("BayesFactor") && require("rstantools")) { - model <- generalTestBF(carb ~ am + mpg, mtcars) +model <- stan_glmer( + mpg ~ wt + cyl + (1 | gear), + data = mtcars, + chains = 1, + iter = 500, + refresh = 0 +) +model_performance(model) - model_performance(model) - model_performance(model[3]) +model <- generalTestBF(carb ~ am + mpg, mtcars) - model_performance(model, average = TRUE) -} +model_performance(model) +model_performance(model[3]) +model_performance(model, average = TRUE) } +\dontshow{\}) # examplesIf} } \references{ Gelman, A., Goodrich, B., Gabry, J., and Vehtari, A. (2018). From 0781788ec9aa09ab4fb3db2a1b987fee039fc384 Mon Sep 17 00:00:00 2001 From: Daniel Date: Thu, 14 Sep 2023 19:08:49 +0200 Subject: [PATCH 05/11] desc --- DESCRIPTION | 1 + 1 file changed, 1 insertion(+) diff --git a/DESCRIPTION b/DESCRIPTION index ac07c230d..207bfa69b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -86,6 +86,7 @@ Suggests: boot, brms, car, + carData, CompQuadForm, correlation, cplm, From bac16db1615016a4e1b4d210f590d3a2110de5c8 Mon Sep 17 00:00:00 2001 From: Daniel Date: Thu, 14 Sep 2023 20:05:18 +0200 Subject: [PATCH 06/11] fix example --- R/check_model.R | 5 ----- man/check_model.Rd | 5 ----- 2 files changed, 10 deletions(-) diff --git a/R/check_model.R b/R/check_model.R index 8f0ae0d5e..c24da4903 100644 --- a/R/check_model.R +++ b/R/check_model.R @@ -149,11 +149,6 @@ #' m <- lmer(Reaction ~ Days + (Days | Subject), sleepstudy) #' check_model(m, panel = FALSE) #' } -#' -#' if (require("rstanarm")) { -#' m <- stan_glm(mpg ~ wt + gear, data = mtcars, chains = 2, iter = 200) -#' check_model(m) -#' } #' } #' @export check_model <- function(x, ...) { diff --git a/man/check_model.Rd b/man/check_model.Rd index d68e6c65e..6eebeb1e6 100644 --- a/man/check_model.Rd +++ b/man/check_model.Rd @@ -214,11 +214,6 @@ if (require("lme4")) { m <- lmer(Reaction ~ Days + (Days | Subject), sleepstudy) check_model(m, panel = FALSE) } - -if (require("rstanarm")) { - m <- stan_glm(mpg ~ wt + gear, data = mtcars, chains = 2, iter = 200) - check_model(m) -} } } \seealso{ From dde7686d12045392f8e651cae861a9ef5a69b197 Mon Sep 17 00:00:00 2001 From: Daniel Date: Thu, 14 Sep 2023 20:24:49 +0200 Subject: [PATCH 07/11] suppress warnings --- R/check_symmetry.R | 2 +- man/check_symmetry.Rd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/check_symmetry.R b/R/check_symmetry.R index 9178e82c5..dbe77dac9 100644 --- a/R/check_symmetry.R +++ b/R/check_symmetry.R @@ -9,7 +9,7 @@ #' @param ... Not used. #' #' @examples -#' V <- wilcox.test(mtcars$mpg) +#' V <- suppressWarnings(wilcox.test(mtcars$mpg)) #' check_symmetry(V) #' #' @export diff --git a/man/check_symmetry.Rd b/man/check_symmetry.Rd index 99ee8953b..cb58d41d6 100644 --- a/man/check_symmetry.Rd +++ b/man/check_symmetry.Rd @@ -18,7 +18,7 @@ nonparametric skew (\eqn{\frac{(Mean - Median)}{SD}}) is different than 0. This is an underlying assumption of Wilcoxon signed-rank test. } \examples{ -V <- wilcox.test(mtcars$mpg) +V <- suppressWarnings(wilcox.test(mtcars$mpg)) check_symmetry(V) } From a4cabd8b65c6a3208ad0c581e17bf99b913788bc Mon Sep 17 00:00:00 2001 From: Daniel Date: Thu, 14 Sep 2023 20:36:23 +0200 Subject: [PATCH 08/11] lintr --- R/check_distribution.R | 34 +++++++++++++++++----------------- R/icc.R | 4 ++-- R/model_performance.bayesian.R | 2 +- 3 files changed, 20 insertions(+), 20 deletions(-) diff --git a/R/check_distribution.R b/R/check_distribution.R index 77cc19db6..fed30eb1f 100644 --- a/R/check_distribution.R +++ b/R/check_distribution.R @@ -192,23 +192,23 @@ check_distribution.numeric <- function(model) { x <- x[!is.na(x)] data.frame( - "SD" = stats::sd(x), - "MAD" = stats::mad(x, constant = 1), - "Mean_Median_Distance" = mean(x) - stats::median(x), - "Mean_Mode_Distance" = mean(x) - as.numeric(bayestestR::map_estimate(x, bw = "nrd0")), - "SD_MAD_Distance" = stats::sd(x) - stats::mad(x, constant = 1), - "Var_Mean_Distance" = stats::var(x) - mean(x), - "Range_SD" = diff(range(x)) / stats::sd(x), - "Range" = diff(range(x)), - "IQR" = stats::IQR(x), - "Skewness" = .skewness(x), - "Kurtosis" = .kurtosis(x), - "Uniques" = length(unique(x)) / length(x), - "N_Uniques" = length(unique(x)), - "Min" = min(x), - "Max" = max(x), - "Proportion_Positive" = sum(x >= 0) / length(x), - "Integer" = all(.is_integer(x)) + SD = stats::sd(x), + MAD = stats::mad(x, constant = 1), + Mean_Median_Distance = mean(x) - stats::median(x), + Mean_Mode_Distance = mean(x) - as.numeric(bayestestR::map_estimate(x, bw = "nrd0")), + SD_MAD_Distance = stats::sd(x) - stats::mad(x, constant = 1), + Var_Mean_Distance = stats::var(x) - mean(x), + Range_SD = diff(range(x)) / stats::sd(x), + Range = diff(range(x)), + IQR = stats::IQR(x), + Skewness = .skewness(x), + Kurtosis = .kurtosis(x), + Uniques = length(unique(x)) / length(x), + N_Uniques = length(unique(x)), + Min = min(x), + Max = max(x), + Proportion_Positive = sum(x >= 0) / length(x), + Integer = all(.is_integer(x)) ) } diff --git a/R/icc.R b/R/icc.R index 9155a7f40..16821e85f 100644 --- a/R/icc.R +++ b/R/icc.R @@ -353,8 +353,8 @@ variance_decomposition <- function(model, result <- structure( class = "icc_decomposed", list( - "ICC_decomposed" = 1 - fun(var_icc), - "ICC_CI" = ci_icc + ICC_decomposed = 1 - fun(var_icc), + ICC_CI = ci_icc ) ) diff --git a/R/model_performance.bayesian.R b/R/model_performance.bayesian.R index 64b227011..576c8abcd 100644 --- a/R/model_performance.bayesian.R +++ b/R/model_performance.bayesian.R @@ -253,7 +253,7 @@ model_performance.BFBayesFactor <- function(model, out <- list() attri <- list() - if ("R2" %in% c(metrics)) { + if ("R2" %in% metrics) { r2 <- r2_bayes(model, average = average, prior_odds = prior_odds, verbose = verbose) attri$r2_bayes <- attributes(r2) # save attributes From 99892bb1293051778f2aa728bd63bd8df2931398 Mon Sep 17 00:00:00 2001 From: Daniel Date: Thu, 14 Sep 2023 20:52:44 +0200 Subject: [PATCH 09/11] lintr, examples --- R/r2_bayes.R | 8 +++++--- R/r2_loo.R | 8 +++++--- man/r2_bayes.Rd | 4 +++- man/r2_loo.Rd | 8 +++++--- 4 files changed, 18 insertions(+), 10 deletions(-) diff --git a/R/r2_bayes.R b/R/r2_bayes.R index cbdec33d5..1db20f827 100644 --- a/R/r2_bayes.R +++ b/R/r2_bayes.R @@ -33,7 +33,9 @@ #' @examples #' library(performance) #' if (require("rstanarm") && require("rstantools")) { -#' model <- stan_glm(mpg ~ wt + cyl, data = mtcars, chains = 1, iter = 500, refresh = 0) +#' model <- suppressWarnings( +#' stan_glm(mpg ~ wt + cyl, data = mtcars, chains = 1, iter = 500, refresh = 0) +#' ) #' r2_bayes(model) #' #' model <- stan_lmer( @@ -424,10 +426,10 @@ as.data.frame.r2_bayes <- function(x, ...) { residuals.BFBayesFactor <- function(object, ...) { everything_we_need <- .get_bfbf_predictions(object, verbose = FALSE) - everything_we_need[["y"]] - apply(everything_we_need[["y_pred"]], 2, mean) + everything_we_need[["y"]] - colMeans(everything_we_need[["y_pred"]]) } #' @export fitted.BFBayesFactor <- function(object, ...) { - apply(.get_bfbf_predictions(object, verbose = FALSE)[["y_pred"]], 2, mean) + colMeans(.get_bfbf_predictions(object, verbose = FALSE)[["y_pred"]]) } diff --git a/R/r2_loo.R b/R/r2_loo.R index 1460d21d9..c62d39c25 100644 --- a/R/r2_loo.R +++ b/R/r2_loo.R @@ -20,9 +20,9 @@ #' leave-one-out-adjusted posterior distribution. This is conceptually similar #' to an adjusted/unbiased R2 estimate in classical regression modeling. See #' [r2_bayes()] for an "unadjusted" R2. -#' \cr \cr +#' #' Mixed models are not currently fully supported. -#' \cr \cr +#' #' `r2_loo_posterior()` is the actual workhorse for `r2_loo()` and #' returns a posterior sample of LOO-adjusted Bayesian R2 values. #' @@ -31,7 +31,9 @@ #' #' @examples #' if (require("rstanarm")) { -#' model <- stan_glm(mpg ~ wt + cyl, data = mtcars, chains = 1, iter = 500, refresh = 0) +#' model <- suppressWarnings( +#' stan_glm(mpg ~ wt + cyl, data = mtcars, chains = 1, iter = 500, refresh = 0) +#' ) #' r2_loo(model) #' } #' @export diff --git a/man/r2_bayes.Rd b/man/r2_bayes.Rd index 9f1531225..298792930 100644 --- a/man/r2_bayes.Rd +++ b/man/r2_bayes.Rd @@ -64,7 +64,9 @@ returns a posterior sample of Bayesian R2 values. \examples{ library(performance) if (require("rstanarm") && require("rstantools")) { - model <- stan_glm(mpg ~ wt + cyl, data = mtcars, chains = 1, iter = 500, refresh = 0) + model <- suppressWarnings( + stan_glm(mpg ~ wt + cyl, data = mtcars, chains = 1, iter = 500, refresh = 0) + ) r2_bayes(model) model <- stan_lmer( diff --git a/man/r2_loo.Rd b/man/r2_loo.Rd index 18d8b106e..cd28fb483 100644 --- a/man/r2_loo.Rd +++ b/man/r2_loo.Rd @@ -45,15 +45,17 @@ Compute LOO-adjusted R2. leave-one-out-adjusted posterior distribution. This is conceptually similar to an adjusted/unbiased R2 estimate in classical regression modeling. See \code{\link[=r2_bayes]{r2_bayes()}} for an "unadjusted" R2. -\cr \cr + Mixed models are not currently fully supported. -\cr \cr + \code{r2_loo_posterior()} is the actual workhorse for \code{r2_loo()} and returns a posterior sample of LOO-adjusted Bayesian R2 values. } \examples{ if (require("rstanarm")) { - model <- stan_glm(mpg ~ wt + cyl, data = mtcars, chains = 1, iter = 500, refresh = 0) + model <- suppressWarnings( + stan_glm(mpg ~ wt + cyl, data = mtcars, chains = 1, iter = 500, refresh = 0) + ) r2_loo(model) } } From 9a6ead40d9e2c33f5fbd7168b3c580b8df28c283 Mon Sep 17 00:00:00 2001 From: Daniel Date: Thu, 14 Sep 2023 22:03:17 +0200 Subject: [PATCH 10/11] suppress warnings? --- R/r2_bayes.R | 11 ++++++++--- R/r2_loo.R | 11 ++++++++--- man/r2_bayes.Rd | 11 ++++++++--- man/r2_loo.Rd | 11 ++++++++--- 4 files changed, 32 insertions(+), 12 deletions(-) diff --git a/R/r2_bayes.R b/R/r2_bayes.R index 1db20f827..506c4dde6 100644 --- a/R/r2_bayes.R +++ b/R/r2_bayes.R @@ -33,9 +33,14 @@ #' @examples #' library(performance) #' if (require("rstanarm") && require("rstantools")) { -#' model <- suppressWarnings( -#' stan_glm(mpg ~ wt + cyl, data = mtcars, chains = 1, iter = 500, refresh = 0) -#' ) +#' model <- suppressWarnings(stan_glm( +#' mpg ~ wt + cyl, +#' data = mtcars, +#' chains = 1, +#' iter = 500, +#' refresh = 0, +#' show_messages = FALSE +#' )) #' r2_bayes(model) #' #' model <- stan_lmer( diff --git a/R/r2_loo.R b/R/r2_loo.R index c62d39c25..857e3834c 100644 --- a/R/r2_loo.R +++ b/R/r2_loo.R @@ -31,9 +31,14 @@ #' #' @examples #' if (require("rstanarm")) { -#' model <- suppressWarnings( -#' stan_glm(mpg ~ wt + cyl, data = mtcars, chains = 1, iter = 500, refresh = 0) -#' ) +#' model <- suppressWarnings(stan_glm( +#' mpg ~ wt + cyl, +#' data = mtcars, +#' chains = 1, +#' iter = 500, +#' refresh = 0, +#' show_messages = FALSE +#' )) #' r2_loo(model) #' } #' @export diff --git a/man/r2_bayes.Rd b/man/r2_bayes.Rd index 298792930..f78f38bf6 100644 --- a/man/r2_bayes.Rd +++ b/man/r2_bayes.Rd @@ -64,9 +64,14 @@ returns a posterior sample of Bayesian R2 values. \examples{ library(performance) if (require("rstanarm") && require("rstantools")) { - model <- suppressWarnings( - stan_glm(mpg ~ wt + cyl, data = mtcars, chains = 1, iter = 500, refresh = 0) - ) + model <- suppressWarnings(stan_glm( + mpg ~ wt + cyl, + data = mtcars, + chains = 1, + iter = 500, + refresh = 0, + show_messages = FALSE + )) r2_bayes(model) model <- stan_lmer( diff --git a/man/r2_loo.Rd b/man/r2_loo.Rd index cd28fb483..c418ab359 100644 --- a/man/r2_loo.Rd +++ b/man/r2_loo.Rd @@ -53,9 +53,14 @@ returns a posterior sample of LOO-adjusted Bayesian R2 values. } \examples{ if (require("rstanarm")) { - model <- suppressWarnings( - stan_glm(mpg ~ wt + cyl, data = mtcars, chains = 1, iter = 500, refresh = 0) - ) + model <- suppressWarnings(stan_glm( + mpg ~ wt + cyl, + data = mtcars, + chains = 1, + iter = 500, + refresh = 0, + show_messages = FALSE + )) r2_loo(model) } } From a85fa62a1f91bcb9348a6acf4850fa9f094ed1bc Mon Sep 17 00:00:00 2001 From: Daniel Date: Thu, 14 Sep 2023 22:11:55 +0200 Subject: [PATCH 11/11] examplesIf --- R/check_model.R | 9 ++- R/check_normality.R | 9 ++- R/check_zeroinflation.R | 10 ++- R/compare_performance.R | 12 ++-- R/model_performance.lavaan.R | 111 ++++++++++++++++---------------- R/model_performance.rma.R | 19 ++++-- R/r2.R | 8 +-- R/r2_loo.R | 22 +++---- man/check_model.Rd | 9 +-- man/check_normality.Rd | 9 +-- man/check_zeroinflation.Rd | 10 +-- man/compare_performance.Rd | 12 ++-- man/model_performance.lavaan.Rd | 26 ++++---- man/model_performance.rma.Rd | 19 ++++-- man/r2.Rd | 8 +-- man/r2_loo.Rd | 22 +++---- 16 files changed, 161 insertions(+), 154 deletions(-) diff --git a/R/check_model.R b/R/check_model.R index c24da4903..2994455fe 100644 --- a/R/check_model.R +++ b/R/check_model.R @@ -140,15 +140,14 @@ #' #' @family functions to check model assumptions and and assess model quality #' -#' @examples +#' @examplesIf require("lme4") #' \dontrun{ #' m <- lm(mpg ~ wt + cyl + gear + disp, data = mtcars) #' check_model(m) #' -#' if (require("lme4")) { -#' m <- lmer(Reaction ~ Days + (Days | Subject), sleepstudy) -#' check_model(m, panel = FALSE) -#' } +#' data(sleepstudy, package = "lme4") +#' m <- lme4::lmer(Reaction ~ Days + (Days | Subject), sleepstudy) +#' check_model(m, panel = FALSE) #' } #' @export check_model <- function(x, ...) { diff --git a/R/check_normality.R b/R/check_normality.R index b5b658b5e..ff7ce29c4 100644 --- a/R/check_normality.R +++ b/R/check_normality.R @@ -27,15 +27,14 @@ #' standardized deviance residuals is shown (in line with changes in #' `plot.lm()` for R 4.3+). #' -#' @examples +#' @examplesIf require("see") #' m <<- lm(mpg ~ wt + cyl + gear + disp, data = mtcars) #' check_normality(m) #' #' # plot results -#' if (require("see")) { -#' x <- check_normality(m) -#' plot(x) -#' } +#' x <- check_normality(m) +#' plot(x) +#' #' \dontrun{ #' # QQ-plot #' plot(check_normality(m), type = "qq") diff --git a/R/check_zeroinflation.R b/R/check_zeroinflation.R index fbf399939..f0f19b369 100644 --- a/R/check_zeroinflation.R +++ b/R/check_zeroinflation.R @@ -21,12 +21,10 @@ #' #' @family functions to check model assumptions and and assess model quality #' -#' @examples -#' if (require("glmmTMB")) { -#' data(Salamanders) -#' m <- glm(count ~ spp + mined, family = poisson, data = Salamanders) -#' check_zeroinflation(m) -#' } +#' @examplesIf require("glmmTMB") +#' data(Salamanders, package = "glmmTMB") +#' m <- glm(count ~ spp + mined, family = poisson, data = Salamanders) +#' check_zeroinflation(m) #' @export check_zeroinflation <- function(x, tolerance = 0.05) { # check if we have poisson diff --git a/R/compare_performance.R b/R/compare_performance.R index ca1dcf9ff..76b0b329f 100644 --- a/R/compare_performance.R +++ b/R/compare_performance.R @@ -70,7 +70,7 @@ #' _Model selection and multimodel inference: A practical information-theoretic approach_ (2nd ed.). #' Springer-Verlag. \doi{10.1007/b97636} #' -#' @examples +#' @examplesIf require("lme4") #' data(iris) #' lm1 <- lm(Sepal.Length ~ Species, data = iris) #' lm2 <- lm(Sepal.Length ~ Species + Petal.Length, data = iris) @@ -78,12 +78,10 @@ #' compare_performance(lm1, lm2, lm3) #' compare_performance(lm1, lm2, lm3, rank = TRUE) #' -#' if (require("lme4")) { -#' m1 <- lm(mpg ~ wt + cyl, data = mtcars) -#' m2 <- glm(vs ~ wt + mpg, data = mtcars, family = "binomial") -#' m3 <- lmer(Petal.Length ~ Sepal.Length + (1 | Species), data = iris) -#' compare_performance(m1, m2, m3) -#' } +#' m1 <- lm(mpg ~ wt + cyl, data = mtcars) +#' m2 <- glm(vs ~ wt + mpg, data = mtcars, family = "binomial") +#' m3 <- lme4::lmer(Petal.Length ~ Sepal.Length + (1 | Species), data = iris) +#' compare_performance(m1, m2, m3) #' @inheritParams model_performance.lm #' @export compare_performance <- function(..., metrics = "all", rank = FALSE, estimator = "ML", verbose = TRUE) { diff --git a/R/model_performance.lavaan.R b/R/model_performance.lavaan.R index 9822c1c2b..050dbd473 100644 --- a/R/model_performance.lavaan.R +++ b/R/model_performance.lavaan.R @@ -1,15 +1,15 @@ #' Performance of lavaan SEM / CFA Models #' #' Compute indices of model performance for SEM or CFA models from the -#' \pkg{lavaan} package. +#' **lavaan** package. #' -#' @param model A \pkg{lavaan} model. +#' @param model A **lavaan** model. #' @param metrics Can be `"all"` or a character vector of metrics to be -#' computed (some of `c("Chi2", "Chi2_df", "p_Chi2", "Baseline", -#' "Baseline_df", "p_Baseline", "GFI", "AGFI", "NFI", "NNFI", "CFI", -#' "RMSEA", "RMSEA_CI_low", "RMSEA_CI_high", "p_RMSEA", "RMR", "SRMR", -#' "RFI", "PNFI", "IFI", "RNI", "Loglikelihood", "AIC", "BIC", -#' "BIC_adjusted")`). +#' computed (some of `"Chi2"`, `"Chi2_df"`, `"p_Chi2"`, `"Baseline"`, +#' `"Baseline_df"`, `"p_Baseline"`, `"GFI"`, `"AGFI"`, `"NFI"`, `"NNFI"`, +#' `"CFI"`, `"RMSEA"`, `"RMSEA_CI_low"`, `"RMSEA_CI_high"`, `"p_RMSEA"`, +#' `"RMR"`, `"SRMR"`, `"RFI"`, `"PNFI"`, `"IFI"`, `"RNI"`, `"Loglikelihood"`, +#' `"AIC"`, `"BIC"`, and `"BIC_adjusted"`. #' @param verbose Toggle off warnings. #' @param ... Arguments passed to or from other methods. #' @@ -70,15 +70,14 @@ #' and the **SRMR**. #' } #' -#' @examples +#' @examplesIf require("lavaan") #' # Confirmatory Factor Analysis (CFA) --------- -#' if (require("lavaan")) { -#' structure <- " visual =~ x1 + x2 + x3 -#' textual =~ x4 + x5 + x6 -#' speed =~ x7 + x8 + x9 " -#' model <- lavaan::cfa(structure, data = HolzingerSwineford1939) -#' model_performance(model) -#' } +#' data(HolzingerSwineford1939, package = "lavaan") +#' structure <- " visual =~ x1 + x2 + x3 +#' textual =~ x4 + x5 + x6 +#' speed =~ x7 + x8 + x9 " +#' model <- lavaan::cfa(structure, data = HolzingerSwineford1939) +#' model_performance(model) #' #' @references #' @@ -113,31 +112,31 @@ model_performance.lavaan <- function(model, metrics = "all", verbose = TRUE, ... row.names(measures) <- NULL out <- data.frame( - "Chi2" = measures$chisq, - "Chi2_df" = measures$df, - "p_Chi2" = measures$pvalue, - "Baseline" = measures$baseline.chisq, - "Baseline_df" = measures$baseline.df, - "p_Baseline" = measures$baseline.pvalue, - "GFI" = measures$gfi, - "AGFI" = measures$agfi, - "NFI" = measures$nfi, - "NNFI" = measures$tli, - "CFI" = measures$cfi, - "RMSEA" = measures$rmsea, - "RMSEA_CI_low" = measures$rmsea.ci.lower, - "RMSEA_CI_high" = measures$rmsea.ci.upper, - "p_RMSEA" = measures$rmsea.pvalue, - "RMR" = measures$rmr, - "SRMR" = measures$srmr, - "RFI" = measures$rfi, - "PNFI" = measures$pnfi, - "IFI" = measures$ifi, - "RNI" = measures$rni, - "Loglikelihood" = measures$logl, - "AIC" = measures$aic, - "BIC" = measures$bic, - "BIC_adjusted" = measures$bic2 + Chi2 = measures$chisq, + Chi2_df = measures$df, + p_Chi2 = measures$pvalue, + Baseline = measures$baseline.chisq, + Baseline_df = measures$baseline.df, + p_Baseline = measures$baseline.pvalue, + GFI = measures$gfi, + AGFI = measures$agfi, + NFI = measures$nfi, + NNFI = measures$tli, + CFI = measures$cfi, + RMSEA = measures$rmsea, + RMSEA_CI_low = measures$rmsea.ci.lower, + RMSEA_CI_high = measures$rmsea.ci.upper, + p_RMSEA = measures$rmsea.pvalue, + RMR = measures$rmr, + SRMR = measures$srmr, + RFI = measures$rfi, + PNFI = measures$pnfi, + IFI = measures$ifi, + RNI = measures$rni, + Loglikelihood = measures$logl, + AIC = measures$aic, + BIC = measures$bic, + BIC_adjusted = measures$bic2 ) if (all(metrics == "all")) { @@ -167,22 +166,22 @@ model_performance.blavaan <- function(model, metrics = "all", verbose = TRUE, .. row.names(measures) <- NULL out <- data.frame( - "BRMSEA" = fitind[1, "EAP"], - "SD_BRMSEA" = fitind[1, "SD"], - "BGammaHat" = fitind[2, "EAP"], - "SD_BGammaHat" = fitind[2, "SD"], - "Adj_BGammaHat" = fitind[3, "EAP"], - "SD_Adj_BGammaHat" = fitind[3, "SD"], - "Loglikelihood" = measures$logl, - "BIC" = measures$bic, - "DIC" = measures$dic, - "p_DIC" = measures$p_dic, - "WAIC" = measures$waic, - "SE_WAIC" = measures$se_waic, - "p_WAIC" = measures$p_waic, - "LOOIC" = measures$looic, - "SE_LOOIC" = measures$se_loo, - "p_LOOIC" = measures$p_loo + BRMSEA = fitind[1, "EAP"], + SD_BRMSEA = fitind[1, "SD"], + BGammaHat = fitind[2, "EAP"], + SD_BGammaHat = fitind[2, "SD"], + Adj_BGammaHat = fitind[3, "EAP"], + SD_Adj_BGammaHat = fitind[3, "SD"], + Loglikelihood = measures$logl, + BIC = measures$bic, + DIC = measures$dic, + p_DIC = measures$p_dic, + WAIC = measures$waic, + SE_WAIC = measures$se_waic, + p_WAIC = measures$p_waic, + LOOIC = measures$looic, + SE_LOOIC = measures$se_loo, + p_LOOIC = measures$p_loo ) if (all(metrics == "all")) { diff --git a/R/model_performance.rma.R b/R/model_performance.rma.R index 2730e5e5b..167eb75bb 100644 --- a/R/model_performance.rma.R +++ b/R/model_performance.rma.R @@ -47,13 +47,18 @@ #' See the documentation for `?metafor::fitstats`. #' } #' -#' @examples -#' if (require("metafor")) { -#' data(dat.bcg) -#' dat <- escalc(measure = "RR", ai = tpos, bi = tneg, ci = cpos, di = cneg, data = dat.bcg) -#' model <- rma(yi, vi, data = dat, method = "REML") -#' model_performance(model) -#' } +#' @examplesIf require("metafor") +#' data(dat.bcg, package = "metafor") +#' dat <- metafor::escalc( +#' measure = "RR", +#' ai = tpos, +#' bi = tneg, +#' ci = cpos, +#' di = cneg, +#' data = dat.bcg +#' ) +#' model <- metafor::rma(yi, vi, data = dat, method = "REML") +#' model_performance(model) #' @export model_performance.rma <- function(model, metrics = "all", estimator = "ML", verbose = TRUE, ...) { if (all(metrics == "all")) { diff --git a/R/r2.R b/R/r2.R index baf3a18a0..26a16f9e6 100644 --- a/R/r2.R +++ b/R/r2.R @@ -32,7 +32,7 @@ #' [`r2_nakagawa()`], [`r2_tjur()`], [`r2_xu()`] and #' [`r2_zeroinflated()`]. #' -#' @examples +#' @examplesIf require("lme4") #' # Pseudo r-quared for GLM #' model <- glm(vs ~ wt + mpg, data = mtcars, family = "binomial") #' r2(model) @@ -41,10 +41,8 @@ #' model <- lm(mpg ~ wt + hp, data = mtcars) #' r2(model, ci = 0.95) #' -#' if (require("lme4")) { -#' model <- lmer(Sepal.Length ~ Petal.Length + (1 | Species), data = iris) -#' r2(model) -#' } +#' model <- lme4::lmer(Sepal.Length ~ Petal.Length + (1 | Species), data = iris) +#' r2(model) #' @export r2 <- function(model, ...) { UseMethod("r2") diff --git a/R/r2_loo.R b/R/r2_loo.R index 857e3834c..040d9b572 100644 --- a/R/r2_loo.R +++ b/R/r2_loo.R @@ -29,18 +29,16 @@ #' @return A list with the LOO-adjusted R2 value. The standard errors #' and credible intervals for the R2 values are saved as attributes. #' -#' @examples -#' if (require("rstanarm")) { -#' model <- suppressWarnings(stan_glm( -#' mpg ~ wt + cyl, -#' data = mtcars, -#' chains = 1, -#' iter = 500, -#' refresh = 0, -#' show_messages = FALSE -#' )) -#' r2_loo(model) -#' } +#' @examplesIf require("rstanarm") && require("rstantools") +#' model <- suppressWarnings(rstanarm::stan_glm( +#' mpg ~ wt + cyl, +#' data = mtcars, +#' chains = 1, +#' iter = 500, +#' refresh = 0, +#' show_messages = FALSE +#' )) +#' r2_loo(model) #' @export r2_loo <- function(model, robust = TRUE, ci = 0.95, verbose = TRUE, ...) { loo_r2 <- r2_loo_posterior(model, verbose = verbose, ...) diff --git a/man/check_model.Rd b/man/check_model.Rd index 6eebeb1e6..309fe1046 100644 --- a/man/check_model.Rd +++ b/man/check_model.Rd @@ -206,15 +206,16 @@ skipped, which also increases performance. } \examples{ +\dontshow{if (require("lme4")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} \dontrun{ m <- lm(mpg ~ wt + cyl + gear + disp, data = mtcars) check_model(m) -if (require("lme4")) { - m <- lmer(Reaction ~ Days + (Days | Subject), sleepstudy) - check_model(m, panel = FALSE) -} +data(sleepstudy, package = "lme4") +m <- lme4::lmer(Reaction ~ Days + (Days | Subject), sleepstudy) +check_model(m, panel = FALSE) } +\dontshow{\}) # examplesIf} } \seealso{ Other functions to check model assumptions and and assess model quality: diff --git a/man/check_normality.Rd b/man/check_normality.Rd index b6591cc1d..93a259e99 100644 --- a/man/check_normality.Rd +++ b/man/check_normality.Rd @@ -43,14 +43,14 @@ standardized residuals, are used for the test. There is also a implemented in the \href{https://easystats.github.io/see/}{\strong{see}-package}. } \examples{ +\dontshow{if (require("see")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} m <<- lm(mpg ~ wt + cyl + gear + disp, data = mtcars) check_normality(m) # plot results -if (require("see")) { - x <- check_normality(m) - plot(x) -} +x <- check_normality(m) +plot(x) + \dontrun{ # QQ-plot plot(check_normality(m), type = "qq") @@ -58,4 +58,5 @@ plot(check_normality(m), type = "qq") # PP-plot plot(check_normality(m), type = "pp") } +\dontshow{\}) # examplesIf} } diff --git a/man/check_zeroinflation.Rd b/man/check_zeroinflation.Rd index d0a62a76c..db9eddd23 100644 --- a/man/check_zeroinflation.Rd +++ b/man/check_zeroinflation.Rd @@ -30,11 +30,11 @@ zero-inflation in the data. In such cases, it is recommended to use negative binomial or zero-inflated models. } \examples{ -if (require("glmmTMB")) { - data(Salamanders) - m <- glm(count ~ spp + mined, family = poisson, data = Salamanders) - check_zeroinflation(m) -} +\dontshow{if (require("glmmTMB")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +data(Salamanders, package = "glmmTMB") +m <- glm(count ~ spp + mined, family = poisson, data = Salamanders) +check_zeroinflation(m) +\dontshow{\}) # examplesIf} } \seealso{ Other functions to check model assumptions and and assess model quality: diff --git a/man/compare_performance.Rd b/man/compare_performance.Rd index cfa80eda0..30c324351 100644 --- a/man/compare_performance.Rd +++ b/man/compare_performance.Rd @@ -91,6 +91,7 @@ same (AIC/...) values as from the defaults in \code{AIC.merMod()}. There is also a \href{https://easystats.github.io/see/articles/performance.html}{\code{plot()}-method} implemented in the \href{https://easystats.github.io/see/}{\pkg{see}-package}. } \examples{ +\dontshow{if (require("lme4")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} data(iris) lm1 <- lm(Sepal.Length ~ Species, data = iris) lm2 <- lm(Sepal.Length ~ Species + Petal.Length, data = iris) @@ -98,12 +99,11 @@ lm3 <- lm(Sepal.Length ~ Species * Petal.Length, data = iris) compare_performance(lm1, lm2, lm3) compare_performance(lm1, lm2, lm3, rank = TRUE) -if (require("lme4")) { - m1 <- lm(mpg ~ wt + cyl, data = mtcars) - m2 <- glm(vs ~ wt + mpg, data = mtcars, family = "binomial") - m3 <- lmer(Petal.Length ~ Sepal.Length + (1 | Species), data = iris) - compare_performance(m1, m2, m3) -} +m1 <- lm(mpg ~ wt + cyl, data = mtcars) +m2 <- glm(vs ~ wt + mpg, data = mtcars, family = "binomial") +m3 <- lme4::lmer(Petal.Length ~ Sepal.Length + (1 | Species), data = iris) +compare_performance(m1, m2, m3) +\dontshow{\}) # examplesIf} } \references{ Burnham, K. P., and Anderson, D. R. (2002). diff --git a/man/model_performance.lavaan.Rd b/man/model_performance.lavaan.Rd index 9ac05771f..b65e9d0f0 100644 --- a/man/model_performance.lavaan.Rd +++ b/man/model_performance.lavaan.Rd @@ -7,10 +7,14 @@ \method{model_performance}{lavaan}(model, metrics = "all", verbose = TRUE, ...) } \arguments{ -\item{model}{A \pkg{lavaan} model.} +\item{model}{A \strong{lavaan} model.} \item{metrics}{Can be \code{"all"} or a character vector of metrics to be -computed (some of \code{c("Chi2", "Chi2_df", "p_Chi2", "Baseline", "Baseline_df", "p_Baseline", "GFI", "AGFI", "NFI", "NNFI", "CFI", "RMSEA", "RMSEA_CI_low", "RMSEA_CI_high", "p_RMSEA", "RMR", "SRMR", "RFI", "PNFI", "IFI", "RNI", "Loglikelihood", "AIC", "BIC", "BIC_adjusted")}).} +computed (some of \code{"Chi2"}, \code{"Chi2_df"}, \code{"p_Chi2"}, \code{"Baseline"}, +\code{"Baseline_df"}, \code{"p_Baseline"}, \code{"GFI"}, \code{"AGFI"}, \code{"NFI"}, \code{"NNFI"}, +\code{"CFI"}, \code{"RMSEA"}, \code{"RMSEA_CI_low"}, \code{"RMSEA_CI_high"}, \code{"p_RMSEA"}, +\code{"RMR"}, \code{"SRMR"}, \code{"RFI"}, \code{"PNFI"}, \code{"IFI"}, \code{"RNI"}, \code{"Loglikelihood"}, +\code{"AIC"}, \code{"BIC"}, and \code{"BIC_adjusted"}.} \item{verbose}{Toggle off warnings.} @@ -22,7 +26,7 @@ A data frame (with one row) and one column per "index" (see } \description{ Compute indices of model performance for SEM or CFA models from the -\pkg{lavaan} package. +\strong{lavaan} package. } \details{ \subsection{Indices of fit}{ @@ -73,15 +77,15 @@ and the \strong{SRMR}. } } \examples{ +\dontshow{if (require("lavaan")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} # Confirmatory Factor Analysis (CFA) --------- -if (require("lavaan")) { - structure <- " visual =~ x1 + x2 + x3 - textual =~ x4 + x5 + x6 - speed =~ x7 + x8 + x9 " - model <- lavaan::cfa(structure, data = HolzingerSwineford1939) - model_performance(model) -} - +data(HolzingerSwineford1939, package = "lavaan") +structure <- " visual =~ x1 + x2 + x3 + textual =~ x4 + x5 + x6 + speed =~ x7 + x8 + x9 " +model <- lavaan::cfa(structure, data = HolzingerSwineford1939) +model_performance(model) +\dontshow{\}) # examplesIf} } \references{ \itemize{ diff --git a/man/model_performance.rma.Rd b/man/model_performance.rma.Rd index 7ace733b1..9f2db24b5 100644 --- a/man/model_performance.rma.Rd +++ b/man/model_performance.rma.Rd @@ -65,10 +65,17 @@ See the documentation for \code{?metafor::fitstats}. } } \examples{ -if (require("metafor")) { - data(dat.bcg) - dat <- escalc(measure = "RR", ai = tpos, bi = tneg, ci = cpos, di = cneg, data = dat.bcg) - model <- rma(yi, vi, data = dat, method = "REML") - model_performance(model) -} +\dontshow{if (require("metafor")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +data(dat.bcg, package = "metafor") +dat <- metafor::escalc( + measure = "RR", + ai = tpos, + bi = tneg, + ci = cpos, + di = cneg, + data = dat.bcg +) +model <- metafor::rma(yi, vi, data = dat, method = "REML") +model_performance(model) +\dontshow{\}) # examplesIf} } diff --git a/man/r2.Rd b/man/r2.Rd index 45169aef2..9c5c648c3 100644 --- a/man/r2.Rd +++ b/man/r2.Rd @@ -54,6 +54,7 @@ If there is no \code{r2()}-method defined for the given model class, \verb{1-sum((y-y_hat)^2)/sum((y-y_bar)^2))} } \examples{ +\dontshow{if (require("lme4")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} # Pseudo r-quared for GLM model <- glm(vs ~ wt + mpg, data = mtcars, family = "binomial") r2(model) @@ -62,10 +63,9 @@ r2(model) model <- lm(mpg ~ wt + hp, data = mtcars) r2(model, ci = 0.95) -if (require("lme4")) { - model <- lmer(Sepal.Length ~ Petal.Length + (1 | Species), data = iris) - r2(model) -} +model <- lme4::lmer(Sepal.Length ~ Petal.Length + (1 | Species), data = iris) +r2(model) +\dontshow{\}) # examplesIf} } \seealso{ \code{\link[=r2_bayes]{r2_bayes()}}, \code{\link[=r2_coxsnell]{r2_coxsnell()}}, \code{\link[=r2_kullback]{r2_kullback()}}, diff --git a/man/r2_loo.Rd b/man/r2_loo.Rd index c418ab359..e6592e08c 100644 --- a/man/r2_loo.Rd +++ b/man/r2_loo.Rd @@ -52,15 +52,15 @@ Mixed models are not currently fully supported. returns a posterior sample of LOO-adjusted Bayesian R2 values. } \examples{ -if (require("rstanarm")) { - model <- suppressWarnings(stan_glm( - mpg ~ wt + cyl, - data = mtcars, - chains = 1, - iter = 500, - refresh = 0, - show_messages = FALSE - )) - r2_loo(model) -} +\dontshow{if (require("rstanarm") && require("rstantools")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +model <- suppressWarnings(rstanarm::stan_glm( + mpg ~ wt + cyl, + data = mtcars, + chains = 1, + iter = 500, + refresh = 0, + show_messages = FALSE +)) +r2_loo(model) +\dontshow{\}) # examplesIf} }