Skip to content

Commit

Permalink
draft plot method
Browse files Browse the repository at this point in the history
  • Loading branch information
strengejacke committed Oct 27, 2023
1 parent 38dde0d commit 0e50fe8
Show file tree
Hide file tree
Showing 2 changed files with 21 additions and 7 deletions.
9 changes: 7 additions & 2 deletions R/data_plot.R
Original file line number Diff line number Diff line change
Expand Up @@ -140,11 +140,16 @@ add_plot_attributes <- function(x) {


#' @keywords internal
.retrieve_data <- function(x) {
.retrieve_data <- function(x) {

Check warning on line 143 in R/data_plot.R

View workflow job for this annotation

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

file=R/data_plot.R,line=143,col=32,[trailing_whitespace_linter] Trailing whitespace is superfluous.

Check warning on line 143 in R/data_plot.R

View workflow job for this annotation

GitHub Actions / lint / lint

file=R/data_plot.R,line=143,col=32,[trailing_whitespace_linter] Trailing whitespace is superfluous.
# retrieve model
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(attributes(x)$model)
}

if (!is.null(obj_name)) {
# first try, parent frame
dat <- tryCatch(get(obj_name, envir = parent.frame()), error = function(e) NULL)
Expand All @@ -156,7 +161,7 @@ add_plot_attributes <- function(x) {

if (is.null(dat)) {
# last try
model <- .dynGet(obj_name, ifnotfound = NULL)
dat <- .dynGet(obj_name, ifnotfound = NULL)
}
}

Expand Down
19 changes: 14 additions & 5 deletions R/plot.check_normality.R
Original file line number Diff line number Diff line change
Expand Up @@ -70,8 +70,9 @@ plot.see_check_normality <- function(x,
} else {
if (type == "qq") {
model_info <- attributes(x)$model_info
if (inhertis(x, "performance_simres")) {
dat <- stats::na.omit(data.frame(y = model))
if (inherits(x, "performance_simres")) {
dat <- stats::na.omit(data.frame(y = attributes(x)$data))
model_info$is_simulated_residuals <- TRUE
} else if (inherits(model, c("lme", "lmerMod", "merMod", "glmmTMB", "afex_aov", "BFBayesFactor"))) {
res_ <- suppressMessages(sort(stats::residuals(model), na.last = NA))
dat <- stats::na.omit(data.frame(y = res_))
Expand All @@ -95,7 +96,11 @@ plot.see_check_normality <- function(x,
method = method
)
} else if (type == "density") {
r <- suppressMessages(stats::residuals(model))
if (inherits(x, "performance_simres")) {
r <- attributes(x)$data
} else {
r <- suppressMessages(stats::residuals(model))
}
dat <- as.data.frame(bayestestR::estimate_density(r))
dat$curve <- stats::dnorm(
seq(min(dat$x), max(dat$x), length.out = nrow(dat)),
Expand All @@ -104,7 +109,11 @@ plot.see_check_normality <- function(x,
)
.plot_diag_norm(dat, size_line = size_line)
} else if (type == "pp") {
x <- suppressMessages(sort(stats::residuals(model), na.last = NA))
if (inherits(x, "performance_simres")) {
x <- attributes(x)$data
} else {
x <- suppressMessages(sort(stats::residuals(model), na.last = NA))
}
dat <- data.frame(res = x)
.plot_diag_pp(
dat,
Expand Down Expand Up @@ -171,7 +180,7 @@ plot.see_check_normality <- function(x,
model_info = NULL) {
qhalfnorm <- function(p) stats::qnorm((p + 1) / 2)
# qq-halfnorm for GLM
if (isTRUE(model_info$is_binomial) || isTRUE(model_info$is_count)) {
if (!isTRUE(model_info$is_simulated_residuals) && (isTRUE(model_info$is_binomial) || isTRUE(model_info$is_count))) {
gg_init <- ggplot2::ggplot(x, ggplot2::aes(x = .data$x, y = .data$y))
qq_stuff <- list(
ggplot2::geom_point(
Expand Down

0 comments on commit 0e50fe8

Please sign in to comment.