From 1e3e2fa68f5ee4eeba1829f1bebd66f1fa4ec41a Mon Sep 17 00:00:00 2001 From: Indrajeet Patil Date: Fri, 8 Sep 2023 21:43:32 +0200 Subject: [PATCH] Clean up some lints --- R/geom_binomdensity.R | 2 +- R/plot.equivalence_test.R | 7 +---- R/plot.estimate_density.R | 10 +++++-- R/plot.p_direction.R | 4 +-- R/plot.p_significance.R | 4 +-- R/plot.rope.R | 4 +-- R/plots.R | 4 ++- R/utils.R | 19 +++++++----- tests/testthat/test-plot.estimate_contrasts.R | 2 +- vignettes/parameters.Rmd | 30 +++++++++++-------- 10 files changed, 46 insertions(+), 40 deletions(-) diff --git a/R/geom_binomdensity.R b/R/geom_binomdensity.R index 2e170c59f..e430baecb 100644 --- a/R/geom_binomdensity.R +++ b/R/geom_binomdensity.R @@ -46,7 +46,7 @@ geom_binomdensity <- function(data, insight::check_if_installed(c("ggplot2", "ggdist")) # Sanitize y (e.g., if levels with no values, etc.) - if (is.factor(data[[y]]) && length(levels(data[[y]])) > 2L) { + if (is.factor(data[[y]]) && nlevels(data[[y]]) > 2L) { data[[y]] <- droplevels(data[[y]]) } diff --git a/R/plot.equivalence_test.R b/R/plot.equivalence_test.R index 57cdca810..510e0c92d 100644 --- a/R/plot.equivalence_test.R +++ b/R/plot.equivalence_test.R @@ -105,12 +105,7 @@ plot.see_equivalence_test <- function(x, tmp <- merge(tmp, cp, by = "predictor") tmp$predictor <- factor(tmp$predictor, levels = rev(unique(tmp$predictor))) - has_multiple_panels <- - (!"Effects" %in% names(tmp) || length(unique(tmp$Effects)) <= 1L) && - (!"Component" %in% names(tmp) || length(unique(tmp$Component)) <= 1L) - - # check if we have multiple panels - if (has_multiple_panels) { + if (.has_multiple_panels(tmp)) { n_columns <- NULL } diff --git a/R/plot.estimate_density.R b/R/plot.estimate_density.R index 4c1eee6cb..bfb7fdb4f 100644 --- a/R/plot.estimate_density.R +++ b/R/plot.estimate_density.R @@ -123,11 +123,15 @@ plot.see_estimate_density <- function(x, if (!inherits(x, "data_plot")) { - x <- data_plot(x, data = model, centrality = centrality, ci = ci, ...) + x <- data_plot(x, + data = model, + centrality = centrality, + ci = ci, + ... + ) } - if ((!"Effects" %in% names(x) || length(unique(x$Effects)) <= 1) && - (!"Component" %in% names(x) || length(unique(x$Component)) <= 1)) { + if (.has_multiple_panels(x)) { n_columns <- NULL } diff --git a/R/plot.p_direction.R b/R/plot.p_direction.R index 112c7b19b..3e268e4f4 100644 --- a/R/plot.p_direction.R +++ b/R/plot.p_direction.R @@ -174,9 +174,7 @@ plot.see_p_direction <- function(x, x <- data_plot(x, data = data, show_intercept = show_intercept) } - # check if we have multiple panels - if ((!"Effects" %in% names(x) || length(unique(x$Effects)) <= 1) && - (!"Component" %in% names(x) || length(unique(x$Component)) <= 1)) { + if (.has_multiple_panels(x)) { n_columns <- NULL } diff --git a/R/plot.p_significance.R b/R/plot.p_significance.R index 216f617f8..cf22c580a 100644 --- a/R/plot.p_significance.R +++ b/R/plot.p_significance.R @@ -186,9 +186,7 @@ plot.see_p_significance <- function(x, x <- data_plot(x, data = data, show_intercept = show_intercept) } - # check if we have multiple panels - if ((!"Effects" %in% names(x) || length(unique(x$Effects)) <= 1L) && - (!"Component" %in% names(x) || length(unique(x$Component)) <= 1L)) { + if (.has_multiple_panels(x)) { n_columns <- NULL } diff --git a/R/plot.rope.R b/R/plot.rope.R index dd7b71493..5199a3d8e 100644 --- a/R/plot.rope.R +++ b/R/plot.rope.R @@ -96,9 +96,7 @@ plot.see_rope <- function(x, x <- data_plot(x, data = data, show_intercept = show_intercept) } - # check if we have multiple panels - if ((!"Effects" %in% names(x) || length(unique(x$Effects)) <= 1) && - (!"Component" %in% names(x) || length(unique(x$Component)) <= 1)) { + if (.has_multiple_panels(x)) { n_columns <- NULL } diff --git a/R/plots.R b/R/plots.R index b7e9bcb62..f5953a604 100644 --- a/R/plots.R +++ b/R/plots.R @@ -65,7 +65,7 @@ plots <- function(..., # Add tags if (!is.null(tags)) { - if (length(tags) == 1) { + if (length(tags) == 1L) { if (isTRUE(tags)) { tags <- "A" } else if (isFALSE(tags) || is.na(tags)) { @@ -100,6 +100,7 @@ plots <- function(..., msg_display1 <- "\n- To fix this issue, please make the window larger." msg_display3 <- "\n- If this still doesn't resolve your problems, you may check whether your apps are rescaled. On Windows, this can be done in the display settings (Start > Settings > System > Display, \"Scale and layout\"). Reduce the scaling and try again." msg_display4 <- "\n- Finally, you can try to decrease the base font-size of your theme before plotting. Load `library(ggplot2)` and run: `theme_set(theme_classic(base_size = 6))`" + if (Sys.getenv("RSTUDIO") == "1") { msg <- "The RStudio 'Plots' window is too small to show this set of plots." msg_display2 <- "\n- If this doesn't help, try to reset your zoom settings. In RStudio, go to Menu \"View > Actual Size\" and then retry." @@ -107,6 +108,7 @@ plots <- function(..., msg <- "The viewport is too small to show this set of plots." msg_display2 <- "\n- If this doesn't help, try to reset the zoom settings of your IDE and then retry." } + msg <- paste(msg, "You may try one of the following steps to resolve this problem.") insight::format_error(msg, msg_display1, msg_display2, msg_display3, msg_display4) } diff --git a/R/utils.R b/R/utils.R index 2b0360238..eb012e520 100644 --- a/R/utils.R +++ b/R/utils.R @@ -27,7 +27,10 @@ as.numeric(as.character(x)) } - +.has_multiple_panels <- function(x) { + (!"Effects" %in% names(x) || length(unique(x$Effects)) <= 1L) && + (!"Component" %in% names(x) || length(unique(x$Component)) <= 1L) +} .clean_parameter_names <- function(params, grid = FALSE) { params <- unique(params) @@ -91,23 +94,25 @@ .fix_facet_names <- function(x) { if ("Component" %in% names(x)) { x$Component <- as.character(x$Component) - if (!"Effects" %in% names(x)) { - x$Component[x$Component == "conditional"] <- "Conditional" - x$Component[x$Component == "zero_inflated"] <- "Zero-Inflated" - x$Component[x$Component == "dispersion"] <- "Dispersion" - x$Component[x$Component == "simplex"] <- "Monotonic Effects" - } else { + if ("Effects" %in% names(x)) { x$Component[x$Component == "conditional"] <- "(Conditional)" x$Component[x$Component == "zero_inflated"] <- "(Zero-Inflated)" x$Component[x$Component == "dispersion"] <- "(Dispersion)" x$Component[x$Component == "simplex"] <- "(Monotonic Effects)" + } else { + x$Component[x$Component == "conditional"] <- "Conditional" + x$Component[x$Component == "zero_inflated"] <- "Zero-Inflated" + x$Component[x$Component == "dispersion"] <- "Dispersion" + x$Component[x$Component == "simplex"] <- "Monotonic Effects" } } + if ("Effects" %in% names(x)) { x$Effects <- as.character(x$Effects) x$Effects[x$Effects == "fixed"] <- "Fixed Effects" x$Effects[x$Effects == "random"] <- "Random Effects" } + x } diff --git a/tests/testthat/test-plot.estimate_contrasts.R b/tests/testthat/test-plot.estimate_contrasts.R index fdfd52af4..448376c29 100644 --- a/tests/testthat/test-plot.estimate_contrasts.R +++ b/tests/testthat/test-plot.estimate_contrasts.R @@ -4,6 +4,6 @@ test_that("`plot.see_estimate_contrasts()` works", { model <- stan_glm(Sepal.Width ~ Species, data = iris, refresh = 0) contrasts <- modelbased::estimate_contrasts(model, contrast = "Species") - means <- modelbased::estimate_means(model, at = c("Species")) + means <- modelbased::estimate_means(model, at = "Species") expect_s3_class(plot(contrasts, means), "gg") }) diff --git a/vignettes/parameters.Rmd b/vignettes/parameters.Rmd index 2a5145044..de801f42a 100644 --- a/vignettes/parameters.Rmd +++ b/vignettes/parameters.Rmd @@ -326,21 +326,27 @@ plot(result) ## Bayesian Meta-Analysis using brms -```{r} -# We download the model to save computation time. Here is the code -# to refit the exact model used below... +We download the model to save computation time, but here is the code to refit the exact model used below: +```{r, eval=FALSE} # Data from # https://github.com/MathiasHarrer/Doing-Meta-Analysis-in-R/blob/master/_data/Meta_Analysis_Data.RData -# set.seed(123) -# priors <- c(prior(normal(0,1), class = Intercept), -# prior(cauchy(0,0.5), class = sd)) -# -# model <- -# brm(TE|se(seTE) ~ 1 + (1|Author), -# data = Meta_Analysis_Data, -# prior = priors, -# iter = 4000) +set.seed(123) +priors <- c( + prior(normal(0, 1), class = Intercept), + prior(cauchy(0, 0.5), class = sd) +) + +model <- brm( + TE | se(seTE) ~ 1 + (1 | Author), + data = Meta_Analysis_Data, + prior = priors, + iter = 4000 +) +``` + + +```{r} library(brms) model <- insight::download_model("brms_meta_1") result <- model_parameters(model)