diff --git a/DESCRIPTION b/DESCRIPTION index e868e25b5..b7b67daea 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: insight Title: Easy Access to Model Information for Various Model Objects -Version: 0.19.6 +Version: 0.19.6.1 Authors@R: c(person(given = "Daniel", family = "Lüdecke", @@ -123,6 +123,7 @@ Suggests: gee, geepack, geoR, + ggeffects, GLMMadaptive, glmmTMB, gmnl, @@ -206,3 +207,4 @@ Config/Needs/website: rstudio/bslib, r-lib/pkgdown, easystats/easystatstemplate +Remotes: strengejacke/ggeffects diff --git a/NAMESPACE b/NAMESPACE index dadc4f9a5..d7a18d771 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -608,6 +608,7 @@ S3method(get_parameters,gam) S3method(get_parameters,gamlss) S3method(get_parameters,gamm) S3method(get_parameters,gbm) +S3method(get_parameters,ggcomparisons) S3method(get_parameters,glht) S3method(get_parameters,glimML) S3method(get_parameters,glmm) @@ -816,6 +817,7 @@ S3method(get_statistic,gamm) S3method(get_statistic,garch) S3method(get_statistic,gee) S3method(get_statistic,geeglm) +S3method(get_statistic,ggcomparisons) S3method(get_statistic,glht) S3method(get_statistic,glimML) S3method(get_statistic,glmm) @@ -1314,6 +1316,7 @@ S3method(model_info,gamlss) S3method(model_info,gamm) S3method(model_info,garch) S3method(model_info,gbm) +S3method(model_info,ggcomparisons) S3method(model_info,glht) S3method(model_info,glimML) S3method(model_info,glmm) diff --git a/NEWS.md b/NEWS.md index cfb0b010b..6dc149c6d 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,9 @@ +# insight 0.19.7 + +## General + +* Support for objects of class `ggcomparisons` from `ggeffects::hypothesis_test()`. + # insight 0.19.6 ## General diff --git a/R/find_statistic.R b/R/find_statistic.R index 3b5b8d345..f72fb1968 100644 --- a/R/find_statistic.R +++ b/R/find_statistic.R @@ -120,8 +120,8 @@ find_statistic <- function(x, ...) { "deltaMethod", "DirichletRegModel", "ergm", "feglm", "flexsurvreg", - "gee", "glimML", "glmm", "glmmadmb", "glmmFit", "glmmLasso", "glmmTMB", - "glmx", "gmnl", + "gee", "ggcomparisons", "glimML", "glmm", "glmmadmb", "glmmFit", "glmmLasso", + "glmmTMB", "glmx", "gmnl", "hurdle", "lavaan", "loggammacenslmrob", "logitmfx", "logitor", "logitr", "LORgee", "lrm", "margins", "marginaleffects", "marginaleffects.summary", "metaplus", "mixor", diff --git a/R/get_parameters_others.R b/R/get_parameters_others.R index 83ada7c72..1b536a65b 100644 --- a/R/get_parameters_others.R +++ b/R/get_parameters_others.R @@ -364,3 +364,31 @@ get_parameters.deltaMethod <- function(x, ...) { row.names = NULL ) } + + +#' @export +get_parameters.ggcomparisons <- function(x, merge_parameters = FALSE, ...) { + estimate_pos <- which(colnames(x) == attr(x, "estimate_name")) + params <- x[, seq_len(estimate_pos - 1), drop = FALSE] + + if (isTRUE(merge_parameters) && ncol(params) > 1L) { + r <- apply(params, 1, function(i) paste0(colnames(params), " [", i, "]")) + out <- data.frame( + Parameter = unname(vapply(as.data.frame(r), toString, character(1))), + Estimate = x[[estimate_pos]], + stringsAsFactors = FALSE, + row.names = NULL + ) + } else { + out <- data.frame( + params, + Estimate = x[[estimate_pos]], + stringsAsFactors = FALSE, + row.names = NULL + ) + if (isTRUE(merge_parameters)) { + colnames(out)[1] <- "Parameter" + } + } + text_remove_backticks(out) +} diff --git a/R/get_statistic.R b/R/get_statistic.R index 6856a1ed5..b67a488d1 100644 --- a/R/get_statistic.R +++ b/R/get_statistic.R @@ -1598,6 +1598,33 @@ get_statistic.emm_list <- function(x, ci = 0.95, adjust = "none", ...) { } +#' @export +get_statistic.ggcomparisons <- function(x, merge_parameters = FALSE, ...) { + estimate_pos <- which(colnames(x) == attr(x, "estimate_name")) + if (isTRUE(merge_parameters)) { + params <- get_parameters(x, merge_parameters = TRUE)["Parameter"] + } else { + params <- x[, seq_len(estimate_pos - 1), drop = FALSE] + } + + stat <- .safe(x[[estimate_pos]] / attributes(x)$standard_error) + if (is.null(stat)) { + return(NULL) + } + + out <- data.frame( + params, + Statistic = as.vector(stat), + stringsAsFactors = FALSE, + row.names = NULL + ) + + out <- text_remove_backticks(out) + attr(out, "statistic") <- find_statistic(x) + out +} + + #' @export get_statistic.robmixglm <- function(x, ...) { cs <- stats::coef(summary(x)) diff --git a/R/is_model.R b/R/is_model.R index 4f3417ca4..0ffc11fc7 100644 --- a/R/is_model.R +++ b/R/is_model.R @@ -89,7 +89,7 @@ is_regression_model <- function(x) { "glmaag", "glmbb", "glmboostLSS", "glmc", "glmdm", "glmdisc", "glmerMod", "glmlep", "glmm", "glmmadmb", "glmmEP", "glmmFit", "glmmfields", "glmmLasso", "glmmPQL", "glmmTMB", "glmnet", "glmrob", - "glmRob", "glmx", "gls", "gmnl", "gmm", "gnls", "gsm", + "glmRob", "glmx", "gls", "gmnl", "gmm", "gnls", "gsm", "ggcomparisons", # h -------------------- "heavyLme", "HLfit", "htest", "hurdle", "hglm", diff --git a/R/model_info.R b/R/model_info.R index db9a43474..e9454ca15 100644 --- a/R/model_info.R +++ b/R/model_info.R @@ -1366,3 +1366,8 @@ model_info.earth <- function(x, ...) { model_info.deltaMethod <- function(x, ...) { NULL } + +#' @export +model_info.ggcomparisons <- function(x, ...) { + NULL +} diff --git a/tests/testthat/test-ggeffects.R b/tests/testthat/test-ggeffects.R new file mode 100644 index 000000000..fa9683137 --- /dev/null +++ b/tests/testthat/test-ggeffects.R @@ -0,0 +1,118 @@ +skip_if_not_installed("ggeffects") + +test_that("get_parameters, hypothesis_test", { + data(iris) + mgg <- lm(Sepal.Width ~ Sepal.Length * Species, data = iris) + + out <- ggeffects::hypothesis_test( + ggeffects::ggpredict(mgg, c("Sepal.Length", "Species")), + test = NULL + ) + + param <- get_parameters(out) + expect_named(param, c("Sepal.Length", "Species", "Estimate")) + expect_identical( + param$Sepal.Length, + c("slope", "slope", "slope") + ) + expect_identical( + param$Species, + structure(1:3, levels = c("setosa", "versicolor", "virginica"), class = "factor") + ) + expect_equal( + param$Estimate, + c(0.79853, 0.31972, 0.23189), + tolerance = 1e-3 + ) + + param <- get_parameters(out, merge_parameters = TRUE) + expect_named(param, c("Parameter", "Estimate")) + expect_identical( + param$Parameter, + c( + "Sepal.Length [slope], Species [setosa]", "Sepal.Length [slope], Species [versicolor]", + "Sepal.Length [slope], Species [virginica]" + ) + ) + expect_equal( + param$Estimate, + c(0.79853, 0.31972, 0.23189), + tolerance = 1e-3 + ) + + out <- ggeffects::hypothesis_test(ggeffects::ggpredict(mgg, c("Sepal.Length", "Species"))) + + param <- get_parameters(out) + expect_named(param, c("Sepal.Length", "Species", "Estimate")) + expect_identical( + param$Sepal.Length, + c("slope", "slope", "slope") + ) + expect_equal( + param$Estimate, + c(0.47881, 0.56664, 0.08783), + tolerance = 1e-3 + ) + + param <- get_parameters(out, merge_parameters = TRUE) + expect_named(param, c("Parameter", "Estimate")) +}) + + +test_that("get_statistic, hypothesis_test", { + data(iris) + mgg <- lm(Sepal.Width ~ Sepal.Length * Species, data = iris) + + out <- ggeffects::hypothesis_test( + ggeffects::ggpredict(mgg, c("Sepal.Length", "Species")), + test = NULL + ) + + param <- get_statistic(out) + expect_named(param, c("Sepal.Length", "Species", "Statistic")) + expect_identical( + param$Sepal.Length, + c("slope", "slope", "slope") + ) + expect_identical( + param$Species, + structure(1:3, levels = c("setosa", "versicolor", "virginica"), class = "factor") + ) + expect_equal( + param$Statistic, + c(7.23551, 4.24211, 3.79015), + tolerance = 1e-3 + ) + + param <- get_statistic(out, merge_parameters = TRUE) + expect_named(param, c("Parameter", "Statistic")) + expect_identical( + param$Parameter, + c( + "Sepal.Length [slope], Species [setosa]", "Sepal.Length [slope], Species [versicolor]", + "Sepal.Length [slope], Species [virginica]" + ) + ) + expect_equal( + param$Statistic, + c(7.23551, 4.24211, 3.79015), + tolerance = 1e-3 + ) + + out <- ggeffects::hypothesis_test(ggeffects::ggpredict(mgg, c("Sepal.Length", "Species"))) + + param <- get_statistic(out) + expect_named(param, c("Sepal.Length", "Species", "Statistic")) + expect_identical( + param$Sepal.Length, + c("slope", "slope", "slope") + ) + expect_equal( + param$Statistic, + c(3.58262, 4.48915, 0.90475), + tolerance = 1e-3 + ) + + param <- get_statistic(out, merge_parameters = TRUE) + expect_named(param, c("Parameter", "Statistic")) +})