From e58fabd63c1ba40903a31cc2243602c26e586a13 Mon Sep 17 00:00:00 2001 From: Daniel Date: Sat, 20 Jul 2024 18:49:03 +0200 Subject: [PATCH] Bug: `pretty_names = "labels"` does not work for `AER::tobit` models (#993) * Bug: `pretty_names = "labels"` does not work for `AER::tobit` models Fixes #987 * lintr * add test --- DESCRIPTION | 2 +- NEWS.md | 3 +++ R/format_parameters.R | 26 ++++++++++++++--------- tests/testthat/_snaps/print_AER_labels.md | 19 +++++++++++++++++ tests/testthat/test-print_AER_labels.R | 9 ++++++++ 5 files changed, 48 insertions(+), 11 deletions(-) create mode 100644 tests/testthat/_snaps/print_AER_labels.md create mode 100644 tests/testthat/test-print_AER_labels.R diff --git a/DESCRIPTION b/DESCRIPTION index 7525cb501..c5c11e856 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: parameters Title: Processing of Model Parameters -Version: 0.22.0.5 +Version: 0.22.0.6 Authors@R: c(person(given = "Daniel", family = "Lüdecke", diff --git a/NEWS.md b/NEWS.md index e278b7e67..d6fb7504a 100644 --- a/NEWS.md +++ b/NEWS.md @@ -12,6 +12,9 @@ * `model_parameters()` for `anova()` from mixed models now also includes the denominator degrees of freedom in the output (`df_error`). +* `print(..., pretty_names = "labels")` for tobit-models from package *AER* now + include value labels, if available. + * Patch release, to ensure that performance runs with older version of datawizard on Mac OS X with R (old-release). diff --git a/R/format_parameters.R b/R/format_parameters.R index 818556416..33c508e4f 100644 --- a/R/format_parameters.R +++ b/R/format_parameters.R @@ -72,10 +72,10 @@ format_parameters.parameters_model <- function(model, ...) { # save some time, if model info is passed as argument dot_args <- list(...) - if (!is.null(dot_args$model_info)) { - info <- dot_args$model_info - } else { + if (is.null(dot_args$model_info)) { info <- insight::model_info(model, verbose = FALSE) + } else { + info <- dot_args$model_info } ## TODO remove is.list() when insight 0.8.3 on CRAN @@ -299,16 +299,16 @@ format_parameters.parameters_model <- function(model, ...) { if (type == "interaction") { components <- paste0( "(", - paste0(utils::head(components, -1), collapse = sep), + paste(utils::head(components, -1), collapse = sep), ")", sep, utils::tail(components, 1) ) } else { - components <- paste0(components, collapse = sep) + components <- paste(components, collapse = sep) } } else { - components <- paste0(components, collapse = sep) + components <- paste(components, collapse = sep) } components } @@ -378,6 +378,12 @@ format_parameters.parameters_model <- function(model, ...) { if (!is.null(model) && insight::is_regression_model(model) && !is.data.frame(model)) { # get data, but exclude response - we have no need for that label mf <- insight::get_data(model, source = "mf", verbose = FALSE) + # sanity check - any labels? + has_labels <- vapply(mf, function(i) !is.null(attr(i, "labels", exact = TRUE)), logical(1)) + # if we don't have labels, we try to get data from environment + if (!any(has_labels)) { + mf <- insight::get_data(model, source = "environment", verbose = FALSE) + } resp <- insight::find_response(model, combine = FALSE) mf <- mf[, setdiff(colnames(mf), resp), drop = FALSE] @@ -432,7 +438,7 @@ format_parameters.parameters_model <- function(model, ...) { # extract single coefficient names from interaction term out <- unlist(strsplit(i, ":", fixed = TRUE)) # combine labels - labs <- c(labs, paste0(sapply(out, function(l) pretty_labels[l]), collapse = " * ")) + labs <- c(labs, paste(sapply(out, function(l) pretty_labels[l]), collapse = " * ")) } # add interaction terms to labels string names(labs) <- names(interactions) @@ -461,10 +467,10 @@ format_parameters.parameters_model <- function(model, ...) { win_os <- tryCatch( { si <- Sys.info() - if (!is.null(si["sysname"])) { - si["sysname"] == "Windows" || startsWith(R.version$os, "mingw") - } else { + if (is.null(si["sysname"])) { FALSE + } else { + si["sysname"] == "Windows" || startsWith(R.version$os, "mingw") } }, error = function(e) { diff --git a/tests/testthat/_snaps/print_AER_labels.md b/tests/testthat/_snaps/print_AER_labels.md new file mode 100644 index 000000000..92b571b63 --- /dev/null +++ b/tests/testthat/_snaps/print_AER_labels.md @@ -0,0 +1,19 @@ +# templates + + Code + print(mp, pretty_names = "labels") + Output + # Fixed Effects + + Parameter | Coefficient | SE | 95% CI | z | p + ----------------------------------------------------------------------------------------------- + (Intercept) | 8.72 | 3.45 | [ 1.95, 15.48] | 2.52 | 0.012 + elder's dependency [slightly dependent] | -1.00 | 3.61 | [-8.08, 6.08] | -0.28 | 0.782 + elder's dependency [moderately dependent] | 2.68 | 3.06 | [-3.32, 8.68] | 0.88 | 0.381 + elder's dependency [severely dependent] | 3.88 | 3.00 | [-2.01, 9.77] | 1.29 | 0.197 + carer's level of education | 1.14 | 0.90 | [-0.62, 2.90] | 1.27 | 0.204 + Message + + Uncertainty intervals (equal-tailed) and p-values (two-tailed) computed + using a Wald z-distribution approximation. + diff --git a/tests/testthat/test-print_AER_labels.R b/tests/testthat/test-print_AER_labels.R new file mode 100644 index 000000000..7420cc2b0 --- /dev/null +++ b/tests/testthat/test-print_AER_labels.R @@ -0,0 +1,9 @@ +skip_if_not_installed("AER") +skip_if_not_installed("datawizard") + +test_that("templates", { + data(efc, package = "datawizard") + model <- AER::tobit(neg_c_7 ~ e42dep + c172code, data = efc) + mp <- model_parameters(model) + expect_snapshot(print(mp, pretty_names = "labels")) +})