diff --git a/DESCRIPTION b/DESCRIPTION index f1839c25e..5f6ae7738 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -63,15 +63,20 @@ Depends: R (>= 3.6), stats Imports: - bayestestR (>= 0.13.0), - correlation (>= 0.8.3), + bayestestR (>= 0.13.0.6), + correlation (>= 0.8.3.1), datawizard (>= 0.6.4), - effectsize (>= 0.8.2), + effectsize (>= 0.8.3), ggplot2 (>= 3.4.0), - insight (>= 0.18.8), + insight (>= 0.19.0), modelbased (>= 0.8.5), parameters (>= 0.20.0), performance (>= 0.10.1) +Remotes: + easystats/insight, + easystats/parameters, + easystats/correlation, + easystats/bayestestR Suggests: brms, curl, diff --git a/R/coord_radar.R b/R/coord_radar.R index e789631c6..909bdb7cf 100644 --- a/R/coord_radar.R +++ b/R/coord_radar.R @@ -5,20 +5,18 @@ #' @inheritParams ggplot2::coord_polar #' @param ... Other arguments to be passed to `ggproto`. #' -#' @examples +#' @examplesIf require("datawizard") && require("ggplot2") #' # Create a radar/spider chart with ggplot: -#' if (require("datawizard") && require("ggplot2")) { -#' data(iris) -#' data <- aggregate(iris[-5], list(Species = iris$Species), mean) -#' data <- data_to_long( -#' data, -#' c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width") -#' ) +#' data(iris) +#' data <- aggregate(iris[-5], list(Species = iris$Species), mean) +#' data <- data_to_long( +#' data, +#' c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width") +#' ) #' -#' ggplot(data, aes(x = name, y = value, color = Species, group = Species)) + -#' geom_polygon(fill = NA, linewidth = 2) + -#' coord_radar(start = -pi / 4) -#' } +#' ggplot(data, aes(x = name, y = value, color = Species, group = Species)) + +#' geom_polygon(fill = NA, linewidth = 2) + +#' coord_radar(start = -pi / 4) #' @export coord_radar <- function(theta = "x", start = 0, direction = 1, ...) { theta <- match.arg(theta, c("x", "y")) diff --git a/R/data_plot.R b/R/data_plot.R index dd8defeab..13f4730ef 100644 --- a/R/data_plot.R +++ b/R/data_plot.R @@ -55,13 +55,13 @@ #' library(bayestestR) #' library(rstanarm) #' -#' model <<- stan_glm( +#' model <<- suppressWarnings(stan_glm( #' Sepal.Length ~ Petal.Width * Species, #' data = iris, #' chains = 2, iter = 200, refresh = 0 -#' ) +#' )) #' -#' x <- rope(model) +#' x <- rope(model, verbose = FALSE) #' plot(x) #' #' x <- hdi(model) @@ -71,17 +71,17 @@ #' x <- p_direction(data) #' plot(x) #' -#' x <- p_direction(model) +#' x <- p_direction(model, verbose = FALSE) #' plot(x) #' -#' model <<- stan_glm( +#' model <<- suppressWarnings(stan_glm( #' mpg ~ wt + gear + cyl + disp, #' chains = 2, #' iter = 200, #' refresh = 0, #' data = mtcars -#' ) -#' x <- equivalence_test(model) +#' )) +#' x <- equivalence_test(model, verbose = FALSE) #' plot(x) #' @export data_plot <- function(x, data = NULL, ...) { @@ -104,11 +104,11 @@ data_plot <- function(x, data = NULL, ...) { #' library(see) #' library(ggplot2) #' -#' model <- stan_glm( +#' model <- suppressWarnings(stan_glm( #' Sepal.Length ~ Petal.Width + Species + Sepal.Width, #' data = iris, #' chains = 2, iter = 200 -#' ) +#' )) #' #' result <- hdi(model, ci = c(0.5, 0.75, 0.9, 0.95)) #' data <- data_plot(result, data = model) diff --git a/R/geom_from_list.R b/R/geom_from_list.R index c9590041b..52a9186a4 100644 --- a/R/geom_from_list.R +++ b/R/geom_from_list.R @@ -111,25 +111,6 @@ #' geom_from_list(list(aes = list(x = "Sepal.Length"), geom = "ggside::geom_xsidedensity")) + #' geom_from_list(list(geom = "ggside::scale_xsidey_continuous", breaks = NULL)) #' -#' # Example 6 (ggraph) -------------------------- -#' -#' @examplesIf require("tidygraph") && require("ggraph") -#' library(tidygraph) -#' library(ggraph) -#' -#' # Prepare graph -#' nodes <- data.frame(name = c("Death", "Famine", "War", "Conquest")) -#' edges <- data.frame( -#' from = c(1, 1, 1, 2, 3, 3, 4, 4, 4), -#' to = c(2, 3, 4, 1, 1, 2, 1, 2, 3) -#' ) -#' data <- tidygraph::tbl_graph(nodes = nodes, edges = edges) -#' -#' ggraph(data, layout = "kk") + -#' geom_from_list(list(geom = "ggraph::geom_edge_arc")) + -#' geom_from_list(list(geom = "ggraph::geom_node_point", size = 10)) + -#' geom_from_list(list(geom = "ggraph::geom_node_label", aes = list(label = "name"))) -#' #' @export geom_from_list <- function(x, ...) { # Additional parameters ------------------------------------------------------ @@ -165,28 +146,25 @@ geom_from_list <- function(x, ...) { return(do.call(ggplot2::facet_grid, args)) } if (x$geom == "smooth") { - if (!is.null(x$aes)) args$mapping <- do.call(ggplot2::aes_string, x$aes) + if (!is.null(x$aes)) args$mapping <- do.call(ggplot2::aes, lapply(x$aes, .str_to_sym)) if (!"method" %in% names(args)) args$method <- "loess" if (!"formula" %in% names(args)) args$formula <- "y ~ x" return(do.call(ggplot2::geom_smooth, args)) } - if (startsWith(x$geom, "scale_")) { - return(do.call(x$geom, args)) - } - if (startsWith(x$geom, "theme")) { - return(do.call(x$geom, args)) - } - if (startsWith(x$geom, "see_")) { + + if (startsWith(x$geom, "scale_") || startsWith(x$geom, "theme") || startsWith(x$geom, "see_")) { return(do.call(x$geom, args)) } + if (startsWith(x$geom, "ggside::")) { insight::check_if_installed("ggside") - if (!is.null(x$aes)) args$mapping <- do.call(ggplot2::aes_string, x$aes) + if (!is.null(x$aes)) args$mapping <- do.call(ggplot2::aes, lapply(x$aes, .str_to_sym)) return(do.call(eval(parse(text = x$geom)), args)) } + if (startsWith(x$geom, "ggraph::")) { insight::check_if_installed("ggraph") - if (!is.null(x$aes)) args$mapping <- do.call(ggplot2::aes_string, x$aes) + if (!is.null(x$aes)) args$mapping <- do.call(ggplot2::aes, lapply(x$aes, .str_to_sym)) return(do.call(eval(parse(text = x$geom)), args)) } @@ -214,11 +192,11 @@ geom_from_list <- function(x, ...) { } else if (x$geom == "density_2d_polygon") { stat <- ggplot2::StatDensity2d x$geom <- "polygon" - if (!"fill" %in% names(x$aes)) x$aes$fill <- "..level.." + if (!"fill" %in% names(x$aes)) x$aes$fill <- quote(after_stat(level)) } else if (x$geom == "density_2d_raster") { stat <- ggplot2::StatDensity2d x$geom <- "raster" - if (!"fill" %in% names(x$aes)) x$aes$fill <- "..density.." + if (!"fill" %in% names(x$aes)) x$aes$fill <- quote(after_stat(density)) } # Position @@ -234,7 +212,7 @@ geom_from_list <- function(x, ...) { # Aesthetics if ("aes" %in% names(x)) { - aes_list <- do.call(ggplot2::aes_string, x$aes) + aes_list <- do.call(ggplot2::aes, lapply(x$aes, .str_to_sym)) } else { aes_list <- NULL } diff --git a/R/plot.check_distribution.R b/R/plot.check_distribution.R index 0db9f1f82..40338131a 100644 --- a/R/plot.check_distribution.R +++ b/R/plot.check_distribution.R @@ -24,7 +24,8 @@ plot.see_check_distribution <- function(x, size_point = 2, panel = TRUE, ...) { dat <- data.frame( x = factor(c(x$Distribution, x$Distribution), levels = rev(sort(unique(x$Distribution)))), y = c(x$p_Response, x$p_Residuals), - group = factor(c(rep("Response", length(x$p_Response)), rep("Residuals", length(x$p_Residuals))), + group = factor( + c(rep("Response", length(x$p_Response)), rep("Residuals", length(x$p_Residuals))), levels = c("Response", "Residuals") ), stringsAsFactors = FALSE @@ -39,16 +40,25 @@ plot.see_check_distribution <- function(x, size_point = 2, panel = TRUE, ...) { # default legend-position lp <- ifelse(isTRUE(panel), "right", "bottom") - p1 <- ggplot(dat, aes( - y = .data$x, - x = .data$y, - colour = .data$group - )) + - geom_linerange(aes(xmin = 0, xmax = .data$y), + p1 <- ggplot( + dat, + aes( + y = .data$x, + x = .data$y, + colour = .data$group + ) + ) + + geom_linerange( + aes(xmin = 0, xmax = .data$y), position = position_dodge(0.4), - linewidth = 0.8 + linewidth = 0.8, + na.rm = TRUE + ) + + geom_point( + size = size_point, + position = position_dodge(0.4), + na.rm = TRUE ) + - geom_point(size = size_point, position = position_dodge(0.4)) + labs( y = NULL, x = NULL, @@ -91,7 +101,8 @@ plot.see_check_distribution <- function(x, size_point = 2, panel = TRUE, ...) { p3 <- ggplot(dat2, aes(x = .data$x)) + geom_histogram( fill = "#f44336", colour = bar_color, - binwidth = sqrt(length(vars(.data$x))) + binwidth = sqrt(length(vars(.data$x))), + na.rm = TRUE ) + labs(x = NULL, y = NULL, title = "Distribution of Response") + theme_lucid() @@ -130,10 +141,29 @@ plot.see_check_distribution_numeric <- function(x, lp <- ifelse(isTRUE(panel), "right", "bottom") p1 <- ggplot(dat, aes(y = .data$x, x = .data$y)) + - geom_linerange(aes(xmin = 0, xmax = .data$y), position = position_dodge(0.4), linewidth = 0.8) + - geom_point(size = size_point, position = position_dodge(0.4)) + - labs(y = NULL, x = NULL, fill = NULL, colour = NULL, title = "Predicted Distribution of Vector") + - scale_x_continuous(labels = .percents, expand = c(0, 0), limits = c(0, max_y)) + + geom_linerange( + aes(xmin = 0, xmax = .data$y), + position = position_dodge(0.4), + linewidth = 0.8, + na.rm = TRUE + ) + + geom_point( + size = size_point, + position = position_dodge(0.4), + na.rm = TRUE + ) + + labs( + y = NULL, + x = NULL, + fill = NULL, + colour = NULL, + title = "Predicted Distribution of Vector" + ) + + scale_x_continuous( + labels = .percents, + expand = c(0, 0), + limits = c(0, max_y) + ) + theme_lucid(legend.position = lp) dat1 <- as.data.frame(stats::density(vec)) @@ -147,14 +177,15 @@ plot.see_check_distribution_numeric <- function(x, p3 <- ggplot(dat2, aes(x = .data$x)) + geom_histogram( colour = theme_lucid()$panel.background$fill, - binwidth = sqrt(length(vars(.data$x))) + binwidth = sqrt(length(vars(.data$x))), + na.rm = TRUE ) + labs(x = NULL, y = NULL, title = "Distribution of Vector") + theme_lucid() if (panel) { insight::check_if_installed("patchwork") - return(p1 / (p2 | p3) + patchwork::plot_layout(nrow = 2)) + return(p1 / (p2 | p3) + patchwork::plot_layout(nrow = 2L)) } else { return(list(p1, p2, p3)) } diff --git a/R/plot.check_homogeneity.R b/R/plot.check_homogeneity.R index c1a19616e..55103abed 100644 --- a/R/plot.check_homogeneity.R +++ b/R/plot.check_homogeneity.R @@ -60,7 +60,10 @@ plot.see_check_homogeneity <- function(x, data = NULL, ...) { ggrepel::geom_label_repel( aes(label = .data$group), y = 0, fill = "white", - data = data.frame(group = unique(dat$group)), + data = data.frame( + group = unique(dat$group), + stringsAsFactors = FALSE + ), direction = "y", segment.colour = NA ) @@ -68,7 +71,10 @@ plot.see_check_homogeneity <- function(x, data = NULL, ...) { geom_label( aes(label = .data$group), y = 0, fill = "white", - data = data.frame(group = unique(dat$group)) + data = data.frame( + group = unique(dat$group), + stringsAsFactors = FALSE + ) ) } } else { @@ -84,7 +90,10 @@ plot.see_check_homogeneity <- function(x, data = NULL, ...) { ggrepel::geom_label_repel( aes(label = .data$x), y = 0, fill = "white", - data = data.frame(x = unique(dat$x)), + data = data.frame( + x = unique(dat$x), + stringsAsFactors = FALSE + ), direction = "y", segment.colour = NA ) @@ -92,7 +101,10 @@ plot.see_check_homogeneity <- function(x, data = NULL, ...) { geom_label( aes(label = .data$x), y = 0, fill = "white", - data = data.frame(x = unique(dat$x)) + data = data.frame( + x = unique(dat$x), + stringsAsFactors = FALSE + ) ) } } diff --git a/R/plot.check_model.R b/R/plot.check_model.R index 9c010a669..9cdb8a85f 100644 --- a/R/plot.check_model.R +++ b/R/plot.check_model.R @@ -254,7 +254,10 @@ plot.see_check_model <- function(x, { if (!is.null(ci_data)) { list( - ggplot2::geom_linerange(linewidth = size_line), + ggplot2::geom_linerange( + linewidth = size_line, + na.rm = TRUE + ), ggplot2::geom_segment( data = x[x$VIF_CI_high > ylim * 1.15, ], mapping = aes( @@ -275,7 +278,8 @@ plot.see_check_model <- function(x, } } + geom_point2( - size = size_point + size = size_point, + na.rm = TRUE ) + ggplot2::labs( title = "Collinearity", @@ -326,12 +330,14 @@ plot.see_check_model <- function(x, mapping = ggplot2::aes(ymin = 0, ymax = .data$y), colour = NA, fill = colors[2], - alpha = alpha_level + alpha = alpha_level, + na.rm = TRUE ) + ggplot2::geom_line( mapping = ggplot2::aes(y = .data$curve), colour = colors[1], - linewidth = size_line + linewidth = size_line, + na.rm = TRUE ) + ggplot2::labs( x = "Residuals", @@ -390,10 +396,13 @@ plot.see_check_model <- function(x, qq_stuff <- list( ggplot2::geom_qq_line( linewidth = size_line, - colour = colors[1] + colour = colors[1], + na.rm = TRUE ), ggplot2::geom_qq( - shape = 16, stroke = 0, + shape = 16, + na.rm = TRUE, + stroke = 0, size = size_point, colour = colors[2] # "#2c3e50" ) @@ -453,7 +462,6 @@ plot.see_check_model <- function(x, ", please install `qqplotr`." ) - x$probs <- stats::ppoints(x$res) dparms <- MASS::fitdistr(x$res, densfun = "normal") x$y <- do.call(stats::pnorm, c(list(q = x$res), dparms$estimate)) diff --git a/R/plot.compare_parameters.R b/R/plot.compare_parameters.R index 90cb59f8f..ac67ba2f9 100644 --- a/R/plot.compare_parameters.R +++ b/R/plot.compare_parameters.R @@ -14,17 +14,13 @@ #' #' @return A ggplot2-object. #' -#' @examples -#' if (require("insight") && -#' require("parameters") && -#' packageVersion("insight") >= "0.13.0") { -#' data(iris) -#' lm1 <- lm(Sepal.Length ~ Species, data = iris) -#' lm2 <- lm(Sepal.Length ~ Species + Petal.Length, data = iris) -#' lm3 <- lm(Sepal.Length ~ Species * Petal.Length, data = iris) -#' result <- compare_parameters(lm1, lm2, lm3) -#' plot(result) -#' } +#' @examplesIf require("insight") && require("parameters") +#' data(iris) +#' lm1 <- lm(Sepal.Length ~ Species, data = iris) +#' lm2 <- lm(Sepal.Length ~ Species + Petal.Length, data = iris) +#' lm3 <- lm(Sepal.Length ~ Species * Petal.Length, data = iris) +#' result <- compare_parameters(lm1, lm2, lm3) +#' plot(result) #' @export plot.see_compare_parameters <- function(x, show_intercept = FALSE, @@ -35,7 +31,7 @@ plot.see_compare_parameters <- function(x, n_columns = NULL, show_labels = FALSE, ...) { - if (!"data_plot" %in% class(x)) { + if (!inherits(x, "data_plot")) { x <- data_plot(x) } @@ -95,7 +91,12 @@ plot.see_compare_parameters <- function(x, p <- ggplot(x, aes(y = .data$Parameter, x = .data$Coefficient, color = .data$group)) + geom_vline(aes(xintercept = y_intercept), linetype = "dotted") + - geom_pointrange(aes(xmin = .data$CI_low, xmax = .data$CI_high), size = size_point, position = position_dodge(dodge_position)) + + geom_pointrange( + aes(xmin = .data$CI_low, xmax = .data$CI_high), + size = size_point, + position = position_dodge(dodge_position), + na.rm = TRUE + ) + theme_modern() + scale_color_material() @@ -108,7 +109,9 @@ plot.see_compare_parameters <- function(x, p <- p + geom_text( mapping = aes(label = .data$Estimate_CI, y = Inf), - colour = "black", hjust = "inward", size = size_text, + colour = "black", + hjust = "inward", + size = size_text, position = position_dodge2(dodge_position) ) + xlim(c(min(new_range), max(new_range))) @@ -120,8 +123,8 @@ plot.see_compare_parameters <- function(x, # largest data points that are within this range. Thereby we have the pretty # values we can use as breaks and labels for the scale... if (exponentiated_coefs) { - range <- 2^c(-24:16) - x_low <- which.min(min(x$CI_low) > range) - 1 + range <- 2^(-24:16) + x_low <- which.min(min(x$CI_low) > range) - 1L x_high <- which.max(max(x$CI_high) < range) if (add_values) { # add some space to the right panel for text @@ -137,7 +140,7 @@ plot.see_compare_parameters <- function(x, } # wrap plot into facets, depending on the components - if (is.null(n_columns)) n_columns <- ifelse(sum(has_component, has_response, has_effects) > 1, 2, 1) + if (is.null(n_columns)) n_columns <- ifelse(sum(has_component, has_response, has_effects) > 1L, 2L, 1L) if (ordinal_model) { facet_scales <- "free_x" @@ -162,7 +165,7 @@ plot.see_compare_parameters <- function(x, } else if (has_response) { p <- p + facet_wrap(~Response, ncol = n_columns, scales = facet_scales) } else if (has_subgroups) { - suppressWarnings(p <- p + facet_grid(Subgroup ~ ., scales = "free", space = "free")) + p <- p + facet_grid(Subgroup ~ ., scales = "free", space = "free") } if (isTRUE(axis_title_in_facet)) { @@ -190,20 +193,37 @@ data_plot.see_compare_parameters <- function(x, ...) { col_ci_high <- which(grepl("^CI_high\\.", colnames(x))) col_p <- which(grepl("^p\\.", colnames(x))) - out1 <- .reshape_to_long(x, values_to = "Coefficient", columns = colnames(x)[col_coefficient])[c("Parameter", "Component", "group", "Coefficient")] - out2 <- .reshape_to_long(x, values_to = "CI_low", columns = colnames(x)[col_ci_low])["CI_low"] - out3 <- .reshape_to_long(x, values_to = "CI_high", columns = colnames(x)[col_ci_high])["CI_high"] - out4 <- .reshape_to_long(x, values_to = "p", columns = colnames(x)[col_p])["p"] + out1 <- .reshape_to_long( + x, + values_to = "Coefficient", + columns = colnames(x)[col_coefficient] + )[c("Parameter", "Component", "group", "Coefficient")] + + out2 <- .reshape_to_long( + x, + values_to = "CI_low", + columns = colnames(x)[col_ci_low] + )["CI_low"] + + out3 <- .reshape_to_long( + x, + values_to = "CI_high", + columns = colnames(x)[col_ci_high] + )["CI_high"] + + out4 <- .reshape_to_long( + x, + values_to = "p", + columns = colnames(x)[col_p] + )["p"] dataplot <- cbind(out1, out2, out3, out4) dataplot$group <- gsub("(.*)\\.(.*)", "\\2", dataplot$group) rownames(dataplot) <- NULL - exp_coef <- unique(unlist(insight::compact_list(lapply(x, function(i) { - attributes(i)$exponentiate - })))) - attr(dataplot, "exponentiate") <- !is.null(exp_coef) && any(exp_coef != FALSE) + exp_coef <- unique(unlist(insight::compact_list(lapply(x, function(i) attributes(i)$exponentiate)))) + attr(dataplot, "exponentiate") <- !is.null(exp_coef) && any(exp_coef) class(dataplot) <- c("data_plot", "see_compare_parameters", class(dataplot)) dataplot diff --git a/R/plot.compare_performance.R b/R/plot.compare_performance.R index 25f156872..624bae36d 100644 --- a/R/plot.compare_performance.R +++ b/R/plot.compare_performance.R @@ -92,7 +92,7 @@ plot.see_compare_performance <- function(x, size_line = 1, ...) { # labs(x = "Model", y = "Performance Score") # } else { - if (!"data_plot" %in% class(x)) { + if (!inherits(x, "data_plot")) { x <- data_plot(x) } diff --git a/R/plot.describe_distribution.R b/R/plot.describe_distribution.R index 997df7d28..a6e3921b2 100644 --- a/R/plot.describe_distribution.R +++ b/R/plot.describe_distribution.R @@ -74,7 +74,7 @@ plot.see_parameters_distribution <- function(x, data <- data[x$Variable] } - if (!"data_plot" %in% class(x)) { + if (!inherits(x, "data_plot")) { x <- data_plot(x, data = data, ...) } @@ -195,7 +195,7 @@ plot.see_parameters_distribution <- function(x, if (!is.null(x$highlight)) { if (is.null(highlight_color)) { - highlight_color <- palette_material("full")(insight::n_unique(x$highlight) - 1) + highlight_color <- palette_material("full")(insight::n_unique(x$highlight) - 1L) } names(highlight_color) <- highlight diff --git a/R/plot.equivalence_test.R b/R/plot.equivalence_test.R index ca40ff566..af9624db2 100644 --- a/R/plot.equivalence_test.R +++ b/R/plot.equivalence_test.R @@ -150,24 +150,28 @@ plot.see_equivalence_test <- function(x, ymin = 0, ymax = Inf, fill = rope_color, - alpha = (rope_alpha / 3) + alpha = (rope_alpha / 3), + na.rm = TRUE ) + geom_vline( xintercept = .rope, linetype = "dashed", colour = rope_color, - alpha = rope.line.alpha + alpha = rope.line.alpha, + na.rm = TRUE ) + geom_vline( xintercept = 0, colour = rope_color, linewidth = 0.8, - alpha = rope.line.alpha + alpha = rope.line.alpha, + na.rm = TRUE ) + ggridges::geom_density_ridges2( rel_min_height = 0.01, scale = 2, - alpha = 0.5 + alpha = 0.5, + na.rm = TRUE ) + scale_fill_manual(values = fill.color) + labs(x = x.title, y = NULL, fill = legend.title) + @@ -218,7 +222,7 @@ plot.see_equivalence_test_df <- function(x, if (is.null(data)) data <- .retrieve_data(x) if (is.null(data)) { - warning("plot() only works for equivalence_test() when original data frame is available.", call. = FALSE) + insight::format_warning("plot() only works for equivalence_test() when original data frame is available.") return(x) } @@ -300,18 +304,21 @@ plot.see_equivalence_test_df <- function(x, xintercept = .rope, linetype = "dashed", colour = rope_color, - alpha = rope.line.alpha + alpha = rope.line.alpha, + na.rm = TRUE ) + geom_vline( xintercept = 0, colour = rope_color, linewidth = 0.8, - alpha = rope.line.alpha + alpha = rope.line.alpha, + na.rm = TRUE ) + ggridges::geom_density_ridges2( rel_min_height = 0.01, scale = 2, - alpha = 0.5 + alpha = 0.5, + na.rm = TRUE ) + scale_fill_manual(values = fill.color) + labs(x = x.title, y = NULL, fill = legend.title) + @@ -341,7 +348,7 @@ plot.see_equivalence_test_lm <- function(x, model_name <- attr(x, "object_name", exact = TRUE) if (is.null(model_name)) { - warning("plot() only works for equivalence_test() with model-objects.", call. = FALSE) + insight::format_warning("plot() only works for equivalence_test() with model-objects.") return(x) } @@ -357,7 +364,7 @@ plot.see_equivalence_test_lm <- function(x, ) if (is.null(model)) { - warning(sprintf("Can't find object '%s'.", model_name), call. = FALSE) + insight::format_warning(sprintf("Can't find object '%s'.", model_name)) return(x) } @@ -421,15 +428,20 @@ plot.see_equivalence_test_lm <- function(x, linetype = "dashed", colour = rope_color, linewidth = 0.8, - alpha = rope.line.alpha + alpha = rope.line.alpha, + na.rm = TRUE ) + geom_vline( xintercept = 0, colour = rope_color, linewidth = 0.8, - alpha = rope.line.alpha + alpha = rope.line.alpha, + na.rm = TRUE + ) + + geom_pointrange( + size = size_point, + na.rm = TRUE ) + - geom_pointrange(size = size_point) + scale_colour_manual(values = fill.color) + labs(y = x.title, x = NULL, colour = legend.title) + theme(legend.position = "bottom") + diff --git a/R/plot.estimate_contrasts.R b/R/plot.estimate_contrasts.R index 41abb91e5..594dbefc9 100644 --- a/R/plot.estimate_contrasts.R +++ b/R/plot.estimate_contrasts.R @@ -69,16 +69,17 @@ data_plot.estimate_contrasts <- function(x, data = NULL, ...) { #' #' @return A ggplot2-object. #' -#' @examplesIf identical(Sys.getenv("NOT_CRAN"), "true") && require("modelbased") && require("rstanarm") && require("emmeans") -#' model <- stan_glm(Sepal.Width ~ Species, data = iris, refresh = 0) +#' @examplesIf require("modelbased") && require("rstanarm") && require("emmeans") +#' \donttest{ +#' model <- suppressWarnings(stan_glm(Sepal.Width ~ Species, data = iris, refresh = 0)) #' contrasts <- estimate_contrasts(model) #' means <- estimate_means(model) #' plot(contrasts, means) -#' +#' } #' @importFrom ggplot2 .data #' @export plot.see_estimate_contrasts <- function(x, data = NULL, ...) { - if (!"data_plot" %in% class(x)) { + if (!inherits(x, "data_plot")) { x <- data_plot(x, data = data) } diff --git a/R/plot.estimate_density.R b/R/plot.estimate_density.R index 8d372c746..04bf29a94 100644 --- a/R/plot.estimate_density.R +++ b/R/plot.estimate_density.R @@ -93,7 +93,7 @@ data_plot.estimate_density <- function(x, #' library(rstanarm) #' library(bayestestR) #' set.seed(123) -#' m <<- stan_glm(Sepal.Length ~ Petal.Width * Species, data = iris, refresh = 0) +#' m <<- suppressWarnings(stan_glm(Sepal.Length ~ Petal.Width * Species, data = iris, refresh = 0)) #' result <- estimate_density(m) #' plot(result) #' @importFrom ggplot2 .data @@ -122,7 +122,7 @@ plot.see_estimate_density <- function(x, ) - if (!"data_plot" %in% class(x)) { + if (!inherits(x, "data_plot")) { x <- data_plot(x, data = model, centrality = centrality, ci = ci, ...) } diff --git a/R/plot.hdi.R b/R/plot.hdi.R index edb1dd3e5..792a1a4ae 100644 --- a/R/plot.hdi.R +++ b/R/plot.hdi.R @@ -193,11 +193,11 @@ data_plot.bayestestR_eti <- data_plot.hdi #' #' @return A ggplot2-object. #' -#' @examplesIf require("rstanarm") && FALSE +#' @examplesIf identical(Sys.getenv("NOT_CRAN"), "true") && require("rstanarm") #' library(rstanarm) #' library(bayestestR) #' set.seed(123) -#' m <<- stan_glm(Sepal.Length ~ Petal.Width * Species, data = iris, refresh = 0) +#' m <<- suppressWarnings(stan_glm(Sepal.Length ~ Petal.Width * Species, data = iris, refresh = 0)) #' result <- hdi(m) #' result #' plot(result) @@ -210,7 +210,7 @@ plot.see_hdi <- function(x, show_title = TRUE, n_columns = 1, ...) { - if (!"data_plot" %in% class(x)) { + if (!inherits(x, "data_plot")) { x <- data_plot(x, data = data, show_intercept = show_intercept) } diff --git a/R/plot.n_factors.R b/R/plot.n_factors.R index 4435a80fa..c262f3f47 100644 --- a/R/plot.n_factors.R +++ b/R/plot.n_factors.R @@ -73,13 +73,11 @@ data_plot.n_clusters <- data_plot.n_factors #' #' @return A ggplot2-object. #' -#' @examples -#' if (require("parameters") && require("nFactors")) { -#' data(mtcars) -#' result <- n_factors(mtcars, type = "PCA") -#' result -#' plot(result, type = "line") -#' } +#' @examplesIf require("parameters") && require("nFactors") +#' data(mtcars) +#' result <- n_factors(mtcars, type = "PCA") +#' result +#' plot(result, type = "line") #' @importFrom ggplot2 .data #' @export plot.see_n_factors <- function(x, @@ -89,7 +87,7 @@ plot.see_n_factors <- function(x, ...) { type <- match.arg(type) - if (!"data_plot" %in% class(x)) { + if (!inherits(x, "data_plot")) { x <- data_plot(x, data = data, type = type) } diff --git a/R/plot.p_direction.R b/R/plot.p_direction.R index 85e53550e..0e6cf9102 100644 --- a/R/plot.p_direction.R +++ b/R/plot.p_direction.R @@ -154,7 +154,7 @@ data_plot.p_direction <- function(x, data = NULL, show_intercept = FALSE, ...) { #' library(rstanarm) #' library(bayestestR) #' set.seed(123) -#' m <<- stan_glm(Sepal.Length ~ Petal.Width * Species, data = iris, refresh = 0) +#' m <<- suppressWarnings(stan_glm(Sepal.Length ~ Petal.Width * Species, data = iris, refresh = 0)) #' result <- p_direction(m) #' plot(result) #' @importFrom ggplot2 .data @@ -170,7 +170,7 @@ plot.see_p_direction <- function(x, model <- .retrieve_data(x) # retrieve and prepare data for plotting - if (!"data_plot" %in% class(x)) { + if (!inherits(x, "data_plot")) { x <- data_plot(x, data = data, show_intercept = show_intercept) } diff --git a/R/plot.p_significance.R b/R/plot.p_significance.R index 910718cd3..c1d631d43 100644 --- a/R/plot.p_significance.R +++ b/R/plot.p_significance.R @@ -42,7 +42,10 @@ data_plot.p_significance <- function(x, ) ) } else { - dataplot <- rbind(dataplot, .compute_densities_ps(data[[i]], name = i, threshold = attr(x, "threshold"))) + dataplot <- rbind( + dataplot, + .compute_densities_ps(data[[i]], name = i, threshold = attr(x, "threshold")) + ) } } @@ -163,7 +166,7 @@ data_plot.p_significance <- function(x, #' library(rstanarm) #' library(bayestestR) #' set.seed(123) -#' m <<- stan_glm(Sepal.Length ~ Petal.Width * Species, data = iris, refresh = 0) +#' m <<- suppressWarnings(stan_glm(Sepal.Length ~ Petal.Width * Species, data = iris, refresh = 0)) #' result <- p_significance(m) #' plot(result) #' @importFrom ggplot2 .data @@ -179,13 +182,13 @@ plot.see_p_significance <- function(x, model <- .retrieve_data(x) # retrieve and prepare data for plotting - if (!"data_plot" %in% class(x)) { + if (!inherits(x, "data_plot")) { 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 ((!"Effects" %in% names(x) || length(unique(x$Effects)) <= 1L) && + (!"Component" %in% names(x) || length(unique(x$Component)) <= 1L)) { n_columns <- NULL } @@ -227,7 +230,7 @@ plot.see_p_significance <- function(x, guides(fill = "none", color = "none", group = "none") - if (length(unique(x$y)) == 1 && is.numeric(x$y)) { + if (length(unique(x$y)) == 1L && is.numeric(x$y)) { p <- p + scale_y_continuous(breaks = NULL, labels = NULL) } else { p <- p + scale_y_discrete(labels = labels) diff --git a/R/plot.parameters_brms_meta.R b/R/plot.parameters_brms_meta.R index c207830c8..6f1c15f4f 100644 --- a/R/plot.parameters_brms_meta.R +++ b/R/plot.parameters_brms_meta.R @@ -158,7 +158,7 @@ plot.see_parameters_brms_meta <- function(x, ) - if (!"data_plot" %in% class(x)) { + if (!inherits(x, "data_plot")) { x <- data_plot(x, data = model, normalize_height = normalize_height, ...) } diff --git a/R/plot.parameters_model.R b/R/plot.parameters_model.R index bbf455c7d..ffd7e78e6 100644 --- a/R/plot.parameters_model.R +++ b/R/plot.parameters_model.R @@ -84,7 +84,7 @@ plot.see_parameters_model <- function(x, # is exp? exponentiated_coefs <- isTRUE(model_attributes$exponentiate) - y_intercept <- ifelse(exponentiated_coefs, 1, 0) + y_intercept <- as.numeric(exponentiated_coefs) # label for coefficient scale coefficient_name <- model_attributes$coefficient_name @@ -108,7 +108,7 @@ plot.see_parameters_model <- function(x, } # check if multiple CIs - if (sum(grepl("^CI_low", colnames(x))) > 1L) { + if (sum(startsWith(colnames(x), "CI_low")) > 1L) { multiple_ci <- TRUE x <- datawizard::reshape_ci(x) } else { @@ -133,7 +133,7 @@ plot.see_parameters_model <- function(x, if (all(x$Group == "")) { x$Group <- NULL } else { - x <- x[!grepl("^SD/Cor", x$Group), , drop = FALSE] + x <- x[!startsWith(x$Group, "SD/Cor"), , drop = FALSE] } } attributes(x) <- c(attributes(x), model_attributes) @@ -170,7 +170,7 @@ plot.see_parameters_model <- function(x, } if (isTRUE(show_density)) { - insight::check_if_installed(c("ggdist")) + insight::check_if_installed("ggdist") # TODO: Handle Effects and Components # TODO: Handle meta-analysis models @@ -184,10 +184,7 @@ plot.see_parameters_model <- function(x, # MCMC or bootstrapped models if (is.null(data)) { - stop( - insight::format_message("Could not retrieve parameter simulations."), - call. = FALSE - ) + insight::format_error("Could not retrieve parameter simulations.") } data <- datawizard::reshape_longer( @@ -196,7 +193,7 @@ plot.see_parameters_model <- function(x, rows_to = "Iteration", values_to = "Coefficient" ) - group <- x[, c("Parameter"), drop = FALSE] + group <- x[, "Parameter", drop = FALSE] group$group <- factor(x$Coefficient < y_intercept, levels = c(FALSE, TRUE)) data <- merge(data, group, by = "Parameter") if (isTRUE(exponentiated_coefs)) { @@ -309,13 +306,11 @@ plot.see_parameters_model <- function(x, } - if (!show_intercept) { - if (length(.in_intercepts(x$Parameter)) > 0L) { - x <- x[!.in_intercepts(x$Parameter), ] - if (show_density && (is_bayesian || is_bootstrap)) { - data <- data[!.in_intercepts(data$Parameter), ] - density_layer$data <- data - } + if (!show_intercept && length(.in_intercepts(x$Parameter)) > 0L) { + x <- x[!.in_intercepts(x$Parameter), ] + if (show_density && (is_bayesian || is_bootstrap)) { + data <- data[!.in_intercepts(data$Parameter), ] + density_layer$data <- data } } @@ -518,7 +513,7 @@ plot.see_parameters_model <- function(x, } else if (has_response) { p <- p + facet_wrap(~Response, ncol = n_columns, scales = facet_scales) } else if (has_subgroups) { - suppressWarnings(p <- p + facet_grid(Subgroup ~ ., scales = "free", space = "free")) + suppressWarnings(p <- p + facet_grid(Subgroup ~ ., scales = "free", space = "free")) # nolint } if (length(model_attributes$parameter_names) > 1L) { @@ -545,7 +540,7 @@ plot.see_parameters_model <- function(x, p + labs( y = parameter_label, x = ifelse(is.null(coefficient_name), - ifelse(exponentiated_coefs, "Exp(Estimate)", "Estimate"), + ifelse(exponentiated_coefs, "Exp(Estimate)", "Estimate"), # nolint coefficient_name ), colour = "CI" diff --git a/R/plot.parameters_pca.R b/R/plot.parameters_pca.R index 47a27d509..d808cff7d 100644 --- a/R/plot.parameters_pca.R +++ b/R/plot.parameters_pca.R @@ -80,7 +80,7 @@ plot.see_parameters_pca <- function(x, ...) { type <- match.arg(type) - if (!"data_plot" %in% class(x)) { + if (!inherits(x, "data_plot")) { x <- data_plot(x) } diff --git a/R/plot.parameters_sem.R b/R/plot.parameters_sem.R index f6d921841..0442cbffa 100644 --- a/R/plot.parameters_sem.R +++ b/R/plot.parameters_sem.R @@ -58,16 +58,18 @@ data_plot.parameters_sem <- function(x, edges$Label_Regression <- ifelse(edges$Component == "Regression", edges$Label, "") edges$Label_Correlation <- ifelse(edges$Component == "Correlation", edges$Label, "") edges$Label_Loading <- ifelse(edges$Component == "Loading", edges$Label, "") - edges <- edges[colSums(!is.na(edges)) > 0] + edges <- edges[colSums(!is.na(edges)) > 0L] # Identify nodes latent_nodes <- data.frame( Name = as.character(edges[edges$Component == "Loading", "to"]), - Latent = TRUE + Latent = TRUE, + stringsAsFactors = FALSE ) manifest_nodes <- data.frame( Name = unique(c(edges$from, edges$to)), - Latent = FALSE + Latent = FALSE, + stringsAsFactors = FALSE ) manifest_nodes <- manifest_nodes[!manifest_nodes$Name %in% latent_nodes$Name, ] nodes <- rbind(manifest_nodes, latent_nodes) @@ -96,7 +98,7 @@ plot.see_parameters_sem <- function(x, ci = TRUE, size_point = 22, ...) { - if (!"data_plot" %in% class(x)) { + if (!inherits(x, "data_plot")) { x <- data_plot( x, component = component, diff --git a/R/plot.parameters_simulate.R b/R/plot.parameters_simulate.R index b81518581..7e5512874 100644 --- a/R/plot.parameters_simulate.R +++ b/R/plot.parameters_simulate.R @@ -100,7 +100,7 @@ plot.see_parameters_simulate <- function(x, centrality <- attributes(x)$centrality } - if (!"data_plot" %in% class(x)) { + if (!inherits(x, "data_plot")) { x <- data_plot(x, data = data, normalize_height = normalize_height) } diff --git a/R/plot.performance_pp_check.R b/R/plot.performance_pp_check.R index c8118a46d..c4ecd98c5 100644 --- a/R/plot.performance_pp_check.R +++ b/R/plot.performance_pp_check.R @@ -46,11 +46,9 @@ data_plot.performance_pp_check <- function(x, ...) { #' #' @return A ggplot2-object. #' -#' @examples -#' if (require("performance")) { -#' model <- lm(Sepal.Length ~ Species * Petal.Width + Petal.Length, data = iris) -#' check_posterior_predictions(model) -#' } +#' @examplesIf require("performance") +#' model <- lm(Sepal.Length ~ Species * Petal.Width + Petal.Length, data = iris) +#' check_posterior_predictions(model) #' @export print.see_performance_pp_check <- function(x, size_line = 0.5, @@ -62,7 +60,7 @@ print.see_performance_pp_check <- function(x, orig_x <- x check_range <- isTRUE(attributes(x)$check_range) - if (!"data_plot" %in% class(x)) { + if (!inherits(x, "data_plot")) { x <- data_plot(x) } @@ -91,7 +89,7 @@ plot.see_performance_pp_check <- function(x, orig_x <- x check_range <- isTRUE(attributes(x)$check_range) - if (!"data_plot" %in% class(x)) { + if (!inherits(x, "data_plot")) { x <- data_plot(x) } @@ -138,13 +136,14 @@ plot.see_performance_pp_check <- function(x, values = c( "Observed data" = 2 * size_line, "Model-predicted data" = size_line - ), + ) ) + ggplot2::scale_alpha_manual( values = c( "Observed data" = 1, "Model-predicted data" = line_alpha - ), guide = "none" + ), + guide = "none" ) + ggplot2::labs( x = info$xlab, @@ -182,7 +181,9 @@ plot.see_performance_pp_check <- function(x, } -.plot_pp_check_range <- function(x, size_bar = 0.7, colors) { +.plot_pp_check_range <- function(x, + size_bar = 0.7, + colors = unname(social_colors(c("green", "blue")))) { original <- data.frame( x = c(min(x$y), max(x$y)), diff --git a/R/plot.point_estimates.R b/R/plot.point_estimates.R index 7dde1d76d..b3479cbe8 100644 --- a/R/plot.point_estimates.R +++ b/R/plot.point_estimates.R @@ -94,7 +94,7 @@ data_plot.map_estimate <- data_plot.point_estimate #' library(rstanarm) #' library(bayestestR) #' set.seed(123) -#' m <<- stan_glm(Sepal.Length ~ Petal.Width * Species, data = iris, refresh = 0) +#' m <<- suppressWarnings(stan_glm(Sepal.Length ~ Petal.Width * Species, data = iris, refresh = 0)) #' result <- point_estimate(m, centrality = "median") #' result #' plot(result) @@ -113,7 +113,7 @@ plot.see_point_estimate <- function(x, # save model for later use model <- .retrieve_data(x) - if (!"data_plot" %in% class(x)) { + if (!inherits(x, "data_plot")) { x <- data_plot(x, data = data) } diff --git a/R/plot.rope.R b/R/plot.rope.R index 9b5204302..9ed3d46a4 100644 --- a/R/plot.rope.R +++ b/R/plot.rope.R @@ -79,7 +79,7 @@ data_plot.rope <- function(x, data = NULL, show_intercept = FALSE, ...) { #' library(rstanarm) #' library(bayestestR) #' set.seed(123) -#' m <<- stan_glm(Sepal.Length ~ Petal.Width * Species, data = iris, refresh = 0) +#' m <<- suppressWarnings(stan_glm(Sepal.Length ~ Petal.Width * Species, data = iris, refresh = 0)) #' result <- rope(m) #' result #' plot(result) @@ -92,7 +92,7 @@ plot.see_rope <- function(x, show_intercept = FALSE, n_columns = 1, ...) { - if (!"data_plot" %in% class(x)) { + if (!inherits(x, "data_plot")) { x <- data_plot(x, data = data, show_intercept = show_intercept) } diff --git a/R/plot.si.R b/R/plot.si.R index 9b84486ee..2ddbdae25 100644 --- a/R/plot.si.R +++ b/R/plot.si.R @@ -16,7 +16,7 @@ #' library(rstanarm) #' library(bayestestR) #' set.seed(123) -#' m <<- stan_glm(Sepal.Length ~ Petal.Width * Species, data = iris, refresh = 0) +#' m <<- suppressWarnings(stan_glm(Sepal.Length ~ Petal.Width * Species, data = iris, refresh = 0)) #' result <- si(m) #' result #' plot(result) diff --git a/R/scale_color_flat.R b/R/scale_color_flat.R index e81e314fe..8c55cd647 100644 --- a/R/scale_color_flat.R +++ b/R/scale_color_flat.R @@ -30,7 +30,11 @@ #' theme_modern() + #' scale_color_flat_c(palette = "rainbow") #' @export -scale_color_flat <- function(palette = "contrast", discrete = TRUE, reverse = FALSE, aesthetics = "color", ...) { +scale_color_flat <- function(palette = "contrast", + discrete = TRUE, + reverse = FALSE, + aesthetics = "color", + ...) { pal <- palette_flat(palette = palette, reverse = reverse) if (discrete) { @@ -47,14 +51,34 @@ scale_color_flat <- function(palette = "contrast", discrete = TRUE, reverse = FA #' @rdname scale_color_flat #' @export -scale_color_flat_d <- function(palette = "contrast", discrete = TRUE, reverse = FALSE, aesthetics = "color", ...) { - scale_color_flat(palette = palette, discrete = discrete, reverse = reverse, aesthetics = aesthetics, ...) +scale_color_flat_d <- function(palette = "contrast", + discrete = TRUE, + reverse = FALSE, + aesthetics = "color", + ...) { + scale_color_flat( + palette = palette, + discrete = discrete, + reverse = reverse, + aesthetics = aesthetics, + ... + ) } #' @rdname scale_color_flat #' @export -scale_color_flat_c <- function(palette = "contrast", discrete = FALSE, reverse = FALSE, aesthetics = "color", ...) { - scale_color_flat(palette = palette, discrete = discrete, reverse = reverse, aesthetics = aesthetics, ...) +scale_color_flat_c <- function(palette = "contrast", + discrete = FALSE, + reverse = FALSE, + aesthetics = "color", + ...) { + scale_color_flat( + palette = palette, + discrete = discrete, + reverse = reverse, + aesthetics = aesthetics, + ... + ) } #' @rdname scale_color_flat @@ -79,7 +103,11 @@ scale_colour_flat_d <- scale_color_flat_d #' @rdname scale_color_flat #' @export -scale_fill_flat <- function(palette = "contrast", discrete = TRUE, reverse = FALSE, aesthetics = "fill", ...) { +scale_fill_flat <- function(palette = "contrast", + discrete = TRUE, + reverse = FALSE, + aesthetics = "fill", + ...) { pal <- palette_flat(palette = palette, reverse = reverse) if (discrete) { @@ -92,14 +120,34 @@ scale_fill_flat <- function(palette = "contrast", discrete = TRUE, reverse = FAL #' @rdname scale_color_flat #' @export -scale_fill_flat_d <- function(palette = "contrast", discrete = TRUE, reverse = FALSE, aesthetics = "fill", ...) { - scale_fill_flat(palette = palette, discrete = discrete, reverse = reverse, aesthetics = aesthetics, ...) +scale_fill_flat_d <- function(palette = "contrast", + discrete = TRUE, + reverse = FALSE, + aesthetics = "fill", + ...) { + scale_fill_flat( + palette = palette, + discrete = discrete, + reverse = reverse, + aesthetics = aesthetics, + ... + ) } #' @rdname scale_color_flat #' @export -scale_fill_flat_c <- function(palette = "contrast", discrete = FALSE, reverse = FALSE, aesthetics = "fill", ...) { - scale_fill_flat(palette = palette, discrete = discrete, reverse = reverse, aesthetics = aesthetics, ...) +scale_fill_flat_c <- function(palette = "contrast", + discrete = FALSE, + reverse = FALSE, + aesthetics = "fill", + ...) { + scale_fill_flat( + palette = palette, + discrete = discrete, + reverse = reverse, + aesthetics = aesthetics, + ... + ) } @@ -162,10 +210,31 @@ flat_colors <- function(...) { flat_palettes <- list( `full` = flat_colors(), `ice` = flat_colors("purple", "deep purple", "blue", "light blue"), - `rainbow` = flat_colors("purple", "deep purple", "blue", "light blue", "green", "light green", "amber", "orange", "deep orange", "red"), + `rainbow` = flat_colors( + "purple", + "deep purple", + "blue", + "light blue", + "green", + "light green", + "amber", + "orange", + "deep orange", + "red" + ), `contrast` = flat_colors("blue", "green", "amber", "purple", "red"), `light` = flat_colors("light blue", "purple", "yellow", "light green", "orange"), - `complement` = flat_colors("blue grey", "blue", "light blue", "teal", "green", "yellow", "amber", "orange", "red") + `complement` = flat_colors( + "blue grey", + "blue", + "light blue", + "teal", + "green", + "yellow", + "amber", + "orange", + "red" + ) ) diff --git a/R/scale_color_metro.R b/R/scale_color_metro.R index ef51b03ed..191f88adb 100644 --- a/R/scale_color_metro.R +++ b/R/scale_color_metro.R @@ -27,7 +27,11 @@ #' theme_modern() + #' scale_color_metro_c(palette = "rainbow") #' @export -scale_color_metro <- function(palette = "complement", discrete = TRUE, reverse = FALSE, aesthetics = "color", ...) { +scale_color_metro <- function(palette = "complement", + discrete = TRUE, + reverse = FALSE, + aesthetics = "color", + ...) { pal <- palette_metro(palette = palette, reverse = reverse) if (discrete) { @@ -44,14 +48,34 @@ scale_color_metro <- function(palette = "complement", discrete = TRUE, reverse = #' @rdname scale_color_metro #' @export -scale_color_metro_d <- function(palette = "complement", discrete = TRUE, reverse = FALSE, aesthetics = "color", ...) { - scale_color_metro(palette = palette, discrete = discrete, reverse = reverse, aesthetics = aesthetics, ...) +scale_color_metro_d <- function(palette = "complement", + discrete = TRUE, + reverse = FALSE, + aesthetics = "color", + ...) { + scale_color_metro( + palette = palette, + discrete = discrete, + reverse = reverse, + aesthetics = aesthetics, + ... + ) } #' @rdname scale_color_metro #' @export -scale_color_metro_c <- function(palette = "complement", discrete = FALSE, reverse = FALSE, aesthetics = "color", ...) { - scale_color_metro(palette = palette, discrete = discrete, reverse = reverse, aesthetics = aesthetics, ...) +scale_color_metro_c <- function(palette = "complement", + discrete = FALSE, + reverse = FALSE, + aesthetics = "color", + ...) { + scale_color_metro( + palette = palette, + discrete = discrete, + reverse = reverse, + aesthetics = aesthetics, + ... + ) } #' @rdname scale_color_metro @@ -76,7 +100,11 @@ scale_colour_metro_d <- scale_color_metro_d #' @rdname scale_color_metro #' @export -scale_fill_metro <- function(palette = "complement", discrete = TRUE, reverse = FALSE, aesthetics = "fill", ...) { +scale_fill_metro <- function(palette = "complement", + discrete = TRUE, + reverse = FALSE, + aesthetics = "fill", + ...) { pal <- palette_metro(palette = palette, reverse = reverse) if (discrete) { @@ -89,14 +117,34 @@ scale_fill_metro <- function(palette = "complement", discrete = TRUE, reverse = #' @rdname scale_color_metro #' @export -scale_fill_metro_d <- function(palette = "complement", discrete = TRUE, reverse = FALSE, aesthetics = "fill", ...) { - scale_fill_metro(palette = palette, discrete = discrete, reverse = reverse, aesthetics = aesthetics, ...) +scale_fill_metro_d <- function(palette = "complement", + discrete = TRUE, + reverse = FALSE, + aesthetics = "fill", + ...) { + scale_fill_metro( + palette = palette, + discrete = discrete, + reverse = reverse, + aesthetics = aesthetics, + ... + ) } #' @rdname scale_color_metro #' @export -scale_fill_metro_c <- function(palette = "complement", discrete = FALSE, reverse = FALSE, aesthetics = "fill", ...) { - scale_fill_metro(palette = palette, discrete = discrete, reverse = reverse, aesthetics = aesthetics, ...) +scale_fill_metro_c <- function(palette = "complement", + discrete = FALSE, + reverse = FALSE, + aesthetics = "fill", + ...) { + scale_fill_metro( + palette = palette, + discrete = discrete, + reverse = reverse, + aesthetics = aesthetics, + ... + ) } @@ -157,10 +205,31 @@ metro_colors <- function(...) { metro_palettes <- list( `full` = metro_colors(), `ice` = metro_colors("purple", "deep purple", "blue", "light blue"), - `rainbow` = metro_colors("purple", "deep purple", "blue", "light blue", "green", "light green", "amber", "orange", "deep orange", "red"), + `rainbow` = metro_colors( + "purple", + "deep purple", + "blue", + "light blue", + "green", + "light green", + "amber", + "orange", + "deep orange", + "red" + ), `contrast` = metro_colors("blue", "green", "amber", "purple", "red"), `light` = material_colors("light blue", "red", "yellow", "light green", "orange"), - `complement` = metro_colors("blue grey", "blue", "light blue", "teal", "green", "yellow", "amber", "orange", "red") + `complement` = metro_colors( + "blue grey", + "blue", + "light blue", + "teal", + "green", + "yellow", + "amber", + "orange", + "red" + ) ) diff --git a/R/scale_color_pizza.R b/R/scale_color_pizza.R index 31d3540c2..3d9a298ba 100644 --- a/R/scale_color_pizza.R +++ b/R/scale_color_pizza.R @@ -23,7 +23,11 @@ #' theme_modern() + #' scale_color_pizza_c() #' @export -scale_color_pizza <- function(palette = "margherita", discrete = TRUE, reverse = FALSE, aesthetics = "color", ...) { +scale_color_pizza <- function(palette = "margherita", + discrete = TRUE, + reverse = FALSE, + aesthetics = "color", + ...) { pal <- palette_pizza(palette = palette, reverse = reverse) if (discrete) { @@ -40,14 +44,34 @@ scale_color_pizza <- function(palette = "margherita", discrete = TRUE, reverse = #' @rdname scale_color_pizza #' @export -scale_color_pizza_d <- function(palette = "margherita", discrete = TRUE, reverse = FALSE, aesthetics = "color", ...) { - scale_color_pizza(palette = palette, discrete = discrete, reverse = reverse, aesthetics = aesthetics, ...) +scale_color_pizza_d <- function(palette = "margherita", + discrete = TRUE, + reverse = FALSE, + aesthetics = "color", + ...) { + scale_color_pizza( + palette = palette, + discrete = discrete, + reverse = reverse, + aesthetics = aesthetics, + ... + ) } #' @rdname scale_color_pizza #' @export -scale_color_pizza_c <- function(palette = "margherita", discrete = FALSE, reverse = FALSE, aesthetics = "color", ...) { - scale_color_pizza(palette = palette, discrete = discrete, reverse = reverse, aesthetics = aesthetics, ...) +scale_color_pizza_c <- function(palette = "margherita", + discrete = FALSE, + reverse = FALSE, + aesthetics = "color", + ...) { + scale_color_pizza( + palette = palette, + discrete = discrete, + reverse = reverse, + aesthetics = aesthetics, + ... + ) } #' @rdname scale_color_pizza @@ -64,15 +88,15 @@ scale_colour_pizza_d <- scale_color_pizza_d - - # Fill -------------------------------------------------------------------- - - #' @rdname scale_color_pizza #' @export -scale_fill_pizza <- function(palette = "margherita", discrete = TRUE, reverse = FALSE, aesthetics = "fill", ...) { +scale_fill_pizza <- function(palette = "margherita", + discrete = TRUE, + reverse = FALSE, + aesthetics = "fill", + ...) { pal <- palette_pizza(palette = palette, reverse = reverse) if (discrete) { @@ -85,14 +109,34 @@ scale_fill_pizza <- function(palette = "margherita", discrete = TRUE, reverse = #' @rdname scale_color_pizza #' @export -scale_fill_pizza_d <- function(palette = "margherita", discrete = TRUE, reverse = FALSE, aesthetics = "fill", ...) { - scale_fill_pizza(palette = palette, discrete = discrete, reverse = reverse, aesthetics = aesthetics, ...) +scale_fill_pizza_d <- function(palette = "margherita", + discrete = TRUE, + reverse = FALSE, + aesthetics = "fill", + ...) { + scale_fill_pizza( + palette = palette, + discrete = discrete, + reverse = reverse, + aesthetics = aesthetics, + ... + ) } #' @rdname scale_color_pizza #' @export -scale_fill_pizza_c <- function(palette = "margherita", discrete = FALSE, reverse = FALSE, aesthetics = "fill", ...) { - scale_fill_pizza(palette = palette, discrete = discrete, reverse = reverse, aesthetics = aesthetics, ...) +scale_fill_pizza_c <- function(palette = "margherita", + discrete = FALSE, + reverse = FALSE, + aesthetics = "fill", + ...) { + scale_fill_pizza( + palette = palette, + discrete = discrete, + reverse = reverse, + aesthetics = aesthetics, + ... + ) } @@ -143,9 +187,6 @@ pizza_palettes <- list( - - - #' Pizza color palette #' #' The palette based on authentic neapolitan pizzas. diff --git a/R/theme_modern.R b/R/theme_modern.R index 84fbdd01a..0dabbee75 100644 --- a/R/theme_modern.R +++ b/R/theme_modern.R @@ -7,7 +7,12 @@ #' @param plot.title.size Title size in pts. Can be "none". #' @param plot.title.face Title font face ("plain", "italic", "bold", "bold.italic"). #' @param plot.title.space Title spacing. -#' @param plot.title.position Alignment of the plot title/subtitle and caption. The setting for plot.title.position applies to both the title and the subtitle. A value of "panel" (the default) means that titles and/or caption are aligned to the plot panels. A value of "plot" means that titles and/or caption are aligned to the entire plot (minus any space for margins and plot tag). +#' @param plot.title.position Alignment of the plot title/subtitle and caption. +#' The setting for plot.title.position applies to both the title and the +#' subtitle. A value of "panel" (the default) means that titles and/or caption +#' are aligned to the plot panels. A value of "plot" means that titles and/or +#' caption are aligned to the entire plot (minus any space for margins and +#' plot tag). #' @param legend.title.size Legend elements text size in pts. #' @param legend.text.size Legend elements text size in pts. Can be "none". #' @param axis.title.space Axis title spacing. @@ -26,93 +31,92 @@ #' geom_point() + #' theme_modern() #' @export -theme_modern <- - function(base_size = 11, - base_family = "", - plot.title.size = 15, - plot.title.face = "plain", - plot.title.space = 20, - plot.title.position = "plot", - legend.position = "right", - axis.title.space = 20, - legend.title.size = 13, - legend.text.size = 12, - axis.title.size = 13, - axis.title.face = "plain", - axis.text.size = 12, - axis.text.angle = NULL, - tags.size = 15, - tags.face = "bold") { - # Remove legend title if necessary - if (is.null(plot.title.size)) { - plot.title.size <- - element_text( - size = plot.title.size, - face = plot.title.face, - margin = margin(0, 0, plot.title.space, 0) - ) - } else if (plot.title.size == "none") { - plot.title.size <- element_blank() - } else { - plot.title.size <- - element_text( - size = plot.title.size, - face = plot.title.face, - margin = margin(0, 0, plot.title.space, 0) - ) - } - - # Remove legend title if necessary - if (is.null(legend.title.size)) { - legend.title.size <- element_text(size = legend.title.size) - } else if (legend.title.size == "none") { - legend.title.size <- element_blank() - } else { - legend.title.size <- element_text(size = legend.title.size) - } +theme_modern <- function(base_size = 11, + base_family = "", + plot.title.size = 15, + plot.title.face = "plain", + plot.title.space = 20, + plot.title.position = "plot", + legend.position = "right", + axis.title.space = 20, + legend.title.size = 13, + legend.text.size = 12, + axis.title.size = 13, + axis.title.face = "plain", + axis.text.size = 12, + axis.text.angle = NULL, + tags.size = 15, + tags.face = "bold") { + # Remove legend title if necessary + if (is.null(plot.title.size)) { + plot.title.size <- + element_text( + size = plot.title.size, + face = plot.title.face, + margin = margin(0, 0, plot.title.space, 0) + ) + } else if (plot.title.size == "none") { + plot.title.size <- element_blank() + } else { + plot.title.size <- + element_text( + size = plot.title.size, + face = plot.title.face, + margin = margin(0, 0, plot.title.space, 0) + ) + } - # Remove axis title if necessary - if (is.null(axis.title.size)) { - axis.title.size <- element_text(size = axis.title.size, face = axis.title.face) - } else if (axis.title.size == "none") { - axis.title.size <- element_blank() - } else { - axis.title.size <- element_text(size = axis.title.size, face = axis.title.face) - } + # Remove legend title if necessary + if (is.null(legend.title.size)) { + legend.title.size <- element_text(size = legend.title.size) + } else if (legend.title.size == "none") { + legend.title.size <- element_blank() + } else { + legend.title.size <- element_text(size = legend.title.size) + } - # Remove axis text if necessary - if (is.null(axis.text.size)) { - axis.text.size <- element_text(size = axis.text.size) - } else if (axis.text.size == "none") { - axis.text.size <- element_blank() - } else { - axis.text.size <- element_text(size = axis.text.size) - } + # Remove axis title if necessary + if (is.null(axis.title.size)) { + axis.title.size <- element_text(size = axis.title.size, face = axis.title.face) + } else if (axis.title.size == "none") { + axis.title.size <- element_blank() + } else { + axis.title.size <- element_text(size = axis.title.size, face = axis.title.face) + } - # Rotate - if (!is.null(axis.text.angle)) { - hjust <- 1 - } else { - hjust <- NULL - } + # Remove axis text if necessary + if (is.null(axis.text.size)) { + axis.text.size <- element_text(size = axis.text.size) + } else if (axis.text.size == "none") { + axis.text.size <- element_blank() + } else { + axis.text.size <- element_text(size = axis.text.size) + } - theme_classic(base_size = base_size, base_family = base_family) + - theme( - plot.title = plot.title.size, - plot.title.position = plot.title.position, - legend.position = legend.position, - legend.text = element_text(size = legend.text.size), - legend.title = legend.title.size, - legend.key = element_blank(), - legend.spacing.x = unit(2, "pt"), - axis.title.y = element_text(margin = margin(t = 0, r = axis.title.space, b = 0, l = 0)), - axis.title.x = element_text(margin = margin(t = axis.title.space, r = 0, b = 0, l = 0)), - axis.title = axis.title.size, - axis.text.x = element_text(angle = axis.text.angle, hjust = hjust), - axis.text = axis.text.size, - axis.ticks = element_blank(), - plot.tag = element_text(size = tags.size, face = tags.face), - strip.background = element_blank(), - strip.text = element_text(face = "bold") - ) + # Rotate + if (!is.null(axis.text.angle)) { + hjust <- 1 + } else { + hjust <- NULL } + + theme_classic(base_size = base_size, base_family = base_family) + + theme( + plot.title = plot.title.size, + plot.title.position = plot.title.position, + legend.position = legend.position, + legend.text = element_text(size = legend.text.size), + legend.title = legend.title.size, + legend.key = element_blank(), + legend.spacing.x = unit(2, "pt"), + axis.title.y = element_text(margin = margin(t = 0, r = axis.title.space, b = 0, l = 0)), + axis.title.x = element_text(margin = margin(t = axis.title.space, r = 0, b = 0, l = 0)), + axis.title = axis.title.size, + axis.text.x = element_text(angle = axis.text.angle, hjust = hjust), + axis.text = axis.text.size, + axis.ticks = element_blank(), + plot.tag = element_text(size = tags.size, face = tags.face), + strip.background = element_blank(), + strip.text = element_text(face = "bold") + ) +} diff --git a/R/theme_radar.R b/R/theme_radar.R index 6e656770f..400b53a60 100644 --- a/R/theme_radar.R +++ b/R/theme_radar.R @@ -7,24 +7,22 @@ #' #' @seealso [coord_radar()] #' -#' @examples -#' if (require("ggplot2") && require("poorman")) { -#' data <- iris[-5] %>% -#' aggregate(list(Species = iris$Species), mean) %>% -#' datawizard::reshape_longer(c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width")) +#' @examplesIf require("ggplot2") && require("poorman") +#' data <- iris[-5] %>% +#' aggregate(list(Species = iris$Species), mean) %>% +#' datawizard::reshape_longer(c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width")) #' -#' data %>% -#' ggplot(aes( -#' x = name, -#' y = value, -#' color = Species, -#' group = Species, -#' fill = Species -#' )) + -#' geom_polygon(linewidth = 1, alpha = 0.1) + -#' coord_radar() + -#' theme_radar() -#' } +#' data %>% +#' ggplot(aes( +#' x = name, +#' y = value, +#' color = Species, +#' group = Species, +#' fill = Species +#' )) + +#' geom_polygon(linewidth = 1, alpha = 0.1) + +#' coord_radar() + +#' theme_radar() #' @export theme_radar <- function(base_size = 11, base_family = "", diff --git a/R/utils.R b/R/utils.R index 477165d04..aa3b495bc 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,15 +1,15 @@ -.as.data.frame_density <- function(x, ...) { - data.frame(x = x$x, y = x$y) -} - - +.str_to_sym <- function(x) { + insight::check_if_installed("rlang") + if (!is.null(x) && is.character(x)) { + x <- rlang::sym(x) + } -.normalize <- function(x) { - as.vector((x - min(x, na.rm = TRUE)) / diff(range(x, na.rm = TRUE), na.rm = TRUE)) + return(x) } - - +.as.data.frame_density <- function(x, ...) { + data.frame(x = x$x, y = x$y) +} # safe conversion from factor to numeric .factor_to_numeric <- function(x) { @@ -56,9 +56,9 @@ if (any(cor_sd)) { params[cor_sd] <- paste("SD/Cor: ", gsub("^(sd_|cor_)(.*?)__(.*)", "\\3", params[cor_sd], perl = TRUE)) # replace "__" by "~" - cor_only <- grepl("^cor_", params[cor_sd]) + cor_only <- !is.na(params[cor_sd]) & startsWith(params[cor_sd], "cor_") if (any(cor_only)) { - params[cor_sd][which(cor_sd)[cor_only]] <- sub("__", " ~ ", params[cor_sd][which(cor_sd)[cor_only]]) + params[cor_sd][which(cor_sd)[cor_only]] <- sub("__", " ~ ", params[cor_sd][which(cor_sd)[cor_only]], fixed = TRUE) } } # correlation and sd: rstanarm @@ -114,21 +114,28 @@ .intercepts <- function() { - c("(intercept)_zi", "intercept (zero-inflated)", "intercept", "zi_intercept", "(intercept)", "b_intercept", "b_zi_intercept") + c( + "(intercept)_zi", + "intercept (zero-inflated)", + "intercept", + "zi_intercept", + "(intercept)", + "b_intercept", + "b_zi_intercept" + ) } .has_intercept <- function(x) { - tolower(x) %in% .intercepts() | grepl("^intercept", tolower(x)) + x <- tolower(x) + x %in% .intercepts() | !is.na(x) & startsWith(x, "intercept") } -.in_intercepts <- function(x) { - tolower(x) %in% .intercepts() | grepl("^intercept", tolower(x)) -} +.in_intercepts <- .has_intercept -.remove_intercept <- function(x, column = "Parameter", show_intercept) { +.remove_intercept <- function(x, column = "Parameter", show_intercept = FALSE) { if (!show_intercept) { remove <- which(.in_intercepts(x[[column]])) if (length(remove)) x <- x[-remove, ] @@ -137,10 +144,8 @@ } - - .percents <- function(x) { - insight::format_value(x = x, as_percent = TRUE, digits = 0) + insight::format_value(x = x, as_percent = TRUE, digits = 0L) } diff --git a/R/utils_add_prior_layer.R b/R/utils_add_prior_layer.R index 6bb4ae382..8c2dbab76 100644 --- a/R/utils_add_prior_layer.R +++ b/R/utils_add_prior_layer.R @@ -42,7 +42,8 @@ group = as.factor(.data$Parameter) ), fill = fill_color, - alpha = priors_alpha + alpha = priors_alpha, + na.rm = TRUE ) } else { ggridges::geom_ridgeline( @@ -55,7 +56,8 @@ ), fill = fill_color, alpha = priors_alpha, - color = NA + color = NA, + na.rm = TRUE ) } } else { @@ -69,7 +71,8 @@ group = as.factor(.data$Parameter), fill = "Priors" ), - alpha = priors_alpha + alpha = priors_alpha, + na.rm = TRUE ) } else { ggridges::geom_ridgeline( @@ -82,7 +85,8 @@ fill = "Priors" ), alpha = priors_alpha, - color = NA + color = NA, + na.rm = TRUE ) } } diff --git a/man/add_plot_attributes.Rd b/man/add_plot_attributes.Rd index 3e42bda69..1c6693ed9 100644 --- a/man/add_plot_attributes.Rd +++ b/man/add_plot_attributes.Rd @@ -21,11 +21,11 @@ library(bayestestR) library(see) library(ggplot2) -model <- stan_glm( +model <- suppressWarnings(stan_glm( Sepal.Length ~ Petal.Width + Species + Sepal.Width, data = iris, chains = 2, iter = 200 -) +)) result <- hdi(model, ci = c(0.5, 0.75, 0.9, 0.95)) data <- data_plot(result, data = model) diff --git a/man/coord_radar.Rd b/man/coord_radar.Rd index 5dcc026eb..e6d8e4fb2 100644 --- a/man/coord_radar.Rd +++ b/man/coord_radar.Rd @@ -20,17 +20,17 @@ is applied clockwise or anticlockwise depending on value of \code{direction}.} Add a radar coordinate system useful for radar charts. } \examples{ +\dontshow{if (require("datawizard") && require("ggplot2")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} # Create a radar/spider chart with ggplot: -if (require("datawizard") && require("ggplot2")) { - data(iris) - data <- aggregate(iris[-5], list(Species = iris$Species), mean) - data <- data_to_long( - data, - c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width") - ) +data(iris) +data <- aggregate(iris[-5], list(Species = iris$Species), mean) +data <- data_to_long( + data, + c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width") +) - ggplot(data, aes(x = name, y = value, color = Species, group = Species)) + - geom_polygon(fill = NA, linewidth = 2) + - coord_radar(start = -pi / 4) -} +ggplot(data, aes(x = name, y = value, color = Species, group = Species)) + + geom_polygon(fill = NA, linewidth = 2) + + coord_radar(start = -pi / 4) +\dontshow{\}) # examplesIf} } diff --git a/man/data_plot.Rd b/man/data_plot.Rd index 7d1010a63..725361f3f 100644 --- a/man/data_plot.Rd +++ b/man/data_plot.Rd @@ -66,13 +66,13 @@ these are shown in the 'Usage' section. library(bayestestR) library(rstanarm) -model <<- stan_glm( +model <<- suppressWarnings(stan_glm( Sepal.Length ~ Petal.Width * Species, data = iris, chains = 2, iter = 200, refresh = 0 -) +)) -x <- rope(model) +x <- rope(model, verbose = FALSE) plot(x) x <- hdi(model) @@ -82,17 +82,17 @@ data <- rnorm(1000, 1) x <- p_direction(data) plot(x) -x <- p_direction(model) +x <- p_direction(model, verbose = FALSE) plot(x) -model <<- stan_glm( +model <<- suppressWarnings(stan_glm( mpg ~ wt + gear + cyl + disp, chains = 2, iter = 200, refresh = 0, data = mtcars -) -x <- equivalence_test(model) +)) +x <- equivalence_test(model, verbose = FALSE) plot(x) \dontshow{\}) # examplesIf} } diff --git a/man/geom_from_list.Rd b/man/geom_from_list.Rd index 709861807..2924376ec 100644 --- a/man/geom_from_list.Rd +++ b/man/geom_from_list.Rd @@ -124,24 +124,5 @@ ggplot(iris, aes(x = Sepal.Length, y = Petal.Width)) + geom_from_list(list(geom = "smooth", color = "red")) + geom_from_list(list(aes = list(x = "Sepal.Length"), geom = "ggside::geom_xsidedensity")) + geom_from_list(list(geom = "ggside::scale_xsidey_continuous", breaks = NULL)) - -# Example 6 (ggraph) -------------------------- -\dontshow{\}) # examplesIf} -\dontshow{if (require("tidygraph") && require("ggraph")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} -library(tidygraph) -library(ggraph) - -# Prepare graph -nodes <- data.frame(name = c("Death", "Famine", "War", "Conquest")) -edges <- data.frame( - from = c(1, 1, 1, 2, 3, 3, 4, 4, 4), - to = c(2, 3, 4, 1, 1, 2, 1, 2, 3) -) -data <- tidygraph::tbl_graph(nodes = nodes, edges = edges) - -ggraph(data, layout = "kk") + - geom_from_list(list(geom = "ggraph::geom_edge_arc")) + - geom_from_list(list(geom = "ggraph::geom_node_point", size = 10)) + - geom_from_list(list(geom = "ggraph::geom_node_label", aes = list(label = "name"))) \dontshow{\}) # examplesIf} } diff --git a/man/plot.see_compare_parameters.Rd b/man/plot.see_compare_parameters.Rd index e7e6e8cd8..5fd9f2c25 100644 --- a/man/plot.see_compare_parameters.Rd +++ b/man/plot.see_compare_parameters.Rd @@ -59,14 +59,12 @@ The \code{plot()} method for the \code{parameters::compare_parameters()} function. } \examples{ -if (require("insight") && - require("parameters") && - packageVersion("insight") >= "0.13.0") { - data(iris) - lm1 <- lm(Sepal.Length ~ Species, data = iris) - lm2 <- lm(Sepal.Length ~ Species + Petal.Length, data = iris) - lm3 <- lm(Sepal.Length ~ Species * Petal.Length, data = iris) - result <- compare_parameters(lm1, lm2, lm3) - plot(result) -} +\dontshow{if (require("insight") && require("parameters")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +data(iris) +lm1 <- lm(Sepal.Length ~ Species, data = iris) +lm2 <- lm(Sepal.Length ~ Species + Petal.Length, data = iris) +lm3 <- lm(Sepal.Length ~ Species * Petal.Length, data = iris) +result <- compare_parameters(lm1, lm2, lm3) +plot(result) +\dontshow{\}) # examplesIf} } diff --git a/man/plot.see_estimate_contrasts.Rd b/man/plot.see_estimate_contrasts.Rd index a336bf318..6556c0036 100644 --- a/man/plot.see_estimate_contrasts.Rd +++ b/man/plot.see_estimate_contrasts.Rd @@ -22,10 +22,12 @@ The \code{plot()} method for the \code{modelbased::estimate_contrasts()} function. } \examples{ -\dontshow{if (identical(Sys.getenv("NOT_CRAN"), "true") && require("modelbased") && require("rstanarm") && require("emmeans")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} -model <- stan_glm(Sepal.Width ~ Species, data = iris, refresh = 0) +\dontshow{if (require("modelbased") && require("rstanarm") && require("emmeans")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +\donttest{ +model <- suppressWarnings(stan_glm(Sepal.Width ~ Species, data = iris, refresh = 0)) contrasts <- estimate_contrasts(model) means <- estimate_means(model) plot(contrasts, means) +} \dontshow{\}) # examplesIf} } diff --git a/man/plot.see_estimate_density.Rd b/man/plot.see_estimate_density.Rd index c9a90266b..0f0936797 100644 --- a/man/plot.see_estimate_density.Rd +++ b/man/plot.see_estimate_density.Rd @@ -68,7 +68,7 @@ The \code{plot()} method for the \code{bayestestR::estimate_density()} function. library(rstanarm) library(bayestestR) set.seed(123) -m <<- stan_glm(Sepal.Length ~ Petal.Width * Species, data = iris, refresh = 0) +m <<- suppressWarnings(stan_glm(Sepal.Length ~ Petal.Width * Species, data = iris, refresh = 0)) result <- estimate_density(m) plot(result) \dontshow{\}) # examplesIf} diff --git a/man/plot.see_hdi.Rd b/man/plot.see_hdi.Rd index a7e5c64e4..188304f82 100644 --- a/man/plot.see_hdi.Rd +++ b/man/plot.see_hdi.Rd @@ -45,11 +45,11 @@ The \code{plot()} method for the \code{bayestestR::hdi()} and related function. } \examples{ -\dontshow{if (require("rstanarm") && FALSE) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +\dontshow{if (identical(Sys.getenv("NOT_CRAN"), "true") && require("rstanarm")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} library(rstanarm) library(bayestestR) set.seed(123) -m <<- stan_glm(Sepal.Length ~ Petal.Width * Species, data = iris, refresh = 0) +m <<- suppressWarnings(stan_glm(Sepal.Length ~ Petal.Width * Species, data = iris, refresh = 0)) result <- hdi(m) result plot(result) diff --git a/man/plot.see_n_factors.Rd b/man/plot.see_n_factors.Rd index f5555c7ed..3d8b7db9f 100644 --- a/man/plot.see_n_factors.Rd +++ b/man/plot.see_n_factors.Rd @@ -26,10 +26,10 @@ A ggplot2-object. The \code{plot()} method for the \code{parameters::n_factors()} and \code{parameters::n_clusters()} } \examples{ -if (require("parameters") && require("nFactors")) { - data(mtcars) - result <- n_factors(mtcars, type = "PCA") - result - plot(result, type = "line") -} +\dontshow{if (require("parameters") && require("nFactors")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +data(mtcars) +result <- n_factors(mtcars, type = "PCA") +result +plot(result, type = "line") +\dontshow{\}) # examplesIf} } diff --git a/man/plot.see_p_direction.Rd b/man/plot.see_p_direction.Rd index c40f62f47..58c360cdc 100644 --- a/man/plot.see_p_direction.Rd +++ b/man/plot.see_p_direction.Rd @@ -50,7 +50,7 @@ The \code{plot()} method for the \code{bayestestR::p_direction()} function. library(rstanarm) library(bayestestR) set.seed(123) -m <<- stan_glm(Sepal.Length ~ Petal.Width * Species, data = iris, refresh = 0) +m <<- suppressWarnings(stan_glm(Sepal.Length ~ Petal.Width * Species, data = iris, refresh = 0)) result <- p_direction(m) plot(result) \dontshow{\}) # examplesIf} diff --git a/man/plot.see_p_significance.Rd b/man/plot.see_p_significance.Rd index 594a89814..d9bb4440d 100644 --- a/man/plot.see_p_significance.Rd +++ b/man/plot.see_p_significance.Rd @@ -50,7 +50,7 @@ The \code{plot()} method for the \code{bayestestR::p_significance()} function. library(rstanarm) library(bayestestR) set.seed(123) -m <<- stan_glm(Sepal.Length ~ Petal.Width * Species, data = iris, refresh = 0) +m <<- suppressWarnings(stan_glm(Sepal.Length ~ Petal.Width * Species, data = iris, refresh = 0)) result <- p_significance(m) plot(result) \dontshow{\}) # examplesIf} diff --git a/man/plot.see_point_estimate.Rd b/man/plot.see_point_estimate.Rd index 7508af530..d6ea11a64 100644 --- a/man/plot.see_point_estimate.Rd +++ b/man/plot.see_point_estimate.Rd @@ -61,7 +61,7 @@ The \code{plot()} method for the \code{bayestestR::point_estimate()}. library(rstanarm) library(bayestestR) set.seed(123) -m <<- stan_glm(Sepal.Length ~ Petal.Width * Species, data = iris, refresh = 0) +m <<- suppressWarnings(stan_glm(Sepal.Length ~ Petal.Width * Species, data = iris, refresh = 0)) result <- point_estimate(m, centrality = "median") result plot(result) diff --git a/man/plot.see_rope.Rd b/man/plot.see_rope.Rd index 90ecc61e8..e38bb418c 100644 --- a/man/plot.see_rope.Rd +++ b/man/plot.see_rope.Rd @@ -47,7 +47,7 @@ The \code{plot()} method for the \code{bayestestR::rope()}. library(rstanarm) library(bayestestR) set.seed(123) -m <<- stan_glm(Sepal.Length ~ Petal.Width * Species, data = iris, refresh = 0) +m <<- suppressWarnings(stan_glm(Sepal.Length ~ Petal.Width * Species, data = iris, refresh = 0)) result <- rope(m) result plot(result) diff --git a/man/plot.see_si.Rd b/man/plot.see_si.Rd index 6d5c19568..8b8dea8a9 100644 --- a/man/plot.see_si.Rd +++ b/man/plot.see_si.Rd @@ -43,7 +43,7 @@ The \code{plot()} method for the \code{bayestestR::si()}. library(rstanarm) library(bayestestR) set.seed(123) -m <<- stan_glm(Sepal.Length ~ Petal.Width * Species, data = iris, refresh = 0) +m <<- suppressWarnings(stan_glm(Sepal.Length ~ Petal.Width * Species, data = iris, refresh = 0)) result <- si(m) result plot(result) diff --git a/man/print.see_performance_pp_check.Rd b/man/print.see_performance_pp_check.Rd index 64b9389a3..2d4bc0a5d 100644 --- a/man/print.see_performance_pp_check.Rd +++ b/man/print.see_performance_pp_check.Rd @@ -48,8 +48,8 @@ A ggplot2-object. The \code{plot()} method for the \code{performance::check_predictions()} function. } \examples{ -if (require("performance")) { - model <- lm(Sepal.Length ~ Species * Petal.Width + Petal.Length, data = iris) - check_posterior_predictions(model) -} +\dontshow{if (require("performance")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +model <- lm(Sepal.Length ~ Species * Petal.Width + Petal.Length, data = iris) +check_posterior_predictions(model) +\dontshow{\}) # examplesIf} } diff --git a/man/theme_abyss.Rd b/man/theme_abyss.Rd index 32fa45933..c30304380 100644 --- a/man/theme_abyss.Rd +++ b/man/theme_abyss.Rd @@ -34,7 +34,12 @@ theme_abyss( \item{plot.title.space}{Title spacing.} -\item{plot.title.position}{Alignment of the plot title/subtitle and caption. The setting for plot.title.position applies to both the title and the subtitle. A value of "panel" (the default) means that titles and/or caption are aligned to the plot panels. A value of "plot" means that titles and/or caption are aligned to the entire plot (minus any space for margins and plot tag).} +\item{plot.title.position}{Alignment of the plot title/subtitle and caption. +The setting for plot.title.position applies to both the title and the +subtitle. A value of "panel" (the default) means that titles and/or caption +are aligned to the plot panels. A value of "plot" means that titles and/or +caption are aligned to the entire plot (minus any space for margins and +plot tag).} \item{legend.position}{the position of legends ("none", "left", "right", "bottom", "top", or two-element numeric vector)} diff --git a/man/theme_blackboard.Rd b/man/theme_blackboard.Rd index 7b46fc88b..651ccdce1 100644 --- a/man/theme_blackboard.Rd +++ b/man/theme_blackboard.Rd @@ -34,7 +34,12 @@ theme_blackboard( \item{plot.title.space}{Title spacing.} -\item{plot.title.position}{Alignment of the plot title/subtitle and caption. The setting for plot.title.position applies to both the title and the subtitle. A value of "panel" (the default) means that titles and/or caption are aligned to the plot panels. A value of "plot" means that titles and/or caption are aligned to the entire plot (minus any space for margins and plot tag).} +\item{plot.title.position}{Alignment of the plot title/subtitle and caption. +The setting for plot.title.position applies to both the title and the +subtitle. A value of "panel" (the default) means that titles and/or caption +are aligned to the plot panels. A value of "plot" means that titles and/or +caption are aligned to the entire plot (minus any space for margins and +plot tag).} \item{legend.position}{the position of legends ("none", "left", "right", "bottom", "top", or two-element numeric vector)} diff --git a/man/theme_lucid.Rd b/man/theme_lucid.Rd index dbc2900a2..a4f3cd68f 100644 --- a/man/theme_lucid.Rd +++ b/man/theme_lucid.Rd @@ -34,7 +34,12 @@ theme_lucid( \item{plot.title.space}{Title spacing.} -\item{plot.title.position}{Alignment of the plot title/subtitle and caption. The setting for plot.title.position applies to both the title and the subtitle. A value of "panel" (the default) means that titles and/or caption are aligned to the plot panels. A value of "plot" means that titles and/or caption are aligned to the entire plot (minus any space for margins and plot tag).} +\item{plot.title.position}{Alignment of the plot title/subtitle and caption. +The setting for plot.title.position applies to both the title and the +subtitle. A value of "panel" (the default) means that titles and/or caption +are aligned to the plot panels. A value of "plot" means that titles and/or +caption are aligned to the entire plot (minus any space for margins and +plot tag).} \item{legend.position}{the position of legends ("none", "left", "right", "bottom", "top", or two-element numeric vector)} diff --git a/man/theme_modern.Rd b/man/theme_modern.Rd index a5dea8fe4..5ea90e989 100644 --- a/man/theme_modern.Rd +++ b/man/theme_modern.Rd @@ -34,7 +34,12 @@ theme_modern( \item{plot.title.space}{Title spacing.} -\item{plot.title.position}{Alignment of the plot title/subtitle and caption. The setting for plot.title.position applies to both the title and the subtitle. A value of "panel" (the default) means that titles and/or caption are aligned to the plot panels. A value of "plot" means that titles and/or caption are aligned to the entire plot (minus any space for margins and plot tag).} +\item{plot.title.position}{Alignment of the plot title/subtitle and caption. +The setting for plot.title.position applies to both the title and the +subtitle. A value of "panel" (the default) means that titles and/or caption +are aligned to the plot panels. A value of "plot" means that titles and/or +caption are aligned to the entire plot (minus any space for margins and +plot tag).} \item{legend.position}{the position of legends ("none", "left", "right", "bottom", "top", or two-element numeric vector)} diff --git a/man/theme_radar.Rd b/man/theme_radar.Rd index 1b481417c..004e060f4 100644 --- a/man/theme_radar.Rd +++ b/man/theme_radar.Rd @@ -53,7 +53,12 @@ theme_radar_dark( \item{plot.title.space}{Title spacing.} -\item{plot.title.position}{Alignment of the plot title/subtitle and caption. The setting for plot.title.position applies to both the title and the subtitle. A value of "panel" (the default) means that titles and/or caption are aligned to the plot panels. A value of "plot" means that titles and/or caption are aligned to the entire plot (minus any space for margins and plot tag).} +\item{plot.title.position}{Alignment of the plot title/subtitle and caption. +The setting for plot.title.position applies to both the title and the +subtitle. A value of "panel" (the default) means that titles and/or caption +are aligned to the plot panels. A value of "plot" means that titles and/or +caption are aligned to the entire plot (minus any space for margins and +plot tag).} \item{legend.position}{the position of legends ("none", "left", "right", "bottom", "top", or two-element numeric vector)} @@ -81,23 +86,23 @@ theme_radar_dark( \code{theme_radar_dark()} is a dark variant of \code{theme_radar()}. } \examples{ -if (require("ggplot2") && require("poorman")) { - data <- iris[-5] \%>\% - aggregate(list(Species = iris$Species), mean) \%>\% - datawizard::reshape_longer(c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width")) - - data \%>\% - ggplot(aes( - x = name, - y = value, - color = Species, - group = Species, - fill = Species - )) + - geom_polygon(linewidth = 1, alpha = 0.1) + - coord_radar() + - theme_radar() -} +\dontshow{if (require("ggplot2") && require("poorman")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +data <- iris[-5] \%>\% + aggregate(list(Species = iris$Species), mean) \%>\% + datawizard::reshape_longer(c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width")) + +data \%>\% + ggplot(aes( + x = name, + y = value, + color = Species, + group = Species, + fill = Species + )) + + geom_polygon(linewidth = 1, alpha = 0.1) + + coord_radar() + + theme_radar() +\dontshow{\}) # examplesIf} } \seealso{ \code{\link[=coord_radar]{coord_radar()}} diff --git a/tests/testthat/test-plot.easycormatrix.R b/tests/testthat/test-plot.easycormatrix.R index a71067a0d..0bf3ff6c4 100644 --- a/tests/testthat/test-plot.easycormatrix.R +++ b/tests/testthat/test-plot.easycormatrix.R @@ -2,7 +2,7 @@ test_that("`plot.see_easycormatrix()` works", { skip_if_not_or_load_if_installed("correlation") skip_if_not(getRversion() >= "4.1") - result <- correlation(mtcars[, -c(8:9)]) + result <- correlation(mtcars[, -(8:9)]) s <- summary(result) expect_s3_class(suppressWarnings(plot(s)), "gg") }) diff --git a/tests/testthat/test-plot.estimate_contrasts.R b/tests/testthat/test-plot.estimate_contrasts.R index bd01de321..bdfc995d5 100644 --- a/tests/testthat/test-plot.estimate_contrasts.R +++ b/tests/testthat/test-plot.estimate_contrasts.R @@ -4,7 +4,7 @@ test_that("`plot.see_estimate_contrasts()` works", { skip_if_not_or_load_if_installed("emmeans") skip_if_not(getRversion() >= "4.1") - model <- rstanarm::stan_glm(Sepal.Width ~ Species, data = iris, refresh = 0) + model <- stan_glm(Sepal.Width ~ Species, data = iris, refresh = 0) contrasts <- modelbased::estimate_contrasts(model) means <- modelbased::estimate_means(model) expect_s3_class(plot(contrasts, means), "gg") diff --git a/tests/testthat/test-plot.estimate_density.R b/tests/testthat/test-plot.estimate_density.R index f75934c2e..38e809512 100644 --- a/tests/testthat/test-plot.estimate_density.R +++ b/tests/testthat/test-plot.estimate_density.R @@ -5,7 +5,7 @@ test_that("`plot.see_estimate_density()` works", { skip_if_not_or_load_if_installed("ggridges") set.seed(123) - m <<- stan_glm(Sepal.Length ~ Petal.Width * Species, data = iris, refresh = 0) + m <<- suppressWarnings(stan_glm(Sepal.Length ~ Petal.Width * Species, data = iris, refresh = 0)) result <- bayestestR::estimate_density(m) expect_s3_class(plot(result), "gg") }) diff --git a/tests/testthat/test-plot.hdi.R b/tests/testthat/test-plot.hdi.R index 24f205dae..fec9ea88f 100644 --- a/tests/testthat/test-plot.hdi.R +++ b/tests/testthat/test-plot.hdi.R @@ -3,7 +3,7 @@ test_that("`plot.see_hdi()` works", { skip_if_not_or_load_if_installed("ggridges") set.seed(123) - m <<- stan_glm(Sepal.Length ~ Petal.Width * Species, data = iris, refresh = 0) + m <<- suppressWarnings(stan_glm(Sepal.Length ~ Petal.Width * Species, data = iris, refresh = 0)) result <- bayestestR::hdi(m) expect_s3_class(plot(result), "gg") diff --git a/tests/testthat/test-plot.p_direction.R b/tests/testthat/test-plot.p_direction.R index 5e9eb0d74..6ffce367d 100644 --- a/tests/testthat/test-plot.p_direction.R +++ b/tests/testthat/test-plot.p_direction.R @@ -3,7 +3,7 @@ test_that("`plot.see_p_direction()` works", { skip_if_not_or_load_if_installed("ggridges") set.seed(123) - m <<- rstanarm::stan_glm(Sepal.Length ~ Petal.Width * Species, data = iris, refresh = 0) + m <<- suppressWarnings(stan_glm(Sepal.Length ~ Petal.Width * Species, data = iris, refresh = 0)) result <- bayestestR::p_direction(m) expect_s3_class(plot(result), "gg") diff --git a/tests/testthat/test-plot.p_significance.R b/tests/testthat/test-plot.p_significance.R index 08e084179..0ef49008b 100644 --- a/tests/testthat/test-plot.p_significance.R +++ b/tests/testthat/test-plot.p_significance.R @@ -3,7 +3,7 @@ test_that("`plot.see_p_significance()` works", { skip_if_not_or_load_if_installed("ggridges") set.seed(123) - m <<- stan_glm(Sepal.Length ~ Petal.Width * Species, data = iris, refresh = 0) + m <<- suppressWarnings(stan_glm(Sepal.Length ~ Petal.Width * Species, data = iris, refresh = 0)) result <- bayestestR::p_significance(m) expect_s3_class(plot(result), "gg") diff --git a/tests/testthat/test-plot.point_estimates.R b/tests/testthat/test-plot.point_estimates.R index 6a76749ac..13adf11ef 100644 --- a/tests/testthat/test-plot.point_estimates.R +++ b/tests/testthat/test-plot.point_estimates.R @@ -1,7 +1,7 @@ test_that("`plot.see_point_estimate()` works", { skip_if_not_or_load_if_installed("rstanarm") set.seed(123) - m <- stan_glm(Sepal.Length ~ Petal.Width * Species, data = iris, refresh = 0) + m <- suppressWarnings(stan_glm(Sepal.Length ~ Petal.Width * Species, data = iris, refresh = 0)) result <- bayestestR::point_estimate(m, centrality = "median") expect_s3_class(plot(result), "ggplot") diff --git a/tests/testthat/test-plot.rope.R b/tests/testthat/test-plot.rope.R index 1fbc1fac6..df1c29e60 100644 --- a/tests/testthat/test-plot.rope.R +++ b/tests/testthat/test-plot.rope.R @@ -1,7 +1,7 @@ test_that("`plot.see_rope()` works", { skip_if_not_or_load_if_installed("rstanarm") set.seed(123) - m <- rstanarm::stan_glm(Sepal.Length ~ Petal.Width * Species, data = iris, refresh = 0) + m <- suppressWarnings(stan_glm(Sepal.Length ~ Petal.Width * Species, data = iris, refresh = 0)) result <- bayestestR::rope(m) expect_s3_class(plot(result), "gg") diff --git a/tests/testthat/test-plot.si.R b/tests/testthat/test-plot.si.R index dd1f1b5e0..c9b5c96b1 100644 --- a/tests/testthat/test-plot.si.R +++ b/tests/testthat/test-plot.si.R @@ -3,7 +3,7 @@ test_that("`plot.see_si()` works", { skip_if_not_or_load_if_installed("logspline") set.seed(123) - m <- stan_glm(Sepal.Length ~ Petal.Width * Species, data = iris, refresh = 0) + m <- suppressWarnings(stan_glm(Sepal.Length ~ Petal.Width * Species, data = iris, refresh = 0)) result <- bayestestR::si(m, verbose = FALSE) expect_s3_class(plot(result), "gg") diff --git a/vignettes/bayestestR.Rmd b/vignettes/bayestestR.Rmd index d25bcd764..c92a05bc8 100644 --- a/vignettes/bayestestR.Rmd +++ b/vignettes/bayestestR.Rmd @@ -171,7 +171,7 @@ plot(result) ``` ```{r fig.width=8, fig.height=10} -result <- p_significance(model2, effects = "all", component = "all") +result <- p_significance(model2, effects = "all", component = "all", verbose = FALSE) result @@ -256,7 +256,7 @@ border. ```{r} library(logspline) # needed for `si()` -result <- si(model) +result <- si(model, verbose = FALSE) result plot(result) + @@ -289,7 +289,7 @@ plot(result, rope_color = "red") + ``` ```{r fig.width=8, fig.height=10} -result <- rope(model2, ci = c(0.9, 0.95), effects = "all", component = "all") +result <- rope(model2, ci = c(0.9, 0.95), effects = "all", component = "all", verbose = FALSE) result @@ -309,7 +309,7 @@ percentage is sufficiently low, the null hypothesis is rejected. If this percentage is sufficiently high, the null hypothesis is accepted. ```{r} -result <- equivalence_test(model) +result <- equivalence_test(model, verbose = FALSE) result