Skip to content

Commit

Permalink
parameters(): performance=TRUE arg as alias for summary (#1022)
Browse files Browse the repository at this point in the history 
* parameters(): `performance=TRUE` arg as alias for `summary`
Fixes #898

* progress

* fix

* final ones

* desc

* news

* update tests

* update snaps

* fix

* consistent order of arguments

* lintr
  • Loading branch information
@strengejacke
strengejacke authored Oct 6, 2024
1 parent 9ee1a56 commit 7d348ad
Show file tree
Hide file tree
Showing 48 changed files with 423 additions and 262 deletions.
8 changes: 4 additions & 4 deletions DESCRIPTION
View file
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
Type: Package
Package: parameters
Title: Processing of Model Parameters
Version: 0.22.2.16
Version: 0.22.2.17
Authors@R:
c(person(given = "Daniel",
family = "Lüdecke",
Expand Down Expand Up @@ -80,8 +80,8 @@ Depends:
R (>= 3.6)
Imports:
bayestestR (>= 0.14.0),
datawizard (>= 0.12.3),
insight (>= 0.20.4),
datawizard (>= 0.13.0),
insight (>= 0.20.5),
graphics,
methods,
stats,
Expand Down Expand Up @@ -224,4 +224,4 @@ Config/testthat/edition: 3
Config/testthat/parallel: true
Config/Needs/website: easystats/easystatstemplate
Config/rcmdcheck/ignore-inconsequential-notes: true
Remotes: easystats/bayestestR, easystats/datawizard
Remotes: easystats/bayestestR#678
11 changes: 10 additions & 1 deletion NEWS.md
View file
Original file line number Diff line number Diff line change
@@ -1,4 +1,13 @@
# parameters 0.22.3
# parameters 0.23.0

## Breaking Changes

* Argument `summary` in `model_parameters()` is now deprecated. Please use
`include_info` instead.

* Changed output style for the included additional information on model formula,
sigma and R2 when printing model parameters. This information now also includes
the RMSE.

## Changes

Expand Down
39 changes: 27 additions & 12 deletions R/1_model_parameters.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -398,8 +398,8 @@ model_parameters <- function(model, ...) {

# Add new options to the docs in "print.parameters_model"

# getOption("parameters_summary"): show model summary
# getOption("parameters_mixed_summary"): show model summary for mixed models
# getOption("parameters_info"): show model summary
# getOption("parameters_mixed_info"): show model summary for mixed models
# getOption("parameters_cimethod"): show message about CI approximation
# getOption("parameters_exponentiate"): show warning about exp for log/logit links
# getOption("parameters_labels"): use value/variable labels instead pretty names
Expand Down Expand Up @@ -466,9 +466,10 @@ parameters <- model_parameters
#' _Confidence intervals and approximation of degrees of freedom_ in
#' [`model_parameters()`] for further details. When `ci_method=NULL`, in most
#' cases `"wald"` is used then.
#' @param summary Logical, if `TRUE`, prints summary information about the
#' @param include_info Logical, if `TRUE`, prints summary information about the
#' model (model formula, number of observations, residual standard deviation
#' and more).
#' @param summary Deprecated, please use `info` instead.
#' @param keep Character containing a regular expression pattern that
#' describes the parameters that should be included (for `keep`) or excluded
#' (for `drop`) in the returned data frame. `keep` may also be a
Expand Down Expand Up @@ -566,16 +567,23 @@ model_parameters.default <- function(model,
standardize = NULL,
exponentiate = FALSE,
p_adjust = NULL,
vcov = NULL,
vcov_args = NULL,
summary = getOption("parameters_summary", FALSE),
include_info = getOption("parameters_info", FALSE),
keep = NULL,
drop = NULL,
verbose = TRUE,
vcov = NULL,
vcov_args = NULL,
...) {
# validation check for inputs
.is_model_valid(model)

## TODO remove deprecated later
if (!missing(summary)) {
.deprecated_warning("summary", "include_info", verbose)
include_info <- summary
}

# validation check, warn if unsupported argument is used.
# unsupported arguments will be removed from the argument list.
dots <- .check_dots(
Expand All @@ -597,7 +605,7 @@ model_parameters.default <- function(model,
standardize = standardize,
exponentiate = exponentiate,
p_adjust = p_adjust,
summary = summary,
include_info = include_info,
keep_parameters = keep,
drop_parameters = drop,
vcov = vcov,
Expand Down Expand Up @@ -654,12 +662,12 @@ model_parameters.default <- function(model,
component = "conditional",
ci_method = NULL,
p_adjust = NULL,
summary = FALSE,
include_info = FALSE,
keep_parameters = NULL,
drop_parameters = NULL,
verbose = TRUE,
vcov = NULL,
vcov_args = NULL,
verbose = TRUE,
...) {
dots <- list(...)

Expand Down Expand Up @@ -726,7 +734,7 @@ model_parameters.default <- function(model,
iterations,
ci_method = ci_method,
p_adjust = p_adjust,
summary = summary,
include_info = include_info,
verbose = verbose,
...
)
Expand All @@ -751,15 +759,22 @@ model_parameters.glm <- function(model,
standardize = NULL,
exponentiate = FALSE,
p_adjust = NULL,
vcov = NULL,
vcov_args = NULL,
summary = getOption("parameters_summary", FALSE),
include_info = getOption("parameters_info", FALSE),
keep = NULL,
drop = NULL,
vcov = NULL,
vcov_args = NULL,
verbose = TRUE,
...) {
dots <- list(...)

## TODO remove deprecated later
if (!missing(summary)) {
.deprecated_warning("summary", "include_info", verbose)
include_info <- summary
}

# set default
if (is.null(ci_method)) {
if (isTRUE(bootstrap)) {
Expand Down Expand Up @@ -797,7 +812,7 @@ model_parameters.glm <- function(model,
standardize = standardize,
exponentiate = exponentiate,
p_adjust = p_adjust,
summary = summary,
include_info = include_info,
keep_parameters = keep,
drop_parameters = drop,
vcov = vcov,
Expand Down
8 changes: 4 additions & 4 deletions R/extract_parameters.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -16,7 +16,7 @@
keep_parameters = NULL,
drop_parameters = NULL,
include_sigma = TRUE,
summary = FALSE,
include_info = FALSE,
vcov = NULL,
vcov_args = NULL,
...) {
Expand Down Expand Up @@ -301,7 +301,7 @@

# ==== add sigma and residual df

if (isTRUE(include_sigma) || isTRUE(summary)) {
if (isTRUE(include_sigma) || isTRUE(include_info)) {
parameters <- .add_sigma_residual_df(parameters, model)
}

Expand Down Expand Up @@ -424,7 +424,7 @@
keep_parameters = NULL,
drop_parameters = NULL,
include_sigma = FALSE,
summary = FALSE,
include_info = FALSE,
vcov = NULL,
vcov_args = NULL,
verbose = TRUE,
Expand Down Expand Up @@ -639,7 +639,7 @@


# add sigma
if (isTRUE(include_sigma) || isTRUE(summary)) {
if (isTRUE(include_sigma) || isTRUE(include_info)) {
parameters <- .add_sigma_residual_df(parameters, model)
}

Expand Down
141 changes: 41 additions & 100 deletions R/format.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -542,13 +542,15 @@ format.parameters_sem <- function(x,
show_sigma = FALSE,
show_formula = FALSE,
show_r2 = FALSE,
show_rmse = FALSE,
format = "text") {
# prepare footer
footer <- NULL
type <- tolower(format)

sigma_value <- attributes(x)$sigma
r2 <- attributes(x)$r2
rmse <- attributes(x)$rmse
residual_df <- attributes(x)$residual_df
p_adjust <- attributes(x)$p_adjust
model_formula <- attributes(x)$model_formula
Expand All @@ -575,29 +577,35 @@ format.parameters_sem <- function(x,
footer <- .add_footer_r2(footer, digits, r2, type)
}

# footer: r-squared
if (isTRUE(show_rmse)) {
footer <- .add_footer_values(footer, digits, value = rmse, text = "RMSE ", type)
}

# footer: p-adjustment
if ("p" %in% colnames(x) && isTRUE(verbose)) {
footer <- .add_footer_padjust(footer, p_adjust, type)
if ("p" %in% colnames(x) && isTRUE(verbose) && !is.null(p_adjust) && p_adjust != "none") {
footer <- .add_footer_text(footer, text = paste("p-value adjustment method:", format_p_adjust(p_adjust)))
}

# footer: anova test
if (!is.null(anova_test)) {
footer <- .add_footer_anova_test(footer, anova_test, type)
footer <- .add_footer_text(footer, text = sprintf("%s test statistic", anova_test))
}

# footer: anova test
# footer: anova type
if (!is.null(anova_type)) {
footer <- .add_footer_anova_type(footer, anova_type, type)
footer <- .add_footer_text(footer, text = sprintf("Anova Table (Type %s tests)", anova_type))
}


# footer: marginaleffects::comparisons()
if (!is.null(prediction_type)) {
footer <- .add_footer_prediction_type(footer, prediction_type, type)
footer <- .add_footer_text(footer, text = sprintf("Prediction type: %s", prediction_type))
}

# footer: htest alternative
if (!is.null(text_alternative)) {
footer <- .add_footer_alternative(footer, text_alternative, type)
footer <- .add_footer_text(footer, text = text_alternative)
}

# footer: generic text
Expand Down Expand Up @@ -627,7 +635,7 @@ format.parameters_sem <- function(x,

# footer: generic text
.add_footer_text <- function(footer = NULL, text = NULL, type = "text", is_ggeffects = FALSE) {
if (!is.null(text)) {
if (!is.null(text) && length(text)) {
if (type == "text" || type == "markdown") {
if (is.null(footer)) {
fill <- "\n"
Expand All @@ -644,6 +652,29 @@ format.parameters_sem <- function(x,
}


# footer: generic values
.add_footer_values <- function(footer = NULL,
digits = 3,
value = NULL,
text = NULL,
type = "text") {
if (!is.null(value) && !is.null(text)) {
string <- sprintf("%s: %s", text, insight::format_value(value, digits = digits))
if (type == "text" || type == "markdown") {
if (is.null(footer)) {
fill <- "\n"
} else {
fill <- ""
}
footer <- paste0(footer, fill, string, "\n")
} else if (type == "html") {
footer <- c(footer, string)
}
}
footer
}


# footer: residual standard deviation
.add_footer_sigma <- function(footer = NULL, digits = 3, sigma = NULL, residual_df = NULL, type = "text") {
if (!is.null(sigma)) {
Expand All @@ -660,9 +691,9 @@ format.parameters_sem <- function(x,
} else {
fill <- ""
}
footer <- paste0(footer, sprintf("%sResidual standard deviation: %.*f%s\n", fill, digits, sigma, res_df))
footer <- paste0(footer, sprintf("%sSigma: %.*f%s\n", fill, digits, sigma, res_df))
} else if (type == "html") {
footer <- c(footer, insight::trim_ws(sprintf("Residual standard deviation: %.*f%s", digits, sigma, res_df)))
footer <- c(footer, insight::trim_ws(sprintf("Sigma: %.*f%s", digits, sigma, res_df)))
}
}
footer
Expand Down Expand Up @@ -693,96 +724,6 @@ format.parameters_sem <- function(x,
}


# footer: anova type
.add_footer_anova_type <- function(footer = NULL, aov_type = NULL, type = "text") {
if (!is.null(aov_type)) {
if (type == "text" || type == "markdown") {
if (is.null(footer)) {
fill <- "\n"
} else {
fill <- ""
}
footer <- paste0(footer, sprintf("%sAnova Table (Type %s tests)\n", fill, aov_type))
} else if (type == "html") {
footer <- c(footer, sprintf("Anova Table (Type %s tests)", aov_type))
}
}
footer
}


# footer: marginaleffects::comparisions() prediction_type
.add_footer_prediction_type <- function(footer = NULL, prediction_type = NULL, type = "text") {
if (!is.null(prediction_type)) {
if (type == "text" || type == "markdown") {
if (is.null(footer)) {
fill <- "\n"
} else {
fill <- ""
}
footer <- paste0(footer, sprintf("%sPrediction type: %s\n", fill, prediction_type))
} else if (type == "html") {
footer <- c(footer, sprintf("Prediction type: %s", prediction_type))
}
}
footer
}


# footer: anova test
.add_footer_anova_test <- function(footer = NULL, test = NULL, type = "text") {
if (!is.null(test)) {
if (type == "text" || type == "markdown") {
if (is.null(footer)) {
fill <- "\n"
} else {
fill <- ""
}
footer <- paste0(footer, sprintf("%s%s test statistic\n", fill, test))
} else if (type == "html") {
footer <- c(footer, sprintf("%s test statistic", test))
}
}
footer
}


# footer: htest alternative
.add_footer_alternative <- function(footer = NULL, text_alternative = NULL, type = "text") {
if (!is.null(text_alternative)) {
if (type == "text" || type == "markdown") {
if (is.null(footer)) {
fill <- "\n"
} else {
fill <- ""
}
footer <- paste0(footer, sprintf("%s%s\n", fill, text_alternative))
} else if (type == "html") {
footer <- c(footer, text_alternative)
}
}
footer
}


# footer: p-adjustment
.add_footer_padjust <- function(footer = NULL, p_adjust = NULL, type = "text") {
if (!is.null(p_adjust) && p_adjust != "none") {
if (type == "text" || type == "markdown") {
if (is.null(footer)) {
fill <- "\n"
} else {
fill <- ""
}
footer <- paste0(footer, fill, "p-value adjustment method: ", format_p_adjust(p_adjust), "\n")
} else if (type == "html") {
footer <- c(footer, paste0("p-value adjustment method: ", format_p_adjust(p_adjust)))
}
}
footer
}


# footer: model formula
.add_footer_formula <- function(footer = NULL, model_formula = NULL, n_obs = NULL, type = "text") {
if (!is.null(model_formula)) {
Expand Down
Loading

0 comments on commit 7d348ad

Please sign in to comment.