Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -159,7 +159,7 @@ Suggests:
withr (>= 3.0.0)
Encoding: UTF-8
Language: en-US
RoxygenNote: 7.3.2
RoxygenNote: 7.3.3
Roxygen: list(markdown = TRUE)
Config/testthat/edition: 3
Config/testthat/parallel: true
Expand Down
46 changes: 30 additions & 16 deletions R/binned_residuals.R
Original file line number Diff line number Diff line change
Expand Up @@ -75,16 +75,18 @@
#' }
#'
#' @export
binned_residuals <- function(model,
term = NULL,
n_bins = NULL,
show_dots = NULL,
ci = 0.95,
ci_type = "exact",
residuals = "deviance",
iterations = 1000,
verbose = TRUE,
...) {
binned_residuals <- function(
model,
term = NULL,
n_bins = NULL,
show_dots = NULL,
ci = 0.95,
ci_type = "exact",
residuals = "deviance",
iterations = 1000,
verbose = TRUE,
...
) {
ci_type <- insight::validate_argument(
ci_type,
c("exact", "gaussian", "boot")
Expand All @@ -98,7 +100,9 @@ binned_residuals <- function(model,
if (isFALSE(insight::model_info(model)$is_bernoulli)) {
ci_type <- "gaussian"
if (verbose) {
insight::format_alert("Using `ci_type = \"gaussian\"` because model is not bernoulli.")
insight::format_alert(
"Using `ci_type = \"gaussian\"` because model is not bernoulli."
)
}
}

Expand All @@ -121,18 +125,23 @@ binned_residuals <- function(model,
y0 <- .recode_to_zero(insight::get_response(model, verbose = FALSE))

# calculate residuals
y <- switch(residuals,
y <- switch(
residuals,
response = y0 - fitted_values,
pearson = .safe((y0 - fitted_values) / sqrt(fitted_values * (1 - fitted_values))),
deviance = .safe(stats::residuals(model, type = "deviance"))
)

# make sure we really have residuals
if (is.null(y)) {
insight::format_error("Could not calculate residuals. Try using `residuals = \"response\"`.")
insight::format_error(
"Could not calculate residuals. Try using `residuals = \"response\"`."
)
}

if (is.null(n_bins)) n_bins <- round(sqrt(length(pred)))
if (is.null(n_bins)) {
n_bins <- round(sqrt(length(pred)))
}

breaks.index <- floor(length(pred) * (1:(n_bins - 1)) / n_bins)
breaks <- unique(c(-Inf, sort(pred)[breaks.index], Inf))
Expand All @@ -151,8 +160,13 @@ binned_residuals <- function(model,
if (n == 0) {
conf_int <- stats::setNames(c(NA, NA), c("CI_low", "CI_high"))
} else {
conf_int <- switch(ci_type,
gaussian = stats::qnorm(c((1 - ci) / 2, (1 + ci) / 2), mean = ybar, sd = sdev / sqrt(n)),
conf_int <- switch(
ci_type,
gaussian = stats::qnorm(
c((1 - ci) / 2, (1 + ci) / 2),
mean = ybar,
sd = sdev / sqrt(n)
),
exact = {
out <- stats::binom.test(sum(y0[items]), n)$conf.int
# center CIs around point estimate
Expand Down
4 changes: 3 additions & 1 deletion R/check_autocorrelation.R
Original file line number Diff line number Diff line change
Expand Up @@ -53,7 +53,9 @@ check_autocorrelation.default <- function(x, nsim = 1000, ...) {

#' @export
plot.check_autocorrelation <- function(x, ...) {
insight::format_warning("There is currently no `plot()` method for `check_autocorrelation()`.")
insight::format_warning(
"There is currently no `plot()` method for `check_autocorrelation()`."
)
}


Expand Down
24 changes: 16 additions & 8 deletions R/check_clusterstructure.R
Original file line number Diff line number Diff line change
Expand Up @@ -37,10 +37,7 @@
#' assessment of (cluster) tendency. In Proceedings of the 2002 International
#' Joint Conference on Neural Networks. IJCNN02 (3), 2225-2230. IEEE.
#' @export
check_clusterstructure <- function(x,
standardize = TRUE,
distance = "euclidean",
...) {
check_clusterstructure <- function(x, standardize = TRUE, distance = "euclidean", ...) {
if (standardize) {
x <- as.data.frame(scale(x))
}
Expand All @@ -64,13 +61,22 @@ check_clusterstructure <- function(x,

out <- list(
H = H,
dissimilarity_matrix = .clusterstructure_dm(x, distance = distance, method = "ward.D2")
dissimilarity_matrix = .clusterstructure_dm(
x,
distance = distance,
method = "ward.D2"
)
)

attr(out, "text") <- res_text
attr(out, "color") <- color
attr(out, "title") <- "Clustering tendency"
class(out) <- c("see_check_clusterstructure", "check_clusterstructure", "easystats_check", class(out))
class(out) <- c(
"see_check_clusterstructure",
"check_clusterstructure",
"easystats_check",
class(out)
)
out
}

Expand All @@ -80,8 +86,10 @@ plot.check_clusterstructure <- function(x, ...) {
# Can be reimplemented with ggplot in see
stats::heatmap(
x$dissimilarity_matrix,
Rowv = NA, Colv = NA,
labRow = FALSE, labCol = FALSE,
Rowv = NA,
Colv = NA,
labRow = FALSE,
labCol = FALSE,
col = grDevices::colorRampPalette(c("#2196F3", "#FAFAFA", "#E91E63"))(100)
)
}
Expand Down
110 changes: 71 additions & 39 deletions R/check_collinearity.R
Original file line number Diff line number Diff line change
Expand Up @@ -313,11 +313,13 @@

#' @rdname check_collinearity
#' @export
check_collinearity.glmmTMB <- function(x,
component = "all",
ci = 0.95,
verbose = TRUE,
...) {
check_collinearity.glmmTMB <- function(
x,
component = "all",
ci = 0.95,
verbose = TRUE,
...
) {
component <- insight::validate_argument(
component,
c("all", "conditional", "count", "zi", "zero_inflated")
Expand All @@ -327,11 +329,13 @@


#' @export
check_collinearity.MixMod <- function(x,
component = "all",
ci = 0.95,
verbose = TRUE,
...) {
check_collinearity.MixMod <- function(
x,
component = "all",
ci = 0.95,
verbose = TRUE,
...
) {
component <- insight::validate_argument(
component,
c("all", "conditional", "count", "zi", "zero_inflated")
Expand All @@ -341,11 +345,13 @@


#' @export
check_collinearity.hurdle <- function(x,
component = "all",
ci = 0.95,
verbose = verbose,
...) {
check_collinearity.hurdle <- function(
x,
component = "all",
ci = 0.95,
verbose = verbose,
...
) {
component <- insight::validate_argument(
component,
c("all", "conditional", "count", "zi", "zero_inflated")
Expand All @@ -355,11 +361,13 @@


#' @export
check_collinearity.zeroinfl <- function(x,
component = "all",
ci = 0.95,
verbose = verbose,
...) {
check_collinearity.zeroinfl <- function(
x,
component = "all",
ci = 0.95,
verbose = verbose,
...
) {
component <- insight::validate_argument(
component,
c("all", "conditional", "count", "zi", "zero_inflated")
Expand All @@ -369,11 +377,13 @@


#' @export
check_collinearity.zerocount <- function(x,
component = "all",
ci = 0.95,
verbose = verbose,
...) {
check_collinearity.zerocount <- function(
x,
component = "all",
ci = 0.95,
verbose = verbose,
...
) {
component <- insight::validate_argument(
component,
c("all", "conditional", "count", "zi", "zero_inflated")
Expand All @@ -385,11 +395,17 @@
# utilities ---------------------------------

.check_collinearity_zi_model <- function(x, component, ci = 0.95, verbose = TRUE) {
if (component == "count") component <- "conditional"
if (component == "zi") component <- "zero_inflated"
if (component == "count") {
component <- "conditional"
}
if (component == "zi") {
component <- "zero_inflated"
}

mi <- insight::model_info(x, verbose = FALSE)
if (!mi$is_zero_inflated) component <- "conditional"
if (!mi$is_zero_inflated) {
component <- "conditional"
}

if (component == "all") {
cond <- .check_collinearity(x, "conditional", ci = ci, verbose = verbose)
Expand Down Expand Up @@ -439,7 +455,10 @@
if (isTRUE(verbose)) {
insight::format_alert(
paste(
sprintf("Could not extract the variance-covariance matrix for the %s component of the model.", component),
sprintf(
"Could not extract the variance-covariance matrix for the %s component of the model.",
component
),
"Please try to run `vcov(model)`, which may help identifying the problem."
)
)
Expand All @@ -453,13 +472,15 @@
if (is.null(term_assign) || all(is.na(term_assign))) {
if (verbose) {
insight::format_alert(
sprintf("Could not extract model terms for the %s component of the model.", component)
sprintf(
"Could not extract model terms for the %s component of the model.",
component
)
)
}
return(NULL)
}


# we have rank-deficiency here. remove NA columns from assignment
if (isTRUE(attributes(v)$rank_deficient) && !is.null(attributes(v)$na_columns_index)) {
term_assign <- term_assign[-attributes(v)$na_columns_index]
Expand All @@ -482,9 +503,11 @@

# hurdle or zeroinfl model can have no zero-inflation formula, in which case
# we have the same formula as for conditional formula part
if (inherits(x, c("hurdle", "zeroinfl", "zerocount")) &&
component == "zero_inflated" &&
is.null(f[["zero_inflated"]])) {
if (
inherits(x, c("hurdle", "zeroinfl", "zerocount")) &&
component == "zero_inflated" &&
is.null(f[["zero_inflated"]])
) {
f$zero_inflated <- f$conditional
}

Expand All @@ -503,13 +526,16 @@
if (n.terms < 2) {
if (isTRUE(verbose)) {
insight::format_alert(
sprintf("Not enough model terms in the %s part of the model to check for multicollinearity.", component)
sprintf(
"Not enough model terms in the %s part of the model to check for multicollinearity.",
component
)
)
}
return(NULL)
}

R <- stats::cov2cor(v)

Check warning on line 538 in R/check_collinearity.R

View workflow job for this annotation

GitHub Actions / lint / lint

file=R/check_collinearity.R,line=538,col=3,[object_overwrite_linter] 'R' is an exported object from package 'tools'. Avoid re-using such symbols.

Check warning on line 538 in R/check_collinearity.R

View workflow job for this annotation

GitHub Actions / lint-changed-files / lint-changed-files

file=R/check_collinearity.R,line=538,col=3,[object_overwrite_linter] 'R' is an exported object from package 'tools'. Avoid re-using such symbols.
detR <- det(R)

result <- vector("numeric")
Expand Down Expand Up @@ -639,17 +665,20 @@
tryCatch(
{
if (inherits(x, c("hurdle", "zeroinfl", "zerocount"))) {
term_assign <- switch(component,
term_assign <- switch(
component,
conditional = attr(insight::get_modelmatrix(x, model = "count"), "assign"),
zero_inflated = attr(insight::get_modelmatrix(x, model = "zero"), "assign")
)
} else if (inherits(x, "glmmTMB")) {
term_assign <- switch(component,
term_assign <- switch(
component,
conditional = attr(insight::get_modelmatrix(x), "assign"),
zero_inflated = .zi_term_assignment(x, component, verbose = verbose)
)
} else if (inherits(x, "MixMod")) {
term_assign <- switch(component,
term_assign <- switch(
component,
conditional = attr(insight::get_modelmatrix(x, type = "fixed"), "assign"),
zero_inflated = attr(insight::get_modelmatrix(x, type = "zi_fixed"), "assign")
)
Expand Down Expand Up @@ -692,7 +721,10 @@
}))

if (insight::is_gam_model(x)) {
model_params <- as.vector(unlist(insight::find_parameters(x)[c(component, "smooth_terms")]))
model_params <- as.vector(unlist(insight::find_parameters(x)[c(
component,
"smooth_terms"
)]))
} else {
model_params <- insight::find_parameters(x)[[component]]
}
Expand Down
Loading
Loading