1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
|
# x <- lm(Sepal.Width ~ Species * Petal.Length, data = iris)
# model <- marginaleffects(x, newdata = insight::get_datagrid(x, at = "Species"), variables = "Petal.Length")
# model_parameters ----------------
#' @export
model_parameters.marginaleffects <- function(model,
ci = 0.95,
exponentiate = FALSE,
...) {
insight::check_if_installed("marginaleffects")
tidy_model <- marginaleffects::tidy(model, conf_level = ci, ...)
out <- .rename_reserved_marginaleffects(tidy_model)
out <- insight::standardize_names(out, style = "easystats")
# in case data grid contained column names that are reserved words,
# rename those back now...
colnames(out) <- gsub("#####$", "", colnames(out))
# contrast_ columns provide indispensable information about the comparisons
colnames(out)[colnames(out) == "contrast"] <- "Comparison"
colnames(out) <- gsub("^contrast_", "Comparison: ", colnames(out))
out <- .safe(.add_model_parameters_attributes(out, model, ci, exponentiate = exponentiate, ...), out)
attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(model))
# do not print or report these columns
out <- out[, !colnames(out) %in% c("predicted_lo", "predicted_hi"), drop = FALSE]
if (inherits(model, "marginalmeans")) {
attr(out, "coefficient_name") <- "Marginal Means"
} else if (inherits(model, "comparisons")) {
attr(out, "coefficient_name") <- "Estimate"
attr(out, "title") <- "Contrasts between Adjusted Predictions"
if ("Type" %in% colnames(out)) {
attr(out, "prediction_type") <- out$Type[1]
}
} else if (inherits(model, "slopes")) {
attr(out, "coefficient_name") <- "Slope"
} else if (inherits(model, "predictions")) {
attr(out, "coefficient_name") <- "Predicted"
} else if (inherits(model, "hypotheses")) {
attr(out, "coefficient_name") <- "Estimate"
}
# exponentiate coefficients and SE/CI, if requested
out <- .exponentiate_parameters(out, model = NULL, exponentiate)
# add further information as attributes
out <- .add_model_parameters_attributes(
out,
model = model,
ci = ci,
exponentiate = exponentiate,
...
)
class(out) <- c("parameters_model", "see_parameters_model", class(out))
out
}
#' @export
model_parameters.comparisons <- model_parameters.marginaleffects
#' @export
model_parameters.marginalmeans <- model_parameters.marginaleffects
#' @export
model_parameters.hypotheses <- model_parameters.marginaleffects
#' @export
model_parameters.slopes <- model_parameters.marginaleffects
#' @export
model_parameters.predictions <- function(model,
ci = 0.95,
exponentiate = FALSE,
...) {
insight::check_if_installed("marginaleffects")
out <- .rename_reserved_marginaleffects(model)
out <- datawizard::data_rename(out, "estimate", "predicted")
out <- datawizard::data_relocate(out, "predicted", before = 1)
out <- insight::standardize_names(out, style = "easystats")
out <- insight::standardize_column_order(out, style = "easystats")
# in case data grid contained column names that are reserved words,
# rename those back now...
colnames(out) <- gsub("#####$", "", colnames(out))
# remove and reorder some columns
out$rowid <- out$Type <- NULL
out <- datawizard::data_relocate(out, select = attributes(model)$newdata_at, after = "Predicted")
# extract response, remove from data frame
reg_model <- attributes(model)$model
if (!is.null(reg_model) && insight::is_model(reg_model)) {
resp <- insight::find_response(reg_model)
out[[resp]] <- NULL
}
out <- .safe(.add_model_parameters_attributes(out, model, ci, exponentiate = exponentiate, ...), out)
attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(model))
attr(out, "coefficient_name") <- "Predicted"
attr(out, "no_caption") <- TRUE
# exponentiate coefficients and SE/CI, if requested
out <- .exponentiate_parameters(out, model = NULL, exponentiate)
# add further information as attributes
out <- .add_model_parameters_attributes(
out,
model = model,
ci = ci,
exponentiate = exponentiate,
...
)
class(out) <- c("parameters_model", "see_parameters_model", class(out))
out
}
.rename_reserved_marginaleffects <- function(model) {
# get focal terms - we might escape column names where focal terms
# equal "reserved" names, like t- or z-statistic
focal_terms <- attributes(model)$focal_terms
reserved <- c("t", "z")
renamed_focal <- NULL
# any focal terms equals reserved words? if so, rename
if (any(reserved %in% focal_terms)) {
renamed_focal <- focal_terms[focal_terms %in% reserved]
model <- datawizard::data_rename(
model,
select = renamed_focal,
replacement = paste0(renamed_focal, "#####")
)
}
model
}
|
