Skip to content

Commit

Permalink
Draft plotting simulated residuals (#329)
Browse files Browse the repository at this point in the history
* Draft plotting simulated residuals

* draft plot for check_residuals

* fix

* docs

* include in check_model

* version

* lintr

* fix

* add transform argument

* use latest performance

* fix

* fix

* fix if qqplotr is missing
  • Loading branch information
strengejacke authored Mar 16, 2024
1 parent 4736d08 commit cb079b7
Show file tree
Hide file tree
Showing 9 changed files with 280 additions and 111 deletions.
4 changes: 3 additions & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
Type: Package
Package: see
Title: Model Visualisation Toolbox for 'easystats' and 'ggplot2'
Version: 0.8.2.4
Version: 0.8.2.5
Authors@R:
c(person(given = "Daniel",
family = "Lüdecke",
Expand Down Expand Up @@ -75,6 +75,7 @@ Imports:
Suggests:
brms,
curl,
DHARMa,
emmeans,
factoextra,
ggdist,
Expand Down Expand Up @@ -118,3 +119,4 @@ Config/Needs/website:
r-lib/pkgdown,
easystats/easystatstemplate
Config/rcmdcheck/ignore-inconsequential-notes: true
Remotes: easystats/performance#643
2 changes: 2 additions & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -38,6 +38,7 @@ S3method(plot,see_check_model)
S3method(plot,see_check_normality)
S3method(plot,see_check_outliers)
S3method(plot,see_check_overdisp)
S3method(plot,see_check_residuals)
S3method(plot,see_compare_parameters)
S3method(plot,see_compare_performance)
S3method(plot,see_effectsize_table)
Expand All @@ -64,6 +65,7 @@ S3method(plot,see_parameters_sem)
S3method(plot,see_parameters_simulate)
S3method(plot,see_performance_pp_check)
S3method(plot,see_performance_roc)
S3method(plot,see_performance_simres)
S3method(plot,see_point_estimate)
S3method(plot,see_rope)
S3method(plot,see_si)
Expand Down
5 changes: 5 additions & 0 deletions R/data_plot.R
Original file line number Diff line number Diff line change
Expand Up @@ -148,6 +148,11 @@ add_plot_attributes <- function(x) {
obj_name <- attr(x, "object_name", exact = TRUE)
dat <- NULL

# for simulated residuals, we save all necessary information in the object
if (inherits(x, "performance_simres")) {
return(x$fittedModel)
}

if (!is.null(obj_name)) {
# first try, parent frame
dat <- tryCatch(get(obj_name, envir = parent.frame()), error = function(e) NULL)
Expand Down
40 changes: 27 additions & 13 deletions R/plot.check_model.R
Original file line number Diff line number Diff line change
Expand Up @@ -165,19 +165,33 @@ plot.see_check_model <- function(x,
}

if ("QQ" %in% names(x) && !is.null(x$QQ) && any(c("qq", "all") %in% check)) {
p$QQ <- .plot_diag_qq(
x$QQ,
size_point,
size_line,
alpha_level = alpha_level,
detrend = detrend,
theme_style = style,
colors = colors,
dot_alpha_level = dot_alpha_level,
show_dots = TRUE, # qq-plots w/o dots makes no sense
model_info = model_info,
model_class = model_class
)
if (inherits(x$QQ, "performance_simres")) {
p$QQ <- plot(
x$QQ,
size_line = size_line,
size_point = size_point,
alpha = alpha_level,
dot_alpha = dot_alpha_level,
colors = colors,
detrend = detrend,
style = style

)
} else {
p$QQ <- .plot_diag_qq(
x$QQ,
size_point,
size_line,
alpha_level = alpha_level,
detrend = detrend,
theme_style = style,
colors = colors,
dot_alpha_level = dot_alpha_level,
show_dots = TRUE, # qq-plots w/o dots makes no sense
model_info = model_info,
model_class = model_class
)
}
}

if ("NORM" %in% names(x) && !is.null(x$NORM) && any(c("normality", "all") %in% check)) {
Expand Down
44 changes: 22 additions & 22 deletions R/plot.parameters_model.R
Original file line number Diff line number Diff line change
Expand Up @@ -595,28 +595,28 @@ plot.see_parameters_model <- function(x,

.meta_measure <- function(meta_measure) {
switch(meta_measure,
"MD" = "Raw Mean Difference",
"SMDH" = ,
"SMD" = "Standardized Mean Difference",
"ROM" = "Log transformed Ratio of Means",
"D2ORL" = ,
"D2ORN" = "Transformed Standardized Mean Difference",
"UCOR" = ,
"COR" = "Raw Correlation Coefficient",
"ZCOR" = "Z transformed Correlation Coefficient",
"PHI" = "Phi Coefficient",
"RR" = "Log Risk Ratio",
"OR" = "Log Odds Ratio",
"RD" = "Risk Difference",
"AS" = "Root transformed Risk Difference",
"PETO" = "Peto's Log Odds Ratio",
"PBIT" = "Standardized Mean Difference (Probit-transformed)",
"OR2DL" = ,
"OR2DN" = "Standardized Mean Difference (Odds Ratio-transformed)",
"IRR" = "Log Incidence Rate Ratio",
"IRD" = "Incidence Rate Difference",
"IRSD" = "Square Root transformed Incidence Rate Difference",
"GEN" = "Generic Estimate",
MD = "Raw Mean Difference",
SMDH = ,
SMD = "Standardized Mean Difference",
ROM = "Log transformed Ratio of Means",
D2ORL = ,
D2ORN = "Transformed Standardized Mean Difference",
UCOR = ,
COR = "Raw Correlation Coefficient",
ZCOR = "Z transformed Correlation Coefficient",
PHI = "Phi Coefficient",
RR = "Log Risk Ratio",
OR = "Log Odds Ratio",
RD = "Risk Difference",
AS = "Root transformed Risk Difference",
PETO = "Peto's Log Odds Ratio",
PBIT = "Standardized Mean Difference (Probit-transformed)",
OR2DL = ,
OR2DN = "Standardized Mean Difference (Odds Ratio-transformed)",
IRR = "Log Incidence Rate Ratio",
IRD = "Incidence Rate Difference",
IRSD = "Square Root transformed Incidence Rate Difference",
GEN = "Generic Estimate",
"Estimate"
)
}
133 changes: 133 additions & 0 deletions R/plot.performance_simres.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,133 @@
#' Plot method for check model for (non-)normality of residuals
#'
#' The `plot()` method for the `performance::check_residuals()` resp.
#' `performance::simulate_residuals()` function.
#'
#' @param transform Function to transform the residuals. If `NULL` (default),
#' no transformation is applied and uniformly distributed residuals are expected.
#' See argument `quantileFuntion` in `?DHARMa:::residuals.DHARMa` for more details.
#'
#' @inheritParams plot.see_check_normality
#' @inheritParams plot.see_check_model
#'
#' @return A ggplot2-object.
#'
#' @seealso See also the vignette about [`check_model()`](https://easystats.github.io/performance/articles/check_model.html).
#'
#' @examplesIf insight::check_if_installed("performance", "0.10.9.7") && require("glmmTMB") && require("qqplotr") && require("DHARMa")
#' data(Salamanders, package = "glmmTMB")
#' model <- glmmTMB::glmmTMB(
#' count ~ mined + spp + (1 | site),
#' family = poisson(),
#' data = Salamanders
#' )
#' simulated_residuals <- performance::simulate_residuals(model)
#' plot(simulated_residuals)
#'
#' # or
#' simulated_residuals <- performance::simulate_residuals(model)
#' result <- performance::check_residuals(simulated_residuals)
#' plot(result)
#'
#' @export
plot.see_performance_simres <- function(x,
size_line = 0.8,
size_point = 1,
alpha = 0.2,
dot_alpha = 0.8,
colors = c("#3aaf85", "#1b6ca8"),
detrend = FALSE,
transform = NULL,
style = theme_lucid,
...) {
dp <- list(min = 0, max = 1, lower.tail = TRUE, log.p = FALSE)

# need DHARMa to be installed
insight::check_if_installed("DHARMa")

# extract data, if from check_residuals
if (inherits(x, "see_check_residuals")) {
x <- attributes(x)$data
}

if (is.null(transform)) {
res <- stats::residuals(x)
} else {
res <- stats::residuals(x, quantileFunction = transform)
}

# base plot information
gg_init <- ggplot2::ggplot(
data.frame(scaled_residuals = res),
ggplot2::aes(sample = .data$scaled_residuals)
)

# when we have package qqplotr, we can add confidence bands
if (requireNamespace("qqplotr", quietly = TRUE)) {
qq_stuff <- list(
qqplotr::stat_qq_band(
distribution = "unif",
dparams = list(min = 0, max = 1),
alpha = alpha,
detrend = detrend
),
qqplotr::stat_qq_line(
distribution = "unif",
dparams = dp,
size = size_line,
colour = colors[1],
detrend = detrend
),
qqplotr::stat_qq_point(
distribution = "unif",
dparams = dp,
size = size_point,
alpha = dot_alpha,
colour = colors[2],
detrend = detrend
)
)
if (detrend) {
y_lab <- "Sample Quantile Deviations"
} else {
y_lab <- "Sample Quantiles"
}
} else {
insight::format_alert("For confidence bands, please install `qqplotr`.")
qq_stuff <- list(
ggplot2::geom_qq(
shape = 16,
stroke = 0,
distribution = stats::qunif,
dparams = dp,
size = size_point,
colour = colors[2]
),
ggplot2::geom_qq_line(
linewidth = size_line,
colour = colors[1],
na.rm = TRUE,
distribution = stats::qunif,
dparams = dp
)
)
y_lab <- "Sample Quantiles"
}

gg_init +
qq_stuff +
ggplot2::labs(
title = "Uniformity of Residuals",
subtitle = "Dots should fall along the line",
x = "Standard Uniform Distribution Quantiles",
y = y_lab
) +
style(
base_size = 10,
plot.title.space = 3,
axis.title.space = 5
)
}

#' @export
plot.see_check_residuals <- plot.see_performance_simres
29 changes: 4 additions & 25 deletions man/geom_violindot.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

63 changes: 13 additions & 50 deletions man/geom_violinhalf.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

Loading

0 comments on commit cb079b7

Please sign in to comment.