From 01240fdace6f153ef335cfdb43c4d5bd885cecfd Mon Sep 17 00:00:00 2001 From: Daniel Date: Mon, 11 Sep 2023 11:57:29 +0200 Subject: [PATCH 01/13] make `parameters()` show fixed effects restricted to 0 Fixes #715 --- R/utils.R | 34 ++++++++++++++++++++++++++++++++++ R/utils_format.R | 29 +++++++++++++++++++++++++++++ 2 files changed, 63 insertions(+) diff --git a/R/utils.R b/R/utils.R index fd1783303..e2a5b3e81 100644 --- a/R/utils.R +++ b/R/utils.R @@ -99,3 +99,37 @@ .is_semLme <- function(x) { all(inherits(x, c("sem", "lme"))) } + + +.insert_row_at <- function(data, row, index, default_value = NA) { + # add missing columns + new_columns <- setdiff(colnames(data), colnames(row)) + if (length(new_columns) > 0) { + row[new_columns] <- default_value + } + # match column order + row <- row[match(colnames(data), colnames(row))] + + # insert row + if (index == 1) { + rbind(row, data) + } else if (index == nrow(data)) { + rbind(data, row) + } else { + rbind(data[1:(index - 1), ], row, data[index:nrow(data), ]) + } +} + + +.find_factor_levels <- function(data) { + out <- lapply(colnames(data), function(i) { + v <- data[[i]] + if (is.factor(v)) { + paste0(i, levels(v)) + } else { + NULL + } + }) + names(out) <- names(data) + insight::compact_list(out) +} diff --git a/R/utils_format.R b/R/utils_format.R index e07283841..6fedaa33f 100644 --- a/R/utils_format.R +++ b/R/utils_format.R @@ -280,6 +280,7 @@ format = NULL, coef_name = NULL, zap_small = FALSE, + add_reference = FALSE, ...) { # default brackets are parenthesis for HTML / MD if ((is.null(ci_brackets) || isTRUE(ci_brackets)) && (identical(format, "html") || identical(format, "markdown"))) { @@ -308,6 +309,11 @@ x$Level <- NULL } + # add the coefficient for the base-(reference)-level of factors? + if (add_reference) { + x <- .add_reference_level(x) + } + insight::format_table( x, pretty_names = pretty_names, @@ -322,6 +328,29 @@ } +.add_reference_level <- function(params) { + # check if we have a model object, else return parameter table + model <- .get_object(params) + if (is.null(model)) { + params + } + + # check if we have model data, else return parameter table + model_data <- insight::get_data(model) + if (is.null(model_data)) { + params + } + + # find factors and factor levels and check if we have any factors in the data + factors <- .find_factor_levels(model_data) + if (!length(factors)) { + params + } + + params +} + + # The coefficient column in the printed output is renamed, based on the model. # But for instance, for random effects, however, which are on a different scale, # we want a different name for this column. Since print.parameters_model() splits From f9e2aa4549337a326eb39e593c3ccaf9afe74523 Mon Sep 17 00:00:00 2001 From: Daniel Date: Mon, 11 Sep 2023 13:59:59 +0200 Subject: [PATCH 02/13] progress --- DESCRIPTION | 2 +- R/format.R | 3 +++ R/print.parameters_model.R | 4 ++++ R/utils_format.R | 6 ++++++ man/display.parameters_model.Rd | 6 ++++++ man/print.parameters_model.Rd | 5 +++++ 6 files changed, 25 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 203635875..304923a8a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: parameters Title: Processing of Model Parameters -Version: 0.21.1.6 +Version: 0.21.1.7 Authors@R: c(person(given = "Daniel", family = "Lüdecke", diff --git a/R/format.R b/R/format.R index d87aa88d9..460c354a2 100644 --- a/R/format.R +++ b/R/format.R @@ -15,6 +15,7 @@ format.parameters_model <- function(x, zap_small = FALSE, format = NULL, groups = NULL, + add_reference = FALSE, ...) { # save attributes coef_name <- attributes(x)$coefficient_name @@ -167,6 +168,7 @@ format.parameters_model <- function(x, ci_width = ci_width, ci_brackets = ci_brackets, zap_small = zap_small, + add_reference = add_reference, ... ) } else { @@ -183,6 +185,7 @@ format.parameters_model <- function(x, format = format, coef_name = coef_name, zap_small = zap_small, + add_reference = add_reference, ... ) } diff --git a/R/print.parameters_model.R b/R/print.parameters_model.R index 0d02629ca..ad073dc01 100644 --- a/R/print.parameters_model.R +++ b/R/print.parameters_model.R @@ -87,6 +87,10 @@ #' labels will be used as parameters names. The latter only works for "labelled" #' data, i.e. if the data used to fit the model had `"label"` and `"labels"` #' attributes. See also section _Global Options to Customize Messages when Printing_. +#' @param add_reference Logical, if `TRUE`, the reference level of factors will +#' be added to the parameter table. This is only relevant for models with +#' categorical predictors. The coefficient for the reference level is always +#' `0`, so this is just for completeness. #' @inheritParams insight::format_table #' @inheritParams compare_parameters #' diff --git a/R/utils_format.R b/R/utils_format.R index 53ccd064a..be26faef8 100644 --- a/R/utils_format.R +++ b/R/utils_format.R @@ -347,6 +347,11 @@ params } + out <- params + for (f in factors) { + min(which(f %in% out$Parameter)) + } + params } @@ -794,6 +799,7 @@ ci_width = "auto", ci_brackets = TRUE, zap_small = FALSE, + add_reference = FALSE, ...) { final_table <- list() diff --git a/man/display.parameters_model.Rd b/man/display.parameters_model.Rd index 5a014b01c..71cc9f6bf 100644 --- a/man/display.parameters_model.Rd +++ b/man/display.parameters_model.Rd @@ -74,6 +74,7 @@ zap_small = FALSE, format = NULL, groups = NULL, + add_reference = FALSE, ... ) @@ -263,6 +264,11 @@ row". A possible use case might be to emphasize focal predictors and control variables, see 'Examples'. Parameters will be re-ordered according to the order used in \code{groups}, while all non-matching parameters will be added to the end.} + +\item{add_reference}{Logical, if \code{TRUE}, the reference level of factors will +be added to the parameter table. This is only relevant for models with +categorical predictors. The coefficient for the reference level is always +\code{0}, so this is just for completeness.} } \value{ If \code{format = "markdown"}, the return value will be a character diff --git a/man/print.parameters_model.Rd b/man/print.parameters_model.Rd index eda4ad2e1..576c53d80 100644 --- a/man/print.parameters_model.Rd +++ b/man/print.parameters_model.Rd @@ -132,6 +132,11 @@ columns across all table components are adjusted to have the same width.} encompassed in square brackets (else in parentheses).} \item{...}{Arguments passed to or from other methods.} + +\item{add_reference}{Logical, if \code{TRUE}, the reference level of factors will +be added to the parameter table. This is only relevant for models with +categorical predictors. The coefficient for the reference level is always +\code{0}, so this is just for completeness.} } \value{ Invisibly returns the original input object. From f5a7a9cd973a04bcc6ea608355a4f182200e0aad Mon Sep 17 00:00:00 2001 From: Daniel Date: Mon, 11 Sep 2023 14:58:03 +0200 Subject: [PATCH 03/13] FIXES --- R/utils.R | 13 ++++++++++++- R/utils_format.R | 25 ++++++++++++++++++++++--- 2 files changed, 34 insertions(+), 4 deletions(-) diff --git a/R/utils.R b/R/utils.R index e2a5b3e81..b06ac1181 100644 --- a/R/utils.R +++ b/R/utils.R @@ -113,7 +113,7 @@ # insert row if (index == 1) { rbind(row, data) - } else if (index == nrow(data)) { + } else if (index == (nrow(data) + 1)) { rbind(data, row) } else { rbind(data[1:(index - 1), ], row, data[index:nrow(data), ]) @@ -121,6 +121,17 @@ } +.insert_element_at <- function(data, element, index) { + if (index == 1) { + c(element, data) + } else if (index == length(data)) { + c(data, element) + } else { + c(data[1:(index - 1)], element, data[index:length(data)]) + } +} + + .find_factor_levels <- function(data) { out <- lapply(colnames(data), function(i) { v <- data[[i]] diff --git a/R/utils_format.R b/R/utils_format.R index be26faef8..494ccad6e 100644 --- a/R/utils_format.R +++ b/R/utils_format.R @@ -347,12 +347,31 @@ params } + pretty_names <- attributes(params)$pretty_names out <- params - for (f in factors) { - min(which(f %in% out$Parameter)) + + for (fn in names(factors)) { + f <- factors[[fn]] + found <- which(names(pretty_names) %in% f) + if (length(found)) { + reference_level <- f[!f %in% names(pretty_names)] + pretty_level <- paste0(fn, " [", sub(fn, "", reference_level, fixed = TRUE), " (ref.)]") + pretty_names <- .insert_element_at( + pretty_names, + stats::setNames(pretty_level, reference_level), + min(found) + ) + out <- .insert_row_at( + out, + data.frame(Parameter = reference_level, Coefficient = 0, stringsAsFactors = FALSE), + min(found) + ) + } + attr(out, "pretty_names") <- pretty_names + attr(out, "pretty_labels") <- pretty_names } - params + out } From 06ab47197df8293ad45dfdd80bde6749a2e14728 Mon Sep 17 00:00:00 2001 From: Daniel Date: Mon, 11 Sep 2023 16:07:10 +0200 Subject: [PATCH 04/13] docs --- R/display.R | 1 + R/print.parameters_model.R | 4 ++++ R/print_html.R | 2 ++ R/print_md.R | 2 ++ man/display.parameters_model.Rd | 13 ++++++++----- man/print.parameters_model.Rd | 5 +++-- 6 files changed, 20 insertions(+), 7 deletions(-) diff --git a/R/display.R b/R/display.R index eb5af55fa..e9549821a 100644 --- a/R/display.R +++ b/R/display.R @@ -91,6 +91,7 @@ display.parameters_model <- function(object, font_size = "100%", line_padding = 4, column_labels = NULL, + add_reference = FALSE, verbose = TRUE, ...) { if (identical(format, "html")) { diff --git a/R/print.parameters_model.R b/R/print.parameters_model.R index ad073dc01..f0570b394 100644 --- a/R/print.parameters_model.R +++ b/R/print.parameters_model.R @@ -237,6 +237,7 @@ print.parameters_model <- function(x, groups = NULL, column_width = NULL, ci_brackets = c("[", "]"), + add_reference = FALSE, ...) { # save original input orig_x <- x @@ -286,6 +287,7 @@ print.parameters_model <- function(x, ci_brackets = ci_brackets, format = "text", groups = groups, + add_reference = add_reference, ... ) @@ -382,6 +384,7 @@ print.parameters_random <- function(x, digits = 2, ...) { ci_brackets = TRUE, format = "text", group = NULL, + add_reference = FALSE, ...) { format( x, @@ -396,6 +399,7 @@ print.parameters_random <- function(x, digits = 2, ...) { zap_small = zap_small, format = format, group = group, + add_reference = add_reference, ... ) } diff --git a/R/print_html.R b/R/print_html.R index aaec47d4d..5be9f9b98 100644 --- a/R/print_html.R +++ b/R/print_html.R @@ -22,6 +22,7 @@ print_html.parameters_model <- function(x, font_size = "100%", line_padding = 4, column_labels = NULL, + add_reference = FALSE, verbose = TRUE, ...) { # check if user supplied digits attributes @@ -82,6 +83,7 @@ print_html.parameters_model <- function(x, ci_brackets = ci_brackets, format = "html", groups = groups, + add_reference = add_reference, ... ) diff --git a/R/print_md.R b/R/print_md.R index ad0393cd8..d95e7fe58 100644 --- a/R/print_md.R +++ b/R/print_md.R @@ -19,6 +19,7 @@ print_md.parameters_model <- function(x, show_formula = FALSE, zap_small = FALSE, groups = NULL, + add_reference = FALSE, verbose = TRUE, ...) { # check if user supplied digits attributes @@ -66,6 +67,7 @@ print_md.parameters_model <- function(x, ci_brackets = ci_brackets, format = "markdown", groups = groups, + add_reference = add_reference, ... ) diff --git a/man/display.parameters_model.Rd b/man/display.parameters_model.Rd index 71cc9f6bf..0db3977c4 100644 --- a/man/display.parameters_model.Rd +++ b/man/display.parameters_model.Rd @@ -33,6 +33,7 @@ font_size = "100\%", line_padding = 4, column_labels = NULL, + add_reference = FALSE, verbose = TRUE, ... ) @@ -99,6 +100,7 @@ font_size = "100\%", line_padding = 4, column_labels = NULL, + add_reference = FALSE, verbose = TRUE, ... ) @@ -121,6 +123,7 @@ show_formula = FALSE, zap_small = FALSE, groups = NULL, + add_reference = FALSE, verbose = TRUE, ... ) @@ -233,6 +236,11 @@ places than \code{digits} are printed in scientific notation.} \item{column_labels}{Labels of columns for HTML tables. If \code{NULL}, automatic column names are generated. See 'Examples'.} +\item{add_reference}{Logical, if \code{TRUE}, the reference level of factors will +be added to the parameter table. This is only relevant for models with +categorical predictors. The coefficient for the reference level is always +\code{0}, so this is just for completeness.} + \item{verbose}{Toggle messages and warnings.} \item{...}{Arguments passed to or from other methods.} @@ -264,11 +272,6 @@ row". A possible use case might be to emphasize focal predictors and control variables, see 'Examples'. Parameters will be re-ordered according to the order used in \code{groups}, while all non-matching parameters will be added to the end.} - -\item{add_reference}{Logical, if \code{TRUE}, the reference level of factors will -be added to the parameter table. This is only relevant for models with -categorical predictors. The coefficient for the reference level is always -\code{0}, so this is just for completeness.} } \value{ If \code{format = "markdown"}, the return value will be a character diff --git a/man/print.parameters_model.Rd b/man/print.parameters_model.Rd index 576c53d80..a21228d7f 100644 --- a/man/print.parameters_model.Rd +++ b/man/print.parameters_model.Rd @@ -22,6 +22,7 @@ groups = NULL, column_width = NULL, ci_brackets = c("[", "]"), + add_reference = FALSE, ... ) @@ -131,12 +132,12 @@ columns across all table components are adjusted to have the same width.} \item{ci_brackets}{Logical, if \code{TRUE} (default), CI-values are encompassed in square brackets (else in parentheses).} -\item{...}{Arguments passed to or from other methods.} - \item{add_reference}{Logical, if \code{TRUE}, the reference level of factors will be added to the parameter table. This is only relevant for models with categorical predictors. The coefficient for the reference level is always \code{0}, so this is just for completeness.} + +\item{...}{Arguments passed to or from other methods.} } \value{ Invisibly returns the original input object. From 1b8d8c24802dcd05f539d4b309f22a7098b9a807 Mon Sep 17 00:00:00 2001 From: Daniel Date: Mon, 11 Sep 2023 16:10:32 +0200 Subject: [PATCH 05/13] minor, make it work for OR etc. --- R/utils_format.R | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/R/utils_format.R b/R/utils_format.R index 494ccad6e..71f9c9f00 100644 --- a/R/utils_format.R +++ b/R/utils_format.R @@ -355,7 +355,7 @@ found <- which(names(pretty_names) %in% f) if (length(found)) { reference_level <- f[!f %in% names(pretty_names)] - pretty_level <- paste0(fn, " [", sub(fn, "", reference_level, fixed = TRUE), " (ref.)]") + pretty_level <- paste0(fn, " [", sub(fn, "", reference_level, fixed = TRUE), "] (ref.)") pretty_names <- .insert_element_at( pretty_names, stats::setNames(pretty_level, reference_level), @@ -363,7 +363,11 @@ ) out <- .insert_row_at( out, - data.frame(Parameter = reference_level, Coefficient = 0, stringsAsFactors = FALSE), + data.frame( + Parameter = reference_level, + Coefficient = as.numeric(attributes(x)$exponentiate), + stringsAsFactors = FALSE + ), min(found) ) } From 06ed6c6a4095f5be18f306aa6a2bbd2242d1e960 Mon Sep 17 00:00:00 2001 From: Daniel Date: Mon, 11 Sep 2023 16:25:01 +0200 Subject: [PATCH 06/13] fix --- R/1_model_parameters.R | 3 ++- R/utils_format.R | 38 ++++++++++++++++++++++++++++---------- 2 files changed, 30 insertions(+), 11 deletions(-) diff --git a/R/1_model_parameters.R b/R/1_model_parameters.R index 995fbb610..cd73dc40b 100644 --- a/R/1_model_parameters.R +++ b/R/1_model_parameters.R @@ -711,7 +711,8 @@ model_parameters.glm <- function(model, keep_parameters = keep, drop_parameters = drop, vcov = vcov, - vcov_args = vcov_args + vcov_args = vcov_args, + verbose = verbose ) args <- c(args, dots) out <- do.call(".model_parameters_generic", args) diff --git a/R/utils_format.R b/R/utils_format.R index 71f9c9f00..4954405e6 100644 --- a/R/utils_format.R +++ b/R/utils_format.R @@ -347,33 +347,51 @@ params } + # we need some more information about prettified labels etc. pretty_names <- attributes(params)$pretty_names + coef_name <- attributes(params)$coefficient_name + if (is.null(coef_name)) { + coef_name <- "Coefficient" + } + + # copy object, so we save original data out <- params + # iterate all factors in the data and check if any factor was used in the model for (fn in names(factors)) { f <- factors[[fn]] + # "f" contains all combinations of factor name and levels from the data, + # which we can match with the names of the pretty_names vector found <- which(names(pretty_names) %in% f) + # if we have a match, we add the reference level to the pretty_names vector if (length(found)) { + # the reference level is *not* in the pretty names yet reference_level <- f[!f %in% names(pretty_names)] + # create a pretty level for the reference category pretty_level <- paste0(fn, " [", sub(fn, "", reference_level, fixed = TRUE), "] (ref.)") + # insert new pretty level at the correct position in "pretty_names" pretty_names <- .insert_element_at( pretty_names, stats::setNames(pretty_level, reference_level), min(found) ) - out <- .insert_row_at( - out, - data.frame( - Parameter = reference_level, - Coefficient = as.numeric(attributes(x)$exponentiate), - stringsAsFactors = FALSE - ), - min(found) + # now we need to update the data as well (i.e. the parameters table) + row_data <- data.frame( + Parameter = reference_level, + Coefficient = as.numeric(attributes(params)$exponentiate), + stringsAsFactors = FALSE ) + # coefficient name can also be "Odds Ratio" etc., so make sure we + # have the correct column name in the data row we want to insert + if (coef_name %in% colnames(out)) { + colnames(row_data)[2] <- coef_name + } + out <- .insert_row_at(out, row_data, min(found)) } - attr(out, "pretty_names") <- pretty_names - attr(out, "pretty_labels") <- pretty_names } + # update pretty_names attribute + attr(out, "pretty_names") <- pretty_names + attr(out, "pretty_labels") <- pretty_names out } From d876847204a90d4c7251522aff0af3713abd8353 Mon Sep 17 00:00:00 2001 From: Daniel Date: Mon, 11 Sep 2023 18:17:15 +0200 Subject: [PATCH 07/13] lintr --- R/format.R | 2 +- R/utils_format.R | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/format.R b/R/format.R index 460c354a2..d006b6447 100644 --- a/R/format.R +++ b/R/format.R @@ -928,7 +928,7 @@ format.parameters_sem <- function(x, if (!is.null(msg) && isTRUE(getOption("parameters_warning_exponentiate", TRUE))) { insight::format_alert(paste0("\n", msg)) # set flag, so message only displayed once per session - options("parameters_warning_exponentiate" = FALSE) + options(parameters_warning_exponentiate = FALSE) } } } diff --git a/R/utils_format.R b/R/utils_format.R index 4954405e6..9a168ee12 100644 --- a/R/utils_format.R +++ b/R/utils_format.R @@ -361,7 +361,7 @@ for (fn in names(factors)) { f <- factors[[fn]] # "f" contains all combinations of factor name and levels from the data, - # which we can match with the names of the pretty_names vector + # which we can match with the names of the pretty_names vector found <- which(names(pretty_names) %in% f) # if we have a match, we add the reference level to the pretty_names vector if (length(found)) { From c9a4eca8292046100070f43a9000052f4341c078 Mon Sep 17 00:00:00 2001 From: Daniel Date: Mon, 11 Sep 2023 18:21:14 +0200 Subject: [PATCH 08/13] docs --- R/print.parameters_model.R | 5 +++-- man/display.parameters_model.Rd | 5 +++-- man/print.parameters_model.Rd | 5 +++-- 3 files changed, 9 insertions(+), 6 deletions(-) diff --git a/R/print.parameters_model.R b/R/print.parameters_model.R index f0570b394..debe8dd20 100644 --- a/R/print.parameters_model.R +++ b/R/print.parameters_model.R @@ -88,9 +88,10 @@ #' data, i.e. if the data used to fit the model had `"label"` and `"labels"` #' attributes. See also section _Global Options to Customize Messages when Printing_. #' @param add_reference Logical, if `TRUE`, the reference level of factors will -#' be added to the parameter table. This is only relevant for models with +#' be added to the parameters table. This is only relevant for models with #' categorical predictors. The coefficient for the reference level is always -#' `0`, so this is just for completeness. +#' `0` (except when `exponentiate = TRUE`, then the coefficient will be `1`), +#' so this is just for completeness. #' @inheritParams insight::format_table #' @inheritParams compare_parameters #' diff --git a/man/display.parameters_model.Rd b/man/display.parameters_model.Rd index 0db3977c4..263fe680a 100644 --- a/man/display.parameters_model.Rd +++ b/man/display.parameters_model.Rd @@ -237,9 +237,10 @@ places than \code{digits} are printed in scientific notation.} column names are generated. See 'Examples'.} \item{add_reference}{Logical, if \code{TRUE}, the reference level of factors will -be added to the parameter table. This is only relevant for models with +be added to the parameters table. This is only relevant for models with categorical predictors. The coefficient for the reference level is always -\code{0}, so this is just for completeness.} +\code{0} (except when \code{exponentiate = TRUE}, then the coefficient will be \code{1}), +so this is just for completeness.} \item{verbose}{Toggle messages and warnings.} diff --git a/man/print.parameters_model.Rd b/man/print.parameters_model.Rd index a21228d7f..b66d83cd7 100644 --- a/man/print.parameters_model.Rd +++ b/man/print.parameters_model.Rd @@ -133,9 +133,10 @@ columns across all table components are adjusted to have the same width.} encompassed in square brackets (else in parentheses).} \item{add_reference}{Logical, if \code{TRUE}, the reference level of factors will -be added to the parameter table. This is only relevant for models with +be added to the parameters table. This is only relevant for models with categorical predictors. The coefficient for the reference level is always -\code{0}, so this is just for completeness.} +\code{0} (except when \code{exponentiate = TRUE}, then the coefficient will be \code{1}), +so this is just for completeness.} \item{...}{Arguments passed to or from other methods.} } From 2b1dc4c572383c0893d50c90dd70fd2817514ec9 Mon Sep 17 00:00:00 2001 From: Daniel Date: Mon, 11 Sep 2023 18:42:35 +0200 Subject: [PATCH 09/13] fix --- R/utils_format.R | 10 +++++ .../testthat/test-printing_reference_level.R | 44 +++++++++++++++++++ 2 files changed, 54 insertions(+) create mode 100644 tests/testthat/test-printing_reference_level.R diff --git a/R/utils_format.R b/R/utils_format.R index 9a168ee12..485934f85 100644 --- a/R/utils_format.R +++ b/R/utils_format.R @@ -357,6 +357,11 @@ # copy object, so we save original data out <- params + # if we use "keep" or "drop", we have less parameters in our data frame, + # so we need to make sure we only have those pretty_names, which names match + # the parameters in the data frame + pretty_names <- pretty_names[names(pretty_names) %in% params$Parameter] + # iterate all factors in the data and check if any factor was used in the model for (fn in names(factors)) { f <- factors[[fn]] @@ -1040,6 +1045,11 @@ tables[[type]][[1]] <- insight::format_value(tables[[type]][[1]], digits = digits, protect_integers = TRUE) } + # add the coefficient for the base-(reference)-level of factors? + if (add_reference) { + tables[[type]] <- .add_reference_level(tables[[type]]) + } + formatted_table <- insight::format_table( tables[[type]], digits = digits, ci_digits = ci_digits, diff --git a/tests/testthat/test-printing_reference_level.R b/tests/testthat/test-printing_reference_level.R new file mode 100644 index 000000000..d847fcd4e --- /dev/null +++ b/tests/testthat/test-printing_reference_level.R @@ -0,0 +1,44 @@ +# skip_if(getRversion() < "4.0.0") + +# test_that("simple reference level", { +# data(PlantGrowth) +# d <<- PlantGrowth +# m <- lm(weight ~ group, data = d) +# mp <- model_parameters(m) +# expect_snapshot(print(mp, add_reference = TRUE)) + +# data(mtcars) +# d <<- mtcars +# d$cyl <- as.factor(d$cyl) +# d$am <- as.factor(d$am) +# m <- lm(mpg ~ hp + cyl + gear + am, data = d) +# mp <- model_parameters(m) +# expect_snapshot(print(mp, add_reference = TRUE)) + +# data(iris) +# d <<- iris +# m <- lm(Sepal.Length ~ Sepal.Width * Species, data = d) +# mp <- model_parameters(m) +# expect_snapshot(print(mp, add_reference = TRUE)) + +# data(mtcars) +# d <<- mtcars +# d$gear <- as.factor(d$gear) +# m <- glm(vs ~ wt + gear, data = d, family = "binomial") +# expect_snapshot(print(model_parameters(m, exponentiate = TRUE, drop = "(Intercept)"), add_reference = TRUE)) +# }) + +# test_that("reference for models with multiple components", { +# skip_on_cran() +# skip_if_not_installed("glmmTMB") +# data("fish") + +# m1 <- glmmTMB::glmmTMB( +# count ~ child + camper + zg + (1 | ID), +# ziformula = ~ child + camper + (1 | persons), +# data = fish, +# family = glmmTMB::truncated_poisson() +# ) + +# print(model_parameters(m1), add_reference = TRUE) +# }) From 663c2fdf42e265b019bd7a02e2e40edca345ede7 Mon Sep 17 00:00:00 2001 From: Daniel Date: Mon, 11 Sep 2023 18:47:00 +0200 Subject: [PATCH 10/13] fix --- R/utils.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/utils.R b/R/utils.R index bcb3f17db..a25d54081 100644 --- a/R/utils.R +++ b/R/utils.R @@ -124,7 +124,7 @@ .insert_element_at <- function(data, element, index) { if (index == 1) { c(element, data) - } else if (index == length(data)) { + } else if (index == (length(data) + 1)) { c(data, element) } else { c(data[1:(index - 1)], element, data[index:length(data)]) From ac74c5d8104bf97b6d9134af0e570eb7d855a6f9 Mon Sep 17 00:00:00 2001 From: Daniel Date: Mon, 11 Sep 2023 18:50:50 +0200 Subject: [PATCH 11/13] fix --- R/utils_format.R | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/R/utils_format.R b/R/utils_format.R index 485934f85..51ea08607 100644 --- a/R/utils_format.R +++ b/R/utils_format.R @@ -353,6 +353,10 @@ if (is.null(coef_name)) { coef_name <- "Coefficient" } + zi_coef_name <- attributes(params)$zi_coefficient_name + if (is.null(zi_coef_name)) { + zi_coef_name <- "Coefficient" + } # copy object, so we save original data out <- params @@ -390,6 +394,8 @@ # have the correct column name in the data row we want to insert if (coef_name %in% colnames(out)) { colnames(row_data)[2] <- coef_name + } else if (zi_coef_name %in% colnames(out)) { + colnames(row_data)[2] <- zi_coef_name } out <- .insert_row_at(out, row_data, min(found)) } From 22798aa087c603832f27bf1b2bbdec7dfe30495e Mon Sep 17 00:00:00 2001 From: Daniel Date: Mon, 11 Sep 2023 18:53:13 +0200 Subject: [PATCH 12/13] dont print "(ref.)" --- R/utils_format.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/utils_format.R b/R/utils_format.R index 51ea08607..144f139ab 100644 --- a/R/utils_format.R +++ b/R/utils_format.R @@ -377,7 +377,7 @@ # the reference level is *not* in the pretty names yet reference_level <- f[!f %in% names(pretty_names)] # create a pretty level for the reference category - pretty_level <- paste0(fn, " [", sub(fn, "", reference_level, fixed = TRUE), "] (ref.)") + pretty_level <- paste0(fn, " [", sub(fn, "", reference_level, fixed = TRUE), "]") # insert new pretty level at the correct position in "pretty_names" pretty_names <- .insert_element_at( pretty_names, From 6bcf62ea122dd4e5997d900c424309e8173112f3 Mon Sep 17 00:00:00 2001 From: Daniel Date: Mon, 11 Sep 2023 20:15:02 +0200 Subject: [PATCH 13/13] update news --- NEWS.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/NEWS.md b/NEWS.md index 8bec9493e..e96ad55d6 100644 --- a/NEWS.md +++ b/NEWS.md @@ -8,6 +8,10 @@ * `model_parameters()` for objects from package *marginaleffects* now also accepts the `exponentiate` argument. +* The `print()`, `print_html()`, `print_md()` and `format()` methods for + `model_parameters()` get an `add_reference` argument, to add the reference + category of categorical predictors to the parameters table. + ## Bug fixes * Fixed issue with wrong calculation of test-statistic and p-values in