Skip to content

Commit 136c07a

Browse files
strengejackestrengejacke
authored
estimate_means(): keep_iterations (#442)
* estimate_means(): keep_iterations Fixes #441 * news, desc * add test * add test * add to other function * fix * fix * tests * fix * fix * fix * fix * fix * minor * fix * add test * styler * fix test * add for emmeans * fix * DRY * add test * rename into add_iterations * rename arg * fix * lintr * lintr * lintr * lintr * fix test * lintr * fix test * revise * fix tests * news
1 parent 7cecaeb commit 136c07a

21 files changed

+510
-84
lines changed

‎DESCRIPTION

+1-1
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
Type: Package
22
Package: modelbased
33
Title: Estimation of Model-Based Predictions, Contrasts and Means
4-
Version: 0.9.0.41
4+
Version: 0.9.0.42
55
Authors@R:
66
c(person(given = "Dominique",
77
family = "Makowski",

‎NEWS.md

+4
Original file line numberDiff line numberDiff line change
@@ -26,6 +26,10 @@
2626
to calculate predictions on the link-scale and back-transform them to the
2727
response scale after aggregation by groups.
2828

29+
* `estimate_means()`, `estimate_slopes()` and `estimate_contrasts()` get a
30+
`keep_iterations` argument, to keep all posterior draws from Bayesian models
31+
added as columns to the output.
32+
2933
* New functions `pool_predictions()` and `pool_contrasts()`, to deal with
3034
*modelbased* objects that were applied to imputed data sets. E.g., functions
3135
like `estimate_means()` can be run on several data sets where missing values

‎R/estimate_contrasts.R

+7-2
Original file line numberDiff line numberDiff line change
@@ -154,6 +154,7 @@ estimate_contrasts.default <- function(model,
154154
estimate = getOption("modelbased_estimate", "typical"),
155155
p_adjust = "none",
156156
transform = NULL,
157+
keep_iterations = FALSE,
157158
effectsize = NULL,
158159
iterations = 200,
159160
es_type = "cohens.d",
@@ -162,19 +163,22 @@ estimate_contrasts.default <- function(model,
162163
...) {
163164
if (backend == "emmeans") {
164165
# Emmeans ------------------------------------------------------------------
165-
estimated <- get_emcontrasts(model,
166+
estimated <- get_emcontrasts(
167+
model,
166168
contrast = contrast,
167169
by = by,
168170
predict = predict,
169171
comparison = comparison,
172+
keep_iterations = keep_iterations,
170173
adjust = p_adjust,
171174
verbose = verbose,
172175
...
173176
)
174177
out <- .format_emmeans_contrasts(model, estimated, ci, p_adjust, ...)
175178
} else {
176179
# Marginalmeans ------------------------------------------------------------
177-
estimated <- get_marginalcontrasts(model,
180+
estimated <- get_marginalcontrasts(
181+
model,
178182
contrast = contrast,
179183
by = by,
180184
predict = predict,
@@ -183,6 +187,7 @@ estimate_contrasts.default <- function(model,
183187
ci = ci,
184188
estimate = estimate,
185189
transform = transform,
190+
keep_iterations = keep_iterations,
186191
verbose = verbose,
187192
...
188193
)

‎R/estimate_means.R

+9
Original file line numberDiff line numberDiff line change
@@ -109,6 +109,12 @@
109109
#' which case `insight::get_transformation()` is called to determine the
110110
#' appropriate transformation-function. Note that no standard errors are returned
111111
#' when transformations are applied.
112+
#' @param keep_iterations If `TRUE`, will keep all iterations (draws) of
113+
#' bootstrapped or Bayesian models. They will be added as additional columns
114+
#' named `iter_1`, `iter_2`, and so on. If `keep_iterations` is a positive
115+
#' number, only as many columns as indicated in `keep_iterations` will be added
116+
#' to the output. You can reshape them to a long format by running
117+
#' [`bayestestR::reshape_iterations()`].
112118
#' @param verbose Use `FALSE` to silence messages and warnings.
113119
#' @param ... Other arguments passed, for instance, to [insight::get_datagrid()],
114120
#' to functions from the **emmeans** or **marginaleffects** package, or to process
@@ -229,6 +235,7 @@ estimate_means <- function(model,
229235
ci = 0.95,
230236
estimate = getOption("modelbased_estimate", "typical"),
231237
transform = NULL,
238+
keep_iterations = FALSE,
232239
backend = getOption("modelbased_backend", "marginaleffects"),
233240
verbose = TRUE,
234241
...) {
@@ -244,6 +251,7 @@ estimate_means <- function(model,
244251
model,
245252
by = by,
246253
predict = predict,
254+
keep_iterations = keep_iterations,
247255
verbose = verbose,
248256
...
249257
)
@@ -257,6 +265,7 @@ estimate_means <- function(model,
257265
ci = ci,
258266
estimate = estimate,
259267
transform = transform,
268+
keep_iterations = keep_iterations,
260269
verbose = verbose,
261270
...
262271
)

‎R/estimate_slopes.R

+3
Original file line numberDiff line numberDiff line change
@@ -124,6 +124,7 @@ estimate_slopes <- function(model,
124124
ci = 0.95,
125125
p_adjust = "none",
126126
transform = NULL,
127+
keep_iterations = FALSE,
127128
backend = getOption("modelbased_backend", "marginaleffects"),
128129
verbose = TRUE,
129130
...) {
@@ -133,6 +134,7 @@ estimate_slopes <- function(model,
133134
model,
134135
trend = trend,
135136
by = by,
137+
keep_iterations = keep_iterations,
136138
verbose = verbose,
137139
...
138140
)
@@ -145,6 +147,7 @@ estimate_slopes <- function(model,
145147
ci = ci,
146148
p_adjust = p_adjust,
147149
transform = transform,
150+
keep_iterations = keep_iterations,
148151
verbose = verbose,
149152
...
150153
)

‎R/format.R

+20-1
Original file line numberDiff line numberDiff line change
@@ -573,7 +573,26 @@ format.marginaleffects_contrasts <- function(x, model = NULL, p_adjust = NULL, c
573573
}
574574

575575
# finally, make sure we have original data types
576-
data.frame(datawizard::data_restoretype(params, model_data))
576+
params <- data.frame(datawizard::data_restoretype(params, model_data))
577+
578+
# add posterior draws?
579+
if (!is.null(attributes(x)$posterior_draws)) {
580+
# how many?
581+
keep_iterations <- attributes(x)$keep_iterations
582+
# check if user wants to keep any posterior draws
583+
if (isTRUE(keep_iterations) || is.numeric(keep_iterations)) {
584+
# reshape draws
585+
posterior_draws <- as.data.frame(attributes(x)$posterior_draws)
586+
# keep all iterations when `TRUE`
587+
if (isTRUE(keep_iterations)) {
588+
keep_iterations <- ncol(posterior_draws)
589+
}
590+
colnames(posterior_draws) <- paste0("iter_", seq_len(ncol(posterior_draws)))
591+
params <- cbind(params, posterior_draws[, 1:keep_iterations, drop = FALSE])
592+
}
593+
}
594+
595+
params
577596
}
578597

579598

‎R/get_emcontrasts.R

+15-1
Original file line numberDiff line numberDiff line change
@@ -23,6 +23,7 @@ get_emcontrasts <- function(model,
2323
predict = NULL,
2424
comparison = "pairwise",
2525
transform = NULL,
26+
keep_iterations = FALSE,
2627
verbose = TRUE,
2728
...) {
2829
# check if available
@@ -88,13 +89,23 @@ get_emcontrasts <- function(model,
8889

8990
out <- emmeans::contrast(estimated, by = emm_by, method = comparison, ...)
9091

92+
# for Bayesian model, keep iterations
93+
if (insight::model_info(model)$is_bayesian) {
94+
attr(out, "posterior_draws") <- insight::get_parameters(estimated)
95+
} else {
96+
keep_iterations <- FALSE
97+
}
98+
9199
attr(out, "contrast") <- my_args$contrast
92100
attr(out, "predict") <- predict
93101
attr(out, "at") <- my_args$by
94102
attr(out, "by") <- my_args$by
95103
attr(out, "focal_terms") <- emm_by
96104
attr(out, "p_adjust") <- list(...)$adjust
97105
attr(out, "comparison") <- comparison
106+
attr(out, "transform") <- TRUE
107+
attr(out, "keep_iterations") <- keep_iterations
108+
98109
out
99110
}
100111

@@ -174,5 +185,8 @@ get_emcontrasts <- function(model,
174185

175186
# Merge levels and rest
176187
out$contrast <- NULL
177-
cbind(level_cols, out)
188+
out <- cbind(level_cols, out)
189+
190+
# add posterior draws?
191+
.add_posterior_draws_emmeans(attributes(estimated), out)
178192
}

‎R/get_emmeans.R

+36-3
Original file line numberDiff line numberDiff line change
@@ -38,6 +38,7 @@ get_emmeans <- function(model,
3838
by = "auto",
3939
predict = NULL,
4040
transform = NULL,
41+
keep_iterations = FALSE,
4142
verbose = TRUE,
4243
...) {
4344
# check if available
@@ -84,10 +85,19 @@ get_emmeans <- function(model,
8485
}
8586
}
8687

88+
# for Bayesian model, keep iterations
89+
if (insight::model_info(model)$is_bayesian) {
90+
attr(estimated, "posterior_draws") <- insight::get_parameters(estimated)
91+
} else {
92+
keep_iterations <- FALSE
93+
}
94+
8795
attr(estimated, "at") <- my_args$by
8896
attr(estimated, "by") <- my_args$by
8997
attr(estimated, "predict") <- predict
9098
attr(estimated, "focal_terms") <- my_args$emmeans_specs
99+
attr(estimated, "transform") <- TRUE
100+
attr(estimated, "keep_iterations") <- keep_iterations
91101

92102
estimated
93103
}
@@ -142,7 +152,6 @@ get_emmeans <- function(model,
142152

143153
# Table formatting emmeans ----------------------------------------------------
144154

145-
146155
.format_emmeans_means <- function(x, model, ci = 0.95, verbose = TRUE, ...) {
147156
predict <- attributes(x)$predict
148157
# Summarize and clean
@@ -166,12 +175,36 @@ get_emmeans <- function(model,
166175
# Restore factor levels
167176
means <- datawizard::data_restoretype(means, insight::get_data(model, verbose = FALSE))
168177

169-
170178
info <- attributes(x)
171179

172180
attr(means, "at") <- info$by
173181
attr(means, "by") <- info$by
174-
means
182+
183+
.add_posterior_draws_emmeans(info, means)
184+
}
185+
186+
187+
# adds posterior draws to output for emmeans objects
188+
.add_posterior_draws_emmeans <- function(info, estimated) {
189+
# add posterior draws?
190+
if (!is.null(info$posterior_draws)) {
191+
# how many?
192+
keep_iterations <- info$keep_iterations
193+
# check if user wants to keep any posterior draws
194+
if (isTRUE(keep_iterations) || is.numeric(keep_iterations)) {
195+
# reshape draws
196+
posterior_draws <- datawizard::data_transpose(info$posterior_draws)
197+
# keep all iterations when `TRUE`
198+
if (isTRUE(keep_iterations)) {
199+
keep_iterations <- ncol(posterior_draws)
200+
}
201+
colnames(posterior_draws) <- paste0("iter_", seq_len(ncol(posterior_draws)))
202+
estimated <- cbind(estimated, posterior_draws[, 1:keep_iterations, drop = FALSE])
203+
}
204+
}
205+
# remove from attributes
206+
attr(estimated, "posterior_draws") <- NULL
207+
estimated
175208
}
176209

177210

‎R/get_emtrends.R

+14-2
Original file line numberDiff line numberDiff line change
@@ -16,6 +16,7 @@
1616
get_emtrends <- function(model,
1717
trend = NULL,
1818
by = NULL,
19+
keep_iterations = FALSE,
1920
verbose = TRUE,
2021
...) {
2122
# check if available
@@ -33,10 +34,19 @@ get_emtrends <- function(model,
3334
...
3435
)
3536

37+
# for Bayesian model, keep iterations
38+
if (insight::model_info(model)$is_bayesian) {
39+
attr(estimated, "posterior_draws") <- insight::get_parameters(estimated)
40+
} else {
41+
keep_iterations <- FALSE
42+
}
43+
3644
attr(estimated, "trend") <- my_args$trend
3745
attr(estimated, "at") <- my_args$by
3846
attr(estimated, "by") <- my_args$by
3947
attr(estimated, "coef_name") <- "Slope"
48+
attr(estimated, "transform") <- TRUE
49+
attr(estimated, "keep_iterations") <- keep_iterations
4050

4151
estimated
4252
}
@@ -83,7 +93,6 @@ get_emtrends <- function(model,
8393

8494
# Formatting ===============================================================
8595

86-
8796
.format_emmeans_slopes <- function(model, estimated, ci, ...) {
8897
# Summarize and clean
8998
if (insight::model_info(model)$is_bayesian) {
@@ -105,5 +114,8 @@ get_emtrends <- function(model,
105114
trends <- datawizard::data_rename(trends, select = c(Slope = "Coefficient"))
106115

107116
# Restore factor levels
108-
datawizard::data_restoretype(trends, insight::get_data(model, verbose = FALSE))
117+
out <- datawizard::data_restoretype(trends, insight::get_data(model, verbose = FALSE))
118+
119+
# add posterior draws?
120+
.add_posterior_draws_emmeans(attributes(estimated), out)
109121
}

0 commit comments

Comments
 (0)