diff --git a/DESCRIPTION b/DESCRIPTION index 2bf9b5d6d..cd758f53a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: modelbased Title: Estimation of Model-Based Predictions, Contrasts and Means -Version: 0.13.0.8 +Version: 0.13.0.9 Authors@R: c(person(given = "Dominique", family = "Makowski", diff --git a/R/estimate_contrasts.R b/R/estimate_contrasts.R index b2fc76f2a..c777e6253 100644 --- a/R/estimate_contrasts.R +++ b/R/estimate_contrasts.R @@ -413,6 +413,11 @@ estimate_contrasts.default <- function( attr(out, "p_adjust") <- p_adjust attr(out, "backend") <- backend + # we want to store the generic, not the ".default" method, in the call + cl <- match.call() + cl[[1L]] <- quote(estimate_contrasts) + attr(out, "call") <- cl + # add attributes from workhorse function attributes(out) <- utils::modifyList(attributes(out), info[.info_elements()]) diff --git a/R/estimate_means.R b/R/estimate_means.R index b26e5d22f..15b34ca02 100644 --- a/R/estimate_means.R +++ b/R/estimate_means.R @@ -470,6 +470,7 @@ estimate_means <- function(model, attr(means, "ci") <- ci attr(means, "backend") <- backend attr(means, "coef_name") <- intersect(.valid_coefficient_names(model), colnames(means)) + attr(means, "call") <- match.call() # add attributes from workhorse function attributes(means) <- utils::modifyList(attributes(means), info[.info_elements()]) diff --git a/R/estimate_slopes.R b/R/estimate_slopes.R index 92f10c0f0..440e23d3c 100644 --- a/R/estimate_slopes.R +++ b/R/estimate_slopes.R @@ -186,6 +186,7 @@ estimate_slopes <- function(model, attr(trends, "model") <- model attr(trends, "response") <- insight::find_response(model) attr(trends, "ci") <- ci + attr(trends, "call") <- match.call() # add attributes from workhorse function attributes(trends) <- utils::modifyList(attributes(trends), info[.info_elements()]) diff --git a/tests/testthat/test-attributes_estimatefun.R b/tests/testthat/test-attributes_estimatefun.R index 8f9f78883..10a2d2c41 100644 --- a/tests/testthat/test-attributes_estimatefun.R +++ b/tests/testthat/test-attributes_estimatefun.R @@ -6,22 +6,24 @@ test_that("attributes_means", { model <- lm(Sepal.Length ~ Species + Sepal.Width, data = iris) estim <- suppressMessages(estimate_means(model, "Species", backend = "emmeans")) + # fmt: skip expect_named( attributes(estim), c( "names", "row.names", "class", "at", "by", "table_title", "table_footer", - "model", "response", "ci", "backend", "coef_name", "focal_terms", + "model", "response", "ci", "backend", "coef_name", "call", "focal_terms", "predict", "transform", "keep_iterations" ) ) estim <- suppressMessages(estimate_means(model, "Species", backend = "marginaleffects")) + # fmt: skip expect_named( attributes(estim), c( "names", "class", "row.names", "at", "by", "focal_terms", "adjusted_for", "predict", "estimate", "transform", "datagrid", "preserve_range", "model_info", "keep_iterations", "joint_test", "vcov", "table_title", - "table_footer", "model", "response", "ci", "backend", "coef_name" + "table_footer", "model", "response", "ci", "backend", "coef_name", "call" ) ) }) @@ -32,42 +34,55 @@ test_that("attributes_means, contrasts", { model <- lm(Sepal.Length ~ Species + Sepal.Width, data = iris) estim <- suppressMessages(estimate_contrasts(model, "Species", backend = "emmeans")) + # fmt: skip expect_named( attributes(estim), c( "names", "class", "row.names", "table_title", "table_footer", - "model", "response", "ci", "p_adjust", "backend", "predict", + "model", "response", "ci", "p_adjust", "backend", "call", "predict", "comparison", "contrast", "transform", "keep_iterations", "joint_test" ) ) estim <- suppressMessages(estimate_contrasts(model, "Species", backend = "marginaleffects")) + # fmt: skip expect_named( attributes(estim), c( "names", "row.names", "class", "table_title", "table_footer", - "model", "response", "ci", "p_adjust", "backend", "focal_terms", + "model", "response", "ci", "p_adjust", "backend", "call", "focal_terms", "adjusted_for", "predict", "comparison", "contrast", "estimate", "transform", "datagrid", "preserve_range", "coef_name", "model_info", "keep_iterations", "joint_test", "vcov" ) ) - estim <- suppressMessages(estimate_contrasts(model, "Species=c('setosa','virginica')", backend = "marginaleffects")) + estim <- suppressMessages(estimate_contrasts( + model, + "Species=c('setosa','virginica')", + backend = "marginaleffects" + )) + # fmt: skip expect_named( attributes(estim), c( "names", "row.names", "class", "table_title", "table_footer", - "model", "response", "ci", "p_adjust", "backend", "focal_terms", + "model", "response", "ci", "p_adjust", "backend", "call", "focal_terms", "adjusted_for", "predict", "comparison", "contrast", "estimate", "transform", "datagrid", "preserve_range", "coef_name", "model_info", "keep_iterations", "joint_test", "vcov" ) ) - estim <- suppressMessages(estimate_contrasts(model, "Species=c('setosa','virginica')", backend = "marginaleffects", estimate = "average")) + estim <- suppressMessages(estimate_contrasts( + model, + "Species=c('setosa','virginica')", + backend = "marginaleffects", + estimate = "average" + )) + # fmt: skip expect_named( attributes(estim), c( "names", "row.names", "class", "table_title", "table_footer", - "model", "response", "ci", "p_adjust", "backend", "focal_terms", + "model", "response", "ci", "p_adjust", "backend", "call", "focal_terms", "adjusted_for", "predict", "comparison", "contrast", "estimate", "transform", "datagrid", "preserve_range", "coef_name", "model_info", "contrast_filter", "keep_iterations", "joint_test","vcov" @@ -81,21 +96,23 @@ test_that("attributes_means, slopes", { model <- lm(Sepal.Length ~ Species + Sepal.Width, data = iris) estim <- suppressMessages(estimate_slopes(model, "Sepal.Width", backend = "emmeans")) + # fmt: skip expect_named( attributes(estim), c( "names", "row.names", "class", "table_title", "table_footer", - "model", "response", "ci", "trend", "transform", "coef_name", + "model", "response", "ci", "call", "trend", "transform", "coef_name", "keep_iterations" ) ) estim <- suppressMessages(estimate_slopes(model, "Sepal.Width", backend = "marginaleffects")) + # fmt: skip expect_named( attributes(estim), c( "names", "class", "row.names", "trend", "p_adjust", "transform", "coef_name", "slope", "ci", "model_info", "keep_iterations", - "vcov", "table_title", "table_footer", "model", "response" + "vcov", "table_title", "table_footer", "model", "response", "call" ) ) }) @@ -109,6 +126,7 @@ test_that("attributes_means", { by = c("Species", "Petal.Width = [fivenum]"), preserve_range = FALSE ) + # fmt: skip expect_named( attributes(estim), c( diff --git a/tests/testthat/test-keep_iterations.R b/tests/testthat/test-keep_iterations.R index 5c56843cd..261266138 100644 --- a/tests/testthat/test-keep_iterations.R +++ b/tests/testthat/test-keep_iterations.R @@ -10,15 +10,17 @@ test_that("estimate_means() - posterior draws", { m <- insight::download_model("brms_1") skip_if(is.null(m)) out <- estimate_means(m, by = "wt", keep_iterations = 5) + # fmt: skip expect_named( attributes(out), c( "names", "class", "row.names", "at", "by", "focal_terms", "adjusted_for", "predict", "estimate", "transform", "datagrid", "preserve_range", "model_info", "keep_iterations", "joint_test", "table_title", - "table_footer", "model", "response", "ci", "backend", "coef_name" + "table_footer", "model", "response", "ci", "backend", "coef_name", "call" ) ) + # fmt: skip expect_named( out, c( @@ -33,15 +35,17 @@ test_that("estimate_means() - posterior draws", { expect_identical(dim(out), c(10L, 4009L)) out <- estimate_means(m, by = "wt") + # fmt: skip expect_named( attributes(out), c( "names", "class", "row.names", "at", "by", "focal_terms", "adjusted_for", "predict", "estimate", "transform", "datagrid", "preserve_range", "model_info", "keep_iterations", "joint_test", "table_title", - "table_footer", "model", "response", "ci", "backend", "coef_name" + "table_footer", "model", "response", "ci", "backend", "coef_name", "call" ) ) + # fmt: skip expect_named( out, c( @@ -57,16 +61,18 @@ test_that("estimate_contrasts() - posterior draws", { m <- insight::download_model("brms_1") skip_if(is.null(m)) out <- estimate_contrasts(m, "wt=c(3,4,5)", keep_iterations = 5) + # fmt: skip expect_named( attributes(out), c( "names", "row.names", "class", "table_title", "table_footer", - "model", "response", "ci", "p_adjust", "backend", "focal_terms", + "model", "response", "ci", "p_adjust", "backend", "call", "focal_terms", "adjusted_for", "predict", "comparison", "contrast", "estimate", "transform", "datagrid", "preserve_range", "coef_name", "model_info", "keep_iterations", "joint_test" ) ) + # fmt: skip expect_named( out, c( @@ -81,16 +87,18 @@ test_that("estimate_contrasts() - posterior draws", { expect_identical(dim(out), c(3L, 4010L)) out <- estimate_contrasts(m, "wt=c(3,4,5)") + # fmt: skip expect_named( attributes(out), c( "names", "row.names", "class", "table_title", "table_footer", - "model", "response", "ci", "p_adjust", "backend", "focal_terms", + "model", "response", "ci", "p_adjust", "backend", "call", "focal_terms", "adjusted_for", "predict", "comparison", "contrast", "estimate", "transform", "datagrid", "preserve_range", "coef_name", "model_info", "keep_iterations", "joint_test" ) ) + # fmt: skip expect_named( out, c( @@ -106,14 +114,16 @@ test_that("estimate_slopes() - posterior draws", { m <- insight::download_model("brms_1") skip_if(is.null(m)) out <- estimate_slopes(m, "wt", keep_iterations = 5) + # fmt: skip expect_named( attributes(out), c( "names", "class", "row.names", "trend", "p_adjust", "transform", "coef_name", "slope", "ci", "model_info", "keep_iterations", - "table_title", "table_footer", "model", "response" + "table_title", "table_footer", "model", "response", "call" ) ) + # fmt: skip expect_named( out, c( @@ -125,14 +135,16 @@ test_that("estimate_slopes() - posterior draws", { expect_identical(dim(out), c(1L, 13L)) out <- estimate_slopes(m, "wt") + # fmt: skip expect_named( attributes(out), c( "names", "class", "row.names", "trend", "p_adjust", "transform", "coef_name", "slope", "ci", "model_info", "keep_iterations", - "table_title", "table_footer", "model", "response" + "table_title", "table_footer", "model", "response", "call" ) ) + # fmt: skip expect_named( out, c( @@ -148,14 +160,16 @@ test_that("estimate_means() - posterior draws, emmeans", { m <- insight::download_model("brms_1") skip_if(is.null(m)) out <- estimate_means(m, by = "wt", keep_iterations = 5, backend = "emmeans") + # fmt: skip expect_named( attributes(out), c( "names", "class", "row.names", "table_title", "table_footer", - "model", "response", "ci", "backend", "coef_name", "at", "by", + "model", "response", "ci", "backend", "coef_name", "call", "at", "by", "focal_terms", "predict", "transform", "keep_iterations" ) ) + # fmt: skip expect_named( out, c( @@ -166,11 +180,12 @@ test_that("estimate_means() - posterior draws, emmeans", { expect_identical(dim(out), c(10L, 10L)) out <- estimate_means(m, by = "wt", keep_iterations = TRUE, backend = "emmeans") + # fmt: skip expect_named( attributes(out), c( "names", "class", "row.names", "table_title", "table_footer", - "model", "response", "ci", "backend", "coef_name", "at", "by", + "model", "response", "ci", "backend", "coef_name", "call", "at", "by", "focal_terms", "predict", "transform", "keep_iterations" ) ) @@ -182,15 +197,17 @@ test_that("estimate_contrasts() - posterior draws, emmeans", { m <- insight::download_model("brms_1") skip_if(is.null(m)) out <- estimate_contrasts(m, by = "wt=c(3,4,5)", keep_iterations = 5, backend = "emmeans") + # fmt: skip expect_named( attributes(out), c( "names", "class", "row.names", "table_title", "table_footer", - "model", "response", "ci", "p_adjust", "backend", "at", "by", + "model", "response", "ci", "p_adjust", "backend", "call", "at", "by", "predict", "comparison", "contrast", "transform", "keep_iterations", "joint_test" ) ) + # fmt: skip expect_named( out, c( @@ -201,11 +218,12 @@ test_that("estimate_contrasts() - posterior draws, emmeans", { expect_identical(dim(out), c(3L, 12L)) out <- estimate_contrasts(m, by = "wt=c(3,4,5)", keep_iterations = TRUE, backend = "emmeans") + # fmt: skip expect_named( attributes(out), c( "names", "class", "row.names", "table_title", "table_footer", - "model", "response", "ci", "p_adjust", "backend", "at", "by", + "model", "response", "ci", "p_adjust", "backend", "call", "at", "by", "predict", "comparison", "contrast", "transform", "keep_iterations", "joint_test" ) @@ -218,14 +236,16 @@ test_that("estimate_slopes() - posterior draws, emmeans", { m <- insight::download_model("brms_1") skip_if(is.null(m)) out <- estimate_slopes(m, "wt", keep_iterations = 5, backend = "emmeans") + # fmt: skip expect_named( attributes(out), c( "names", "class", "row.names", "table_title", "table_footer", - "model", "response", "ci", "trend", "transform", "coef_name", + "model", "response", "ci", "call", "trend", "transform", "coef_name", "keep_iterations" ) ) + # fmt: skip expect_named( out, c( @@ -236,11 +256,12 @@ test_that("estimate_slopes() - posterior draws, emmeans", { expect_identical(dim(out), c(1L, 10L)) out <- estimate_slopes(m, "wt", keep_iterations = TRUE, backend = "emmeans") + # fmt: skip expect_named( attributes(out), c( "names", "class", "row.names", "table_title", "table_footer", - "model", "response", "ci", "trend", "transform", "coef_name", + "model", "response", "ci", "call", "trend", "transform", "coef_name", "keep_iterations" ) ) @@ -252,6 +273,7 @@ test_that("estimate_slopes() - posterior draws, get_predicted", { m <- insight::download_model("brms_1") skip_if(is.null(m)) out <- estimate_relation(m, by = "wt", keep_iterations = 5) + # fmt: skip expect_named( attributes(out), c( @@ -261,6 +283,7 @@ test_that("estimate_slopes() - posterior draws, get_predicted", { "adjusted_for", "at_specs", "at", "by", "reference", "data" ) ) + # fmt: skip expect_named( out, c(