Skip to content

Commit 04afa5d

Browse files
strengejackestrengejacke
committed
air
1 parent eb02e37 commit 04afa5d

110 files changed

Lines changed: 3560 additions & 1027 deletions

File tree

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

‎R/check_homogeneity.R‎

Lines changed: 30 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -71,14 +71,18 @@ check_homogeneity.default <- function(x, method = "bartlett", ...) {
7171
)
7272

7373
if (is.null(check)) {
74-
insight::print_color("'check_homogeneity()' cannot perform check for normality. Please specify the 'method'-argument for the test of equal variances.\n", "red") # nolint
74+
insight::print_color(
75+
"'check_homogeneity()' cannot perform check for normality. Please specify the 'method'-argument for the test of equal variances.\n",
76+
"red"
77+
) # nolint
7578
return(NULL)
7679
}
7780

7881
method <- ifelse(check < 0.05, "fligner", "bartlett")
7982
}
8083

81-
if (method == "fligner") { # nolint
84+
if (method == "fligner") {
85+
# nolint
8286
r <- stats::fligner.test(f, data = insight::get_data(x, verbose = FALSE))
8387
p.val <- r$p.value
8488
} else if (method == "bartlett") {
@@ -90,8 +94,8 @@ check_homogeneity.default <- function(x, method = "bartlett", ...) {
9094
p.val <- r$`Pr(>F)`
9195
}
9296

93-
94-
method.string <- switch(method,
97+
method.string <- switch(
98+
method,
9599
bartlett = "Bartlett Test",
96100
fligner = "Fligner-Killeen Test",
97101
levene = "Levene's Test"
@@ -115,9 +119,23 @@ print.check_homogeneity <- function(x, ...) {
115119
insight::format_warning(paste0("Could not perform ", method.string, "."))
116120
invisible(NULL)
117121
} else if (x < 0.05) {
118-
insight::print_color(sprintf("Warning: Variances differ between groups (%s, p = %.3f).\n", method.string, x), "red")
122+
insight::print_color(
123+
sprintf(
124+
"Warning: Variances differ between groups (%s, p = %.3f).\n",
125+
method.string,
126+
x
127+
),
128+
"red"
129+
)
119130
} else {
120-
insight::print_color(sprintf("OK: There is not clear evidence for different variances across groups (%s, p = %.3f).\n", method.string, x), "green") # nolint
131+
insight::print_color(
132+
sprintf(
133+
"OK: There is not clear evidence for different variances across groups (%s, p = %.3f).\n",
134+
method.string,
135+
x
136+
),
137+
"green"
138+
) # nolint
121139
}
122140
invisible(x)
123141
}
@@ -138,11 +156,15 @@ check_homogeneity.afex_aov <- function(x, method = "levene", ...) {
138156
insight::check_if_installed("car")
139157

140158
if (tolower(method) != "levene") {
141-
insight::format_alert("Only Levene's test for homogeneity supported for `afex_aov()`.")
159+
insight::format_alert(
160+
"Only Levene's test for homogeneity supported for `afex_aov()`."
161+
)
142162
}
143163

144164
if (length(attr(x, "between")) == 0) {
145-
insight::format_error("Levene test is only aplicable to ANOVAs with between-subjects factors.")
165+
insight::format_error(
166+
"Levene test is only aplicable to ANOVAs with between-subjects factors."
167+
)
146168
}
147169

148170
long_data <- x$data$long # Use this to also get id column

‎R/check_model_diagnostics.R‎

Lines changed: 64 additions & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -66,7 +66,10 @@
6666
return(NULL)
6767
}
6868

69-
if (inherits(model, c("glm", "glmerMod")) || (inherits(model, "glmmTMB") && isFALSE(model_info$is_linear))) {
69+
if (
70+
inherits(model, c("glm", "glmerMod")) ||
71+
(inherits(model, "glmmTMB") && isFALSE(model_info$is_linear))
72+
) {
7073
fitted_ <- stats::qnorm((stats::ppoints(length(res_)) + 1) / 2)
7174
} else {
7275
fitted_ <- stats::fitted(model)
@@ -89,7 +92,12 @@
8992

9093
# prepare data for random effects QQ plot ----------------------------------
9194

92-
.model_diagnostic_ranef_qq <- function(model, level = 0.95, model_info = NULL, verbose = TRUE) {
95+
.model_diagnostic_ranef_qq <- function(
96+
model,
97+
level = 0.95,
98+
model_info = NULL,
99+
verbose = TRUE
100+
) {
93101
# check if we have mixed model
94102
if (is.null(model_info) || !model_info$is_mixed) {
95103
return(NULL)
@@ -110,7 +118,6 @@
110118
}
111119
)
112120

113-
114121
se <- tryCatch(
115122
suppressWarnings(lapply(re, function(.x) {
116123
pv <- attr(.x, var_attr, exact = TRUE)
@@ -124,28 +131,34 @@
124131

125132
if (is.null(se)) {
126133
if (verbose) {
127-
insight::format_alert("Could not compute standard errors from random effects for diagnostic plot.")
134+
insight::format_alert(
135+
"Could not compute standard errors from random effects for diagnostic plot."
136+
)
128137
}
129138
return(NULL)
130139
}
131140

132-
133-
Map(function(.re, .se) {
134-
ord <- unlist(lapply(.re, order)) + rep((0:(ncol(.re) - 1)) * nrow(.re), each = nrow(.re))
135-
136-
df.y <- unlist(.re)[ord]
137-
df.ci <- stats::qnorm((1 + level) / 2) * .se[ord]
138-
139-
data.frame(
140-
x = rep(stats::qnorm(stats::ppoints(nrow(.re))), ncol(.re)),
141-
y = df.y,
142-
conf.low = df.y - df.ci,
143-
conf.high = df.y + df.ci,
144-
facet = gl(ncol(.re), nrow(.re), labels = names(.re)),
145-
stringsAsFactors = FALSE,
146-
row.names = NULL
147-
)
148-
}, re, se)
141+
Map(
142+
function(.re, .se) {
143+
ord <- unlist(lapply(.re, order)) +
144+
rep((0:(ncol(.re) - 1)) * nrow(.re), each = nrow(.re))
145+
146+
df.y <- unlist(.re)[ord]
147+
df.ci <- stats::qnorm((1 + level) / 2) * .se[ord]
148+
149+
data.frame(
150+
x = rep(stats::qnorm(stats::ppoints(nrow(.re))), ncol(.re)),
151+
y = df.y,
152+
conf.low = df.y - df.ci,
153+
conf.high = df.y + df.ci,
154+
facet = gl(ncol(.re), nrow(.re), labels = names(.re)),
155+
stringsAsFactors = FALSE,
156+
row.names = NULL
157+
)
158+
},
159+
re,
160+
se
161+
)
149162
}
150163

151164

@@ -163,7 +176,11 @@
163176
}
164177

165178
dat <- as.data.frame(bayestestR::estimate_density(r))
166-
dat$curve <- stats::dnorm(seq(min(dat$x), max(dat$x), length.out = nrow(dat)), mean(r), stats::sd(r))
179+
dat$curve <- stats::dnorm(
180+
seq(min(dat$x), max(dat$x), length.out = nrow(dat)),
181+
mean(r),
182+
stats::sd(r)
183+
)
167184
dat
168185
}
169186

@@ -198,7 +215,9 @@
198215
)
199216
plot_data$Index <- seq_len(nrow(plot_data))
200217
plot_data$Influential <- "OK"
201-
plot_data$Influential[abs(plot_data$Cooks_Distance) >= max(cook_levels)] <- "Influential"
218+
plot_data$Influential[
219+
abs(plot_data$Cooks_Distance) >= max(cook_levels)
220+
] <- "Influential"
202221

203222
attr(plot_data, "cook_levels") <- cook_levels
204223
attr(plot_data, "n_params") <- n_params
@@ -304,7 +323,8 @@
304323
d$V <- insight::get_sigma(model)^2 * stats::family(model)$variance(predicted)
305324
} else {
306325
# for nbinom2, "sigma()" has "inverse meaning" (see #654)
307-
d$V <- (1 / insight::get_sigma(model)^2) * stats::family(model)$variance(predicted)
326+
d$V <- (1 / insight::get_sigma(model)^2) *
327+
stats::family(model)$variance(predicted)
308328
}
309329
} else {
310330
## FIXME: this is not correct for glm.nb models?
@@ -332,7 +352,10 @@
332352
}
333353
d$Prob <- stats::predict(model, type = ptype)
334354
d$Disp <- insight::get_sigma(model)
335-
d$V <- predicted * (1 + predicted / d$Disp) * (1 - d$Prob) * (1 + predicted * (1 + predicted / d$Disp) * d$Prob) # nolint
355+
d$V <- predicted *
356+
(1 + predicted / d$Disp) *
357+
(1 - d$Prob) *
358+
(1 + predicted * (1 + predicted / d$Disp) * d$Prob) # nolint
336359
}
337360

338361
# data for zero-inflated negative binomial models with dispersion
@@ -345,7 +368,10 @@
345368
}
346369
d$Prob <- stats::predict(model, type = ptype)
347370
d$Disp <- stats::predict(model, type = "disp")
348-
d$V <- predicted * (1 + predicted / d$Disp) * (1 - d$Prob) * (1 + predicted * (1 + predicted / d$Disp) * d$Prob) # nolint
371+
d$V <- predicted *
372+
(1 + predicted / d$Disp) *
373+
(1 - d$Prob) *
374+
(1 + predicted * (1 + predicted / d$Disp) * d$Prob) # nolint
349375
}
350376

351377
d
@@ -376,7 +402,8 @@
376402
d$V <- insight::get_sigma(model)^2 * stats::family(model)$variance(d$Predicted)
377403
} else {
378404
# for nbinom2, "sigma()" has "inverse meaning" (see #654)
379-
d$V <- (1 / insight::get_sigma(model)^2) * stats::family(model)$variance(d$Predicted)
405+
d$V <- (1 / insight::get_sigma(model)^2) *
406+
stats::family(model)$variance(d$Predicted)
380407
}
381408
} else {
382409
## FIXME: this is not correct for glm.nb models?
@@ -415,7 +442,10 @@
415442
}
416443
d$Prob <- stats::predict(model, type = ptype)
417444
d$Disp <- insight::get_sigma(model)
418-
d$V <- d$Predicted * (1 + d$Predicted / d$Disp) * (1 - d$Prob) * (1 + d$Predicted * (1 + d$Predicted / d$Disp) * d$Prob) # nolint
445+
d$V <- d$Predicted *
446+
(1 + d$Predicted / d$Disp) *
447+
(1 - d$Prob) *
448+
(1 + d$Predicted * (1 + d$Predicted / d$Disp) * d$Prob) # nolint
419449
d$StdRes <- insight::get_residuals(model, type = "pearson")
420450
}
421451

@@ -431,7 +461,10 @@
431461
}
432462
d$Prob <- stats::predict(model, type = ptype)
433463
d$Disp <- stats::predict(model, type = "disp")
434-
d$V <- d$Predicted * (1 + d$Predicted / d$Disp) * (1 - d$Prob) * (1 + d$Predicted * (1 + d$Predicted / d$Disp) * d$Prob) # nolint
464+
d$V <- d$Predicted *
465+
(1 + d$Predicted / d$Disp) *
466+
(1 - d$Prob) *
467+
(1 + d$Predicted * (1 + d$Predicted / d$Disp) * d$Prob) # nolint
435468
d$StdRes <- insight::get_residuals(model, type = "pearson")
436469
}
437470

@@ -446,7 +479,8 @@
446479
return(1)
447480
}
448481
betad <- model$fit$par["betadisp"]
449-
switch(faminfo$family,
482+
switch(
483+
faminfo$family,
450484
gaussian = exp(0.5 * betad),
451485
Gamma = exp(-0.5 * betad),
452486
exp(betad)

0 commit comments

Comments
 (0)