From 64c1924de5b33030750615f792e0f7078f02f3f4 Mon Sep 17 00:00:00 2001 From: Daniel Date: Fri, 27 Oct 2023 10:09:53 +0200 Subject: [PATCH 1/5] Support performance_simres class --- R/plot.check_normality.R | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/R/plot.check_normality.R b/R/plot.check_normality.R index 01c62233b..f44c4b6ef 100644 --- a/R/plot.check_normality.R +++ b/R/plot.check_normality.R @@ -70,7 +70,9 @@ plot.see_check_normality <- function(x, } else { if (type == "qq") { model_info <- attributes(x)$model_info - if (inherits(model, c("lme", "lmerMod", "merMod", "glmmTMB", "afex_aov", "BFBayesFactor"))) { + if (inhertis(x, "performance_simres")) { + dat <- stats::na.omit(data.frame(y = model)) + } 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_)) } else if (inherits(model, "glm")) { From 38dde0deb4ecdf8a437c02f68ac14e5d928bad04 Mon Sep 17 00:00:00 2001 From: Daniel Date: Fri, 27 Oct 2023 10:10:18 +0200 Subject: [PATCH 2/5] update vers --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 96e7dd12b..dd4106490 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: see Title: Model Visualisation Toolbox for 'easystats' and 'ggplot2' -Version: 0.8.0.6 +Version: 0.8.0.7 Authors@R: c(person(given = "Daniel", family = "Lüdecke", From 0e50fe894d90b0cdf2913ad3dfa741c735c58980 Mon Sep 17 00:00:00 2001 From: Daniel Date: Fri, 27 Oct 2023 11:58:50 +0200 Subject: [PATCH 3/5] draft plot method --- R/data_plot.R | 9 +++++++-- R/plot.check_normality.R | 19 ++++++++++++++----- 2 files changed, 21 insertions(+), 7 deletions(-) diff --git a/R/data_plot.R b/R/data_plot.R index 3b916383f..7bacfd2ee 100644 --- a/R/data_plot.R +++ b/R/data_plot.R @@ -140,11 +140,16 @@ add_plot_attributes <- function(x) { #' @keywords internal -.retrieve_data <- function(x) { +.retrieve_data <- function(x) { # 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) @@ -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) } } diff --git a/R/plot.check_normality.R b/R/plot.check_normality.R index f44c4b6ef..9de744bdf 100644 --- a/R/plot.check_normality.R +++ b/R/plot.check_normality.R @@ -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_)) @@ -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)), @@ -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, @@ -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( From 8ea7d859bda9d10e5ae99314ef56332acfef4d2a Mon Sep 17 00:00:00 2001 From: Daniel Date: Mon, 30 Oct 2023 08:18:45 +0100 Subject: [PATCH 4/5] Add method --- NAMESPACE | 1 + R/data_plot.R | 2 +- R/plot.check_normality.R | 6 +++++- 3 files changed, 7 insertions(+), 2 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index c4027f24d..1bb139b9a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -64,6 +64,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) diff --git a/R/data_plot.R b/R/data_plot.R index 7bacfd2ee..caa0ea59b 100644 --- a/R/data_plot.R +++ b/R/data_plot.R @@ -140,7 +140,7 @@ add_plot_attributes <- function(x) { #' @keywords internal -.retrieve_data <- function(x) { +.retrieve_data <- function(x) { # retrieve model obj_name <- attr(x, "object_name", exact = TRUE) dat <- NULL diff --git a/R/plot.check_normality.R b/R/plot.check_normality.R index 9de744bdf..98630f481 100644 --- a/R/plot.check_normality.R +++ b/R/plot.check_normality.R @@ -71,7 +71,7 @@ plot.see_check_normality <- function(x, if (type == "qq") { model_info <- attributes(x)$model_info if (inherits(x, "performance_simres")) { - dat <- stats::na.omit(data.frame(y = attributes(x)$data)) + dat <- stats::na.omit(data.frame(y = attributes(x)$scaledResiduals)) 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)) @@ -129,6 +129,10 @@ plot.see_check_normality <- function(x, } +#' @export +plot.see_performance_simres <- plot.see_check_normality + + # normality plot: density ------------------------- .plot_diag_norm <- function(x, From cd1d463aea06b96b5a708dd57ac4cb2256d11602 Mon Sep 17 00:00:00 2001 From: Daniel Date: Mon, 30 Oct 2023 08:21:43 +0100 Subject: [PATCH 5/5] fix --- R/data_plot.R | 2 +- R/plot.check_normality.R | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/data_plot.R b/R/data_plot.R index caa0ea59b..4f45c508f 100644 --- a/R/data_plot.R +++ b/R/data_plot.R @@ -147,7 +147,7 @@ add_plot_attributes <- function(x) { # for simulated residuals, we save all necessary information in the object if (inherits(x, "performance_simres")) { - return(attributes(x)$model) + return(x$fittedModel) } if (!is.null(obj_name)) { diff --git a/R/plot.check_normality.R b/R/plot.check_normality.R index 98630f481..f41619858 100644 --- a/R/plot.check_normality.R +++ b/R/plot.check_normality.R @@ -71,7 +71,7 @@ plot.see_check_normality <- function(x, if (type == "qq") { model_info <- attributes(x)$model_info if (inherits(x, "performance_simres")) { - dat <- stats::na.omit(data.frame(y = attributes(x)$scaledResiduals)) + dat <- stats::na.omit(data.frame(y = x$scaledResiduals)) 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))