Skip to content

Commit 28b7d74

Browse files
mattansbmattansb
authored
Fix standardization for Bayesian models
Fix std bayes error
2 parents 6241d11 + 192c0a6 commit 28b7d74

File tree

3 files changed

+238
-158
lines changed

3 files changed

+238
-158
lines changed

‎R/extract_parameters.R‎

Lines changed: 84 additions & 32 deletions
Original file line numberDiff line numberDiff line change
@@ -48,6 +48,7 @@
4848
fun_args[["robust"]] <- NULL
4949
fun <- datawizard::standardize
5050
model <- do.call(fun, fun_args)
51+
standardize <- NULL
5152
}
5253

5354
parameters <- insight::get_parameters(
@@ -290,7 +291,7 @@
290291

291292
# ==== Std Coefficients for other methods than "refit"
292293

293-
if (!is.null(standardize) && !isTRUE(standardize == "refit")) {
294+
if (!is.null(standardize)) {
294295
# give minimal attributes required for standardization
295296
temp_pars <- parameters
296297
class(temp_pars) <- c("parameters_model", class(temp_pars))
@@ -775,16 +776,75 @@
775776
verbose = TRUE,
776777
...
777778
) {
779+
if (
780+
isTRUE(test == "all") && (!is.null(standardize) || insight::is_multivariate(model))
781+
) {
782+
exception_type <- ifelse(
783+
is.null(standardize),
784+
"for multivariate models",
785+
"when standardizing"
786+
)
787+
insight::format_error(
788+
sprintf("`test = \"all\"` is not supported %s;", exception_type),
789+
"Please specify the tests you want to perform using the `test` argument."
790+
)
791+
}
792+
793+
# No scale-dependent inferential statistics
794+
if (
795+
!is.null(standardize) &&
796+
any(
797+
c(
798+
"bf",
799+
"bayesfactor",
800+
"bayes_factor",
801+
"rope",
802+
"p_rope",
803+
"equivalence_test",
804+
"equitest"
805+
) %in%
806+
test
807+
)
808+
) {
809+
test <- setdiff(
810+
test,
811+
c(
812+
"bf",
813+
"bayesfactor",
814+
"bayes_factor",
815+
"rope",
816+
"p_rope",
817+
"equivalence_test",
818+
"equitest"
819+
)
820+
)
821+
if (verbose) {
822+
insight::format_warning(
823+
"Scale-dependent inferential statistics (such as `rope` and `bayes_factor`) are not meaningful for standardized parameters",
824+
"These have been removed from the output."
825+
)
826+
}
827+
}
828+
778829
# no ROPE for multi-response models
779830
if (insight::is_multivariate(model) && any(c("rope", "p_rope") %in% test)) {
780831
test <- setdiff(test, c("rope", "p_rope"))
781832
if (verbose) {
782-
insight::format_alert(
833+
insight::format_warning(
783834
"Multivariate response models are not yet supported for tests `rope` and `p_rope`."
784835
)
785836
}
786837
}
787838

839+
if (length(test) == 0) {
840+
test <- NULL
841+
}
842+
843+
if (isTRUE(standardize == "refit")) {
844+
model <- datawizard::standardize(model, verbose = verbose)
845+
standardize <- NULL
846+
}
847+
788848
# MCMCglmm need special handling
789849
if (inherits(model, "MCMCglmm")) {
790850
parameters <- bayestestR::describe_posterior(
@@ -816,36 +876,24 @@
816876
verbose = verbose,
817877
...
818878
)
879+
}
819880

820-
if (!is.null(standardize)) {
821-
# Don't test BF on standardized params
822-
test_no_BF <- test[!test %in% c("bf", "bayesfactor", "bayes_factor")]
823-
if (length(test_no_BF) == 0) {
824-
test_no_BF <- NULL
825-
}
826-
std_post <- standardize_posteriors(model, method = standardize)
827-
std_parameters <- bayestestR::describe_posterior(
828-
std_post,
829-
centrality = centrality,
830-
dispersion = dispersion,
831-
ci = ci,
832-
ci_method = ci_method,
833-
test = test_no_BF,
834-
rope_range = rope_range,
835-
rope_ci = rope_ci,
836-
verbose = verbose,
837-
...
838-
)
881+
if (!is.null(standardize)) {
882+
# give minimal attributes required for standardization
883+
temp_pars <- parameters
884+
class(temp_pars) <- c("parameters_model", class(temp_pars))
885+
attr(temp_pars, "ci") <- ci
886+
attr(temp_pars, "object_name") <- model # pass the model as is (this is a cheat - teehee!)
839887

840-
parameters <- merge(
841-
std_parameters,
842-
parameters[c(
843-
"Parameter",
844-
setdiff(colnames(parameters), colnames(std_parameters))
845-
)],
846-
sort = FALSE
847-
)
848-
}
888+
std_parameters <- standardize_parameters(temp_pars, method = standardize)
889+
890+
parameters <- merge(
891+
std_parameters,
892+
parameters[c("Parameter", setdiff(colnames(parameters), colnames(std_parameters)))],
893+
sort = FALSE
894+
)
895+
896+
parameters <- .NA_inferential_cols(parameters)
849897
}
850898

851899
if (length(ci) > 1) {
@@ -1057,11 +1105,15 @@
10571105
.NA_inferential_cols <- function(pr) {
10581106
# For models where the response is NOT standardized, the (Intercept) is set
10591107
# to NA and so we also need to set all inferential statistics to NA
1060-
rows_to_NA <- pr$Parameter %in% "(Intercept)" | is.na(pr$Std_Coefficient)
1108+
coef_name <- colnames(pr)[startsWith(colnames(pr), "Std_")]
1109+
if (length(coef_name) != 1L) {
1110+
insight::format_error("Wrong number of standardized coefficient columns detected.")
1111+
}
1112+
rows_to_NA <- pr$Parameter == "(Intercept)" | is.na(pr[[coef_name]])
10611113
if (any(rows_to_NA)) {
10621114
# fmt: skip
10631115
cols_not_to_NA <- c(".id", "Parameter", "Component", "Response", "Effects", "Group",
1064-
"CI", "Std_Coefficient")
1116+
"CI", coef_name)
10651117
cols_to_NA <- setdiff(colnames(pr), cols_not_to_NA)
10661118
pr[rows_to_NA, cols_to_NA] <- NA
10671119
}

‎R/methods_coxme.R‎

Lines changed: 40 additions & 32 deletions
Original file line numberDiff line numberDiff line change
@@ -1,24 +1,26 @@
11
#' @export
2-
model_parameters.coxme <- function(model,
3-
ci = 0.95,
4-
ci_method = NULL,
5-
ci_random = NULL,
6-
bootstrap = FALSE,
7-
iterations = 1000,
8-
standardize = NULL,
9-
effects = "all",
10-
group_level = FALSE,
11-
exponentiate = FALSE,
12-
p_adjust = NULL,
13-
vcov = NULL,
14-
vcov_args = NULL,
15-
wb_component = FALSE,
16-
include_info = getOption("parameters_mixed_info", FALSE),
17-
include_sigma = FALSE,
18-
keep = NULL,
19-
drop = NULL,
20-
verbose = TRUE,
21-
...) {
2+
model_parameters.coxme <- function(
3+
model,
4+
ci = 0.95,
5+
ci_method = NULL,
6+
ci_random = NULL,
7+
bootstrap = FALSE,
8+
iterations = 1000,
9+
standardize = NULL,
10+
effects = "all",
11+
group_level = FALSE,
12+
exponentiate = FALSE,
13+
p_adjust = NULL,
14+
vcov = NULL,
15+
vcov_args = NULL,
16+
wb_component = FALSE,
17+
include_info = getOption("parameters_mixed_info", FALSE),
18+
include_sigma = FALSE,
19+
keep = NULL,
20+
drop = NULL,
21+
verbose = TRUE,
22+
...
23+
) {
2224
insight::check_if_installed("lme4")
2325
dots <- list(...)
2426

@@ -27,7 +29,8 @@ model_parameters.coxme <- function(model,
2729
if (isTRUE(bootstrap)) {
2830
ci_method <- "quantile"
2931
} else {
30-
ci_method <- switch(insight::find_statistic(model),
32+
ci_method <- switch(
33+
insight::find_statistic(model),
3134
`t-statistic` = "residual",
3235
"wald"
3336
)
@@ -46,8 +49,17 @@ model_parameters.coxme <- function(model,
4649
ci_method <- insight::validate_argument(
4750
ci_method,
4851
c(
49-
"wald", "normal", "residual", "ml1", "betwithin", "satterthwaite",
50-
"kenward", "kr", "boot", "profile", "uniroot"
52+
"wald",
53+
"normal",
54+
"residual",
55+
"ml1",
56+
"betwithin",
57+
"satterthwaite",
58+
"kenward",
59+
"kr",
60+
"boot",
61+
"profile",
62+
"uniroot"
5163
)
5264
)
5365
}
@@ -88,7 +100,7 @@ model_parameters.coxme <- function(model,
88100

89101
# for refit, we completely refit the model, than extract parameters,
90102
# ci etc. as usual - therefor, we set "standardize" to NULL
91-
if (!is.null(standardize) && standardize == "refit") {
103+
if (isTRUE(standardize == "refit")) {
92104
model <- datawizard::standardize(model, verbose = FALSE)
93105
standardize <- NULL
94106
}
@@ -99,16 +111,13 @@ model_parameters.coxme <- function(model,
99111
if (effects %in% c("fixed", "all")) {
100112
# Processing
101113
if (bootstrap) {
102-
params <- bootstrap_parameters(
103-
model,
104-
iterations = iterations,
105-
ci = ci,
106-
...
107-
)
114+
params <- bootstrap_parameters(model, iterations = iterations, ci = ci, ...)
108115
if (effects != "fixed") {
109116
effects <- "fixed"
110117
if (verbose) {
111-
insight::format_alert("Bootstrapping only returns fixed effects of the mixed model.")
118+
insight::format_alert(
119+
"Bootstrapping only returns fixed effects of the mixed model."
120+
)
112121
}
113122
}
114123
} else {
@@ -183,7 +192,6 @@ model_parameters.coxme <- function(model,
183192
...
184193
)
185194

186-
187195
attr(params, "object_name") <- insight::safe_deparse_symbol(substitute(model))
188196
class(params) <- c("parameters_model", "see_parameters_model", class(params))
189197

0 commit comments

Comments
 (0)