diff --git a/NAMESPACE b/NAMESPACE index d0192967..511a3cdf 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -63,14 +63,18 @@ export(add_test_asterisks) export(add_test_pvalue) export(add_title) export(add_violin) +export(adjust_caption) export(adjust_colors) -export(adjust_description) export(adjust_font) -export(adjust_legend) +export(adjust_legend_position) +export(adjust_legend_title) export(adjust_padding) export(adjust_size) +export(adjust_title) export(adjust_x_axis) +export(adjust_x_axis_title) export(adjust_y_axis) +export(adjust_y_axis_title) export(all_rows) export(as_tidyplot) export(colors_continuous_bluepinkyellow) @@ -105,9 +109,11 @@ export(last_rows) export(max_rows) export(min_rows) export(new_color_scheme) +export(remove_caption) export(remove_legend) export(remove_legend_title) export(remove_padding) +export(remove_title) export(remove_x_axis) export(remove_x_axis_labels) export(remove_x_axis_line) @@ -148,6 +154,7 @@ importFrom(lifecycle,deprecated) importFrom(rlang,":=") importFrom(rlang,.data) importFrom(stats,density) +importFrom(stats,median) importFrom(stats,sd) importFrom(stats,setNames) importFrom(utils,tail) diff --git a/R/aaa.R b/R/aaa.R index b734879c..48a452b9 100644 --- a/R/aaa.R +++ b/R/aaa.R @@ -1,5 +1,5 @@ #' @importFrom grDevices col2rgb rgb dev.off pdf -#' @importFrom stats density sd setNames +#' @importFrom stats density sd setNames median #' @importFrom utils tail #' @importFrom rlang := .data NULL diff --git a/R/add-general.R b/R/add-general.R index aa6eb697..38e6be46 100644 --- a/R/add-general.R +++ b/R/add-general.R @@ -12,7 +12,7 @@ #' @param preserve Should dodging preserve the `"total"` width of all elements at #' a position, or the width of a `"single"` element? #' @param rasterize If `FALSE` (the default) the layer will be constructed of -#' vector shapes. If `TRUE` the layer will be rastered to a pixel image. This can +#' vector shapes. If `TRUE` the layer will be rasterized to a pixel image. This can #' be useful when plotting many individual objects (1,000 or more) compromises #' the performance of the generated PDF file. #' @param rasterize_dpi The resolution in dots per inch (dpi) used for rastering @@ -45,6 +45,7 @@ #' @param saturation A `number` between `0` and `1` for the color saturation of an object. A value of `0` is completely desaturated (white), `1` is the original color. #' @param group Variable in the dataset to be used for grouping. #' @param reverse Whether the order should be reversed or not. Defaults to `FALSE`, meaning not reversed. +#' @param .reverse Whether the order should be reversed or not. Defaults to `FALSE`, meaning not reversed. #' @param scale_cut Scale cut function to be applied. See `scales::cut_short_scale()` and friends. #' @param fontsize Font size in points. Defaults to `7`. #' @param replace_na Whether to replace `count = NA` with `count = 0`. @@ -61,7 +62,7 @@ NULL ## Error bar function factory ff_errorbar <- function(.fun.data) { function(plot, dodge_width = NULL, width = 0.4, linewidth = 0.25, preserve = "total", ...) { - check_tidyplot(plot) + plot <- check_tidyplot(plot) dodge_width <- dodge_width %||% plot$tidyplot$dodge_width position <- ggplot2::position_dodge(width = dodge_width, preserve = preserve) plot + ggplot2::stat_summary(fun.data = .fun.data, geom = "errorbar", @@ -130,7 +131,7 @@ add_ci95_errorbar <- ff_errorbar(.fun.data = mean_cl_boot) ## Ribbon function factory ff_ribbon <- function(.fun.data) { function(plot, dodge_width = NULL, alpha = 0.4, color = NA, ...) { - check_tidyplot(plot) + plot <- check_tidyplot(plot) mapping <- ggplot2::aes() mapping$group <- plot$mapping$colour dodge_width <- dodge_width %||% plot$tidyplot$dodge_width @@ -195,7 +196,7 @@ add_ci95_ribbon <- ff_ribbon(.fun.data = ggplot2::mean_cl_boot) ## Bar function factory ff_bar <- function(.fun, .count = FALSE) { function(plot, dodge_width = NULL, width = 0.6, saturation = 1, preserve = "total", ...) { - check_tidyplot(plot) + plot <- check_tidyplot(plot) dodge_width <- dodge_width %||% plot$tidyplot$dodge_width position <- ggplot2::position_dodge(width = dodge_width, preserve = preserve) if (saturation != 1) { @@ -221,7 +222,7 @@ ff_bar <- function(.fun, .count = FALSE) { ## Dash function factory ff_dash <- function(.fun, .count = FALSE) { function(plot, dodge_width = NULL, width = 0.6, linewidth = 0.25, preserve = "total", ...) { - check_tidyplot(plot) + plot <- check_tidyplot(plot) dodge_width <- dodge_width %||% plot$tidyplot$dodge_width position <- ggplot2::position_dodge(width = dodge_width, preserve = preserve) if (.count) { @@ -237,7 +238,7 @@ ff_dash <- function(.fun, .count = FALSE) { ## Dot function factory ff_dot <- function(.fun, .count = FALSE) { function(plot, dodge_width = NULL, size = 2, preserve = "total", ...) { - check_tidyplot(plot) + plot <- check_tidyplot(plot) dodge_width <- dodge_width %||% plot$tidyplot$dodge_width position <- ggplot2::position_dodge(width = dodge_width, preserve = preserve) if (.count) { @@ -251,7 +252,7 @@ ff_dot <- function(.fun, .count = FALSE) { ff_value <- function(.fun, .count = FALSE) { function(plot, dodge_width = NULL, accuracy = 0.1, scale_cut = NULL, fontsize = 7, extra_padding = 0.15, vjust = NULL, hjust = NULL, preserve = "total", ...) { - check_tidyplot(plot) + plot <- check_tidyplot(plot) ptype <- get_plottype(plot) if ((stringr::str_sub(ptype, 2, 2) == "c" || .count)) { @@ -290,7 +291,7 @@ ff_value <- function(.fun, .count = FALSE) { ## Line function factory ff_line <- function(.fun, .count = FALSE, .geom) { function(plot, group, dodge_width = NULL, linewidth = 0.25, preserve = "total", ...) { - check_tidyplot(plot) + plot <- check_tidyplot(plot) if(.geom == "area") linewidth = NA mapping <- NULL if (is_missing(plot, "group")) { diff --git a/R/add-heatmap.R b/R/add-heatmap.R index e5493a61..af25b114 100644 --- a/R/add-heatmap.R +++ b/R/add-heatmap.R @@ -4,7 +4,7 @@ #' @inherit common_arguments #' #' @details -#' * `add_heatmap()` supports rasterizing. See examples and [Advanced plotting](https://jbengler.github.io/tidyplots/articles/Advanced-plotting.html#rasterizing). +#' * `add_heatmap()` supports rasterization. See examples and [Advanced plotting](https://jbengler.github.io/tidyplots/articles/Advanced-plotting.html#rasterization). #' #' @examples #' climate %>% @@ -29,7 +29,7 @@ #' @export add_heatmap <- function(plot, scale = c("none", "row", "column"), rotate_labels = 90, rasterize = FALSE, rasterize_dpi = 300, ...) { - check_tidyplot(plot) + plot <- check_tidyplot(plot) mapping <- NULL scale <- match.arg(scale) diff --git a/R/add-misc.R b/R/add-misc.R index 342ba8d2..118df11d 100644 --- a/R/add-misc.R +++ b/R/add-misc.R @@ -35,7 +35,7 @@ add_boxplot <- function(plot, dodge_width = NULL, saturation = 0.3, show_whiskers = TRUE, show_outliers = TRUE, box_width = 0.6, whiskers_width = 0.8, outlier.size = 0.5, coef = 1.5, outlier.shape = 19, linewidth = 0.25, preserve = "total", ...) { - check_tidyplot(plot) + plot <- check_tidyplot(plot) dodge_width <- dodge_width %||% plot$tidyplot$dodge_width position <- ggplot2::position_dodge(width = dodge_width, preserve = preserve) if (saturation != 1) { @@ -83,7 +83,7 @@ add_boxplot <- function(plot, dodge_width = NULL, saturation = 0.3, show_whisker #' @export add_violin <- function(plot, dodge_width = NULL, saturation = 0.3, draw_quantiles = NULL, trim = FALSE, linewidth = 0.25, scale = "width", ...) { - check_tidyplot(plot) + plot <- check_tidyplot(plot) dodge_width <- dodge_width %||% plot$tidyplot$dodge_width position <- ggplot2::position_dodge(width = dodge_width) plot <- plot %>% adjust_colors(saturation = saturation) @@ -114,7 +114,7 @@ add_violin <- function(plot, dodge_width = NULL, saturation = 0.3, draw_quantile #' #' @export add_line <- function(plot, group, dodge_width = NULL, linewidth = 0.25, preserve = "total", ...) { - check_tidyplot(plot) + plot <- check_tidyplot(plot) mapping <- NULL if (is_missing(plot, "group")) { mapping <- ggplot2::aes() @@ -130,7 +130,7 @@ add_line <- function(plot, group, dodge_width = NULL, linewidth = 0.25, preserve #' @rdname add_line #' @export add_area <- function(plot, group, dodge_width = NULL, linewidth = 0.25, alpha = 0.4, preserve = "total", ...) { - check_tidyplot(plot) + plot <- check_tidyplot(plot) ptype <- get_plottype(plot) # detect orientation @@ -192,7 +192,7 @@ add_area <- function(plot, group, dodge_width = NULL, linewidth = 0.25, alpha = #' @export add_curve_fit <- function(plot, dodge_width = NULL, method = "loess", linewidth = 0.25, alpha = 0.4, preserve = "total", ...) { - check_tidyplot(plot) + plot <- check_tidyplot(plot) mapping <- ggplot2::aes() mapping$group <- plot$mapping$colour dodge_width <- dodge_width %||% plot$tidyplot$dodge_width @@ -219,7 +219,7 @@ add_curve_fit <- function(plot, dodge_width = NULL, method = "loess", linewidth #' #' @export add_histogram <- function(plot, binwidth = NULL, bins = NULL, ...) { - check_tidyplot(plot) + plot <- check_tidyplot(plot) plot %>% remove_padding(force_continuous = TRUE) + ggplot2::geom_histogram(binwidth = binwidth, bins = bins, ...) @@ -227,7 +227,7 @@ add_histogram <- function(plot, binwidth = NULL, bins = NULL, ...) { #' @rdname add_histogram #' @export add_density_histogram <- function(plot, binwidth = NULL, bins = NULL, ...) { - check_tidyplot(plot) + plot <- check_tidyplot(plot) plot %>% remove_padding(force_continuous = TRUE) + ggplot2::geom_histogram(ggplot2::aes(y = ggplot2::after_stat(density)), @@ -236,7 +236,7 @@ add_density_histogram <- function(plot, binwidth = NULL, bins = NULL, ...) { #' @rdname add_histogram #' @export add_density_curve <- function(plot, bw = "nrd0", adjust = 1, kernel = "gaussian", n = 512, alpha = 0.4, color = "#D55E00",...) { - check_tidyplot(plot) + plot <- check_tidyplot(plot) plot %>% remove_padding(force_continuous = TRUE) + ggplot2::geom_density(bw = bw, adjust = adjust, kernel = kernel, n = n, color = color, fill = color, alpha = alpha, ...) @@ -271,7 +271,7 @@ add_density_curve <- function(plot, bw = "nrd0", adjust = 1, kernel = "gaussian" #' #' @export add_title <- function(plot, title = ggplot2::waiver()) { - check_tidyplot(plot) + plot <- check_tidyplot(plot) # parse title if (!is_waiver(title)) title <- tidyplot_parser(as.character(title)) plot + ggplot2::labs(title = title) @@ -279,7 +279,7 @@ add_title <- function(plot, title = ggplot2::waiver()) { #' @rdname add_title #' @export add_caption <- function(plot, caption = ggplot2::waiver()) { - check_tidyplot(plot) + plot <- check_tidyplot(plot) # parse caption if (!is_waiver(caption)) caption <- tidyplot_parser(as.character(caption)) plot + ggplot2::labs(caption = caption) @@ -306,7 +306,7 @@ add_caption <- function(plot, caption = ggplot2::waiver()) { #' #' @export add_reference_lines <- function(plot, x = NULL, y = NULL, linetype = "dashed", linewidth = 0.25, ...) { - check_tidyplot(plot) + plot <- check_tidyplot(plot) out <- plot if(!is.null(x)) { out <- out + ggplot2::geom_vline(xintercept = x, linetype = linetype, linewidth = linewidth, ...) @@ -377,7 +377,7 @@ add_reference_lines <- function(plot, x = NULL, y = NULL, linetype = "dashed", l add_data_labels <- function(plot, label, data = all_rows(), fontsize = 7, background = FALSE, background_color = "#FFFFFF", background_alpha = 0.6, label_position = c("below", "above", "left", "right", "center"), ...) { - check_tidyplot(plot) + plot <- check_tidyplot(plot) size <- fontsize/ggplot2::.pt if (!background) background_alpha <- 0 label.padding <- ggplot2::unit(0.1, "lines") @@ -414,7 +414,7 @@ add_data_labels <- function(plot, label, data = all_rows(), fontsize = 7, add_data_labels_repel <- function(plot, label, data = all_rows(), fontsize = 7, segment.size = 0.2, box.padding = 0.2, max.overlaps = Inf, background = FALSE, background_color = "#FFFFFF", background_alpha = 0.6, ...) { - check_tidyplot(plot) + plot <- check_tidyplot(plot) size <- fontsize/ggplot2::.pt if (!background) background_alpha <- 0 label.padding <- ggplot2::unit(0.1, "lines") diff --git a/R/add-points.R b/R/add-points.R index 1972ed9c..9ef377bf 100644 --- a/R/add-points.R +++ b/R/add-points.R @@ -14,7 +14,7 @@ #' * `add_data_points_beeswarm()` is based on `ggbeeswarm::geom_beeswarm()`. #' Check there for additional arguments. #' -#' * `add_data_points()` and friends support rasterizing. See examples and [Advanced plotting](https://jbengler.github.io/tidyplots/articles/Advanced-plotting.html#rasterizing). +#' * `add_data_points()` and friends support rasterization. See examples and [Advanced plotting](https://jbengler.github.io/tidyplots/articles/Advanced-plotting.html#rasterization). #' #' * `add_data_points()` and friends support data subsetting. See examples and [Advanced plotting](https://jbengler.github.io/tidyplots/articles/Advanced-plotting.html#data-subsetting). #' @@ -44,7 +44,7 @@ #' tidyplot(x = weight, y = size) %>% #' add_data_points(alpha = 0.4) #' -#' # Rasterizing +#' # Rasterization #' animals %>% #' tidyplot(x = weight, y = size) %>% #' add_data_points(rasterize = TRUE, rasterize_dpi = 50) @@ -61,7 +61,7 @@ add_data_points <- function(plot, data = all_rows(), dodge_width = NULL, preserve = "total", rasterize = FALSE, rasterize_dpi = 300, ...) { - check_tidyplot(plot) + plot <- check_tidyplot(plot) f_points(plot = plot, data = data, shape = shape, size = size, white_border = white_border, dodge_width = dodge_width, @@ -75,7 +75,7 @@ add_data_points_jitter <- function(plot, data = all_rows(), dodge_width = NULL, jitter_width = 0.2, jitter_height = 0, preserve = "total", rasterize = FALSE, rasterize_dpi = 300, ...) { - check_tidyplot(plot) + plot <- check_tidyplot(plot) f_points(plot = plot, data = data, shape = shape, size = size, white_border = white_border, dodge_width = dodge_width, @@ -90,7 +90,7 @@ add_data_points_beeswarm <- function(plot, data = all_rows(), dodge_width = NULL, preserve = "total", rasterize = FALSE, rasterize_dpi = 300, ...) { - check_tidyplot(plot) + plot <- check_tidyplot(plot) f_points(beeswarm = TRUE, plot = plot, data = data, shape = shape, size = size, white_border = white_border, diff --git a/R/add-proportional.R b/R/add-proportional.R index 33432c1f..6d6e2210 100644 --- a/R/add-proportional.R +++ b/R/add-proportional.R @@ -1,7 +1,7 @@ ## Pie function factory ff_pie <- function(.type = "pie") { function(plot, width = 1, reverse = FALSE, ...) { - check_tidyplot(plot) + plot <- check_tidyplot(plot) plot <- plot %>% remove_padding() %>% @@ -64,7 +64,7 @@ add_donut <- ff_pie(.type = "donut") ## Barstack function factory ff_barstack <- function(.position_fun) { function(plot, width = 0.8, reverse = FALSE, ...) { - check_tidyplot(plot) + plot <- check_tidyplot(plot) ptype <- get_plottype(plot) if (is_missing(plot, "colour")) cli::cli_abort("Argument {.arg color} missing without default") @@ -159,7 +159,7 @@ add_barstack_relative <- ff_barstack(.position_fun = ggplot2::position_fill) ## Areastack function factory ff_areastack <- function(.position_fun) { function(plot, linewidth = 0.25, alpha = 0.4, reverse = FALSE, replace_na = FALSE, ...) { - check_tidyplot(plot) + plot <- check_tidyplot(plot) ptype <- get_plottype(plot) # overwrite group aesthetic diff --git a/R/add-stats.R b/R/add-stats.R index 75e2183f..94957310 100644 --- a/R/add-stats.R +++ b/R/add-stats.R @@ -1,4 +1,4 @@ -#' Add statistics +#' Add statistical test #' @param padding_top Extra padding above the data points to accommodate the statistical comparisons. #' @param hide_info Whether to hide details about the statistical testing as caption. Defaults to `FALSE`. #' @param ... Arguments passed on to `ggpubr::geom_pwc()`. @@ -79,7 +79,7 @@ add_test_pvalue <- function(plot, ), hide_info = FALSE, ...) { - check_tidyplot(plot) + plot <- check_tidyplot(plot) # cli::cli_alert_success("add_test: {.pkg method} = {method}, {.pkg label} = {label}, {.pkg p.adjust.method} = {p.adjust.method}, {.pkg hide.ns} = {hide.ns}") plot <- plot %>% @@ -125,7 +125,7 @@ add_test_asterisks <- function(plot, ), hide_info = FALSE, ...) { - check_tidyplot(plot) + plot <- check_tidyplot(plot) add_test_pvalue(plot, padding_top = padding_top, method = method, diff --git a/R/adjust.R b/R/adjust.R index 60b40ce9..aa70703d 100644 --- a/R/adjust.R +++ b/R/adjust.R @@ -4,7 +4,7 @@ ff_adjust_axis <- function(axis) { labels = ggplot2::waiver(), limits = NULL, padding = c(NA, NA), rotate_labels = FALSE, transform = "identity", cut_short_scale = FALSE, force_continuous = FALSE, ...) { - check_tidyplot(plot) + plot <- check_tidyplot(plot) # Parse title if (!is_waiver(title)) title <- tidyplot_parser(as.character(title)) @@ -222,7 +222,7 @@ adjust_y_axis <- ff_adjust_axis("y") #' #' @export adjust_size <- function(plot, width = 50, height = 50, unit = "mm") { - check_tidyplot(plot) + plot <- check_tidyplot(plot) # cli::cli_alert_success("adjust_size: {.arg width} = {width} {unit}, {.arg height} = {height} {unit}") if (!is.na(width)) width <- ggplot2::unit(width, unit) if (!is.na(height)) height <- ggplot2::unit(height, unit) @@ -268,7 +268,7 @@ adjust_size <- function(plot, width = 50, height = 50, unit = "mm") { #' #' @export adjust_font <- function(plot, fontsize = 7, family = NULL, face = NULL, color = "black") { - check_tidyplot(plot) + plot <- check_tidyplot(plot) plot + ggplot2::theme( plot.title = ggplot2::element_text(size = fontsize, family = family, face = face, colour = color, hjust = 0.5, vjust = 0.5), @@ -291,7 +291,7 @@ adjust_font <- function(plot, fontsize = 7, family = NULL, face = NULL, color = #' @inherit common_arguments #' #' @details -#' * The `title` argument of `adjust_legend()` supports [plotmath expressions](https://www.rdocumentation.org/packages/grDevices/versions/3.6.2/topics/plotmath) to include special characters. +#' * The `title` argument of `adjust_legend_title()` supports [plotmath expressions](https://www.rdocumentation.org/packages/grDevices/versions/3.6.2/topics/plotmath) to include special characters. #' See examples and [Advanced plotting](https://jbengler.github.io/tidyplots/articles/Advanced-plotting.html#special-characters). #' #' @examples @@ -308,7 +308,7 @@ adjust_font <- function(plot, fontsize = 7, family = NULL, face = NULL, color = #' add_data_points_beeswarm() %>% #' add_mean_bar(alpha = 0.4) %>% #' add_sem_errorbar() %>% -#' adjust_legend(title = "My new legend title") +#' adjust_legend_title("My new legend title") #' #' # New title with plotmath expression #' study %>% @@ -316,7 +316,7 @@ adjust_font <- function(plot, fontsize = 7, family = NULL, face = NULL, color = #' add_data_points_beeswarm() %>% #' add_mean_bar(alpha = 0.4) %>% #' add_sem_errorbar() %>% -#' adjust_legend(title = "$E==m*c^{2}$") +#' adjust_legend_title("$E==m*c^{2}$") #' #' # Alternative legend positions #' study %>% @@ -324,21 +324,21 @@ adjust_font <- function(plot, fontsize = 7, family = NULL, face = NULL, color = #' add_data_points_beeswarm() %>% #' add_mean_bar(alpha = 0.4) %>% #' add_sem_errorbar() %>% -#' adjust_legend(position = "left") +#' adjust_legend_position("left") #' #' study %>% #' tidyplot(x = treatment, y = score, color = treatment) %>% #' add_data_points_beeswarm() %>% #' add_mean_bar(alpha = 0.4) %>% #' add_sem_errorbar() %>% -#' adjust_legend(position = "top") +#' adjust_legend_position("top") #' #' study %>% #' tidyplot(x = treatment, y = score, color = treatment) %>% #' add_data_points_beeswarm() %>% #' add_mean_bar(alpha = 0.4) %>% #' add_sem_errorbar() %>% -#' adjust_legend(position = "bottom") +#' adjust_legend_position("bottom") #' #' # `position = "none"` hides the legend #' study %>% @@ -346,11 +346,20 @@ adjust_font <- function(plot, fontsize = 7, family = NULL, face = NULL, color = #' add_data_points_beeswarm() %>% #' add_mean_bar(alpha = 0.4) %>% #' add_sem_errorbar() %>% -#' adjust_legend(position = "none") +#' adjust_legend_position("none") #' #' @export +adjust_legend_title <- function(plot, title = ggplot2::waiver()) { + plot %>% adjust_legend(title = title) +} +#' @rdname adjust_legend_title +#' @export +adjust_legend_position <- function(plot, position = "right") { + plot %>% adjust_legend(position = position) +} + adjust_legend <- function(plot, title = ggplot2::waiver(), position = "right") { - check_tidyplot(plot) + plot <- check_tidyplot(plot) # parse title if (!is_waiver(title)) title <- tidyplot_parser(as.character(title)) plot + @@ -402,7 +411,7 @@ adjust_legend <- function(plot, title = ggplot2::waiver(), position = "right") { #' #' @export adjust_padding <- function(plot, top = NA, right = NA, bottom = NA, left = NA, all = NA, force_continuous = FALSE, ...) { - check_tidyplot(plot) + plot <- check_tidyplot(plot) if (!is.na(all) && is.numeric(all)) { top <- right <- bottom <- left <- all } @@ -412,17 +421,15 @@ adjust_padding <- function(plot, top = NA, right = NA, bottom = NA, left = NA, a } -#' Adjust description -#' @param title Plot title. -#' @param x_axis_title X axis title. -#' @param y_axis_title Y axis title. -#' @param legend_title Legend title. -#' @param caption Plot caption text. -#' @param ... Arguments passed on to `ggplot2::labs()`. +#' Adjust titles and caption +#' @param title Plot or axes title. +#' @param caption Plot caption. #' @inherit common_arguments #' #' @details -#' * `adjust_description()` supports [plotmath expressions](https://www.rdocumentation.org/packages/grDevices/versions/3.6.2/topics/plotmath) to include special characters. +#' Adjust the plot title, axis titles and caption +#' +#' * All functions support [plotmath expressions](https://www.rdocumentation.org/packages/grDevices/versions/3.6.2/topics/plotmath) to include special characters. #' See examples and [Advanced plotting](https://jbengler.github.io/tidyplots/articles/Advanced-plotting.html#special-characters). #' #' @examples @@ -439,12 +446,11 @@ adjust_padding <- function(plot, top = NA, right = NA, bottom = NA, left = NA, a #' add_data_points() %>% #' add_mean_bar(alpha = 0.4) %>% #' add_sem_errorbar() %>% -#' adjust_description( -#' title = "This is my fantastic plot title", -#' x_axis_title = "Treatment group", -#' y_axis_title = "Disease score", -#' legend_title = "Legend title", -#' caption = "Here goes the caption") +#' adjust_title("This is my fantastic plot title") %>% +#' adjust_x_axis_title("Treatment group") %>% +#' adjust_y_axis_title("Disease score") %>% +#' adjust_legend_title("Legend title") %>% +#' adjust_caption("Here goes the caption") #' #' # Plotmath expressions #' study %>% @@ -452,18 +458,36 @@ adjust_padding <- function(plot, top = NA, right = NA, bottom = NA, left = NA, a #' add_data_points() %>% #' add_mean_bar(alpha = 0.4) %>% #' add_sem_errorbar() %>% -#' adjust_description( -#' title = "$H[2]*O$", -#' x_axis_title = "$H[2]*O$", -#' y_axis_title = "$H[2]*O$", -#' legend_title = "$H[2]*O$", -#' caption = "$H[2]*O$") +#' adjust_title("$H[2]*O$") %>% +#' adjust_x_axis_title("$H[2]*O$") %>% +#' adjust_y_axis_title("$H[2]*O$") %>% +#' adjust_legend_title("$H[2]*O$") %>% +#' adjust_caption("$H[2]*O$") #' #' @export +adjust_title <- function(plot, title = ggplot2::waiver()) { + plot %>% adjust_description(title = title) +} +#' @rdname adjust_title +#' @export +adjust_x_axis_title <- function(plot, title = ggplot2::waiver()) { + plot %>% adjust_description(x_axis_title = title) +} +#' @rdname adjust_title +#' @export +adjust_y_axis_title <- function(plot, title = ggplot2::waiver()) { + plot %>% adjust_description(y_axis_title = title) +} +#' @rdname adjust_title +#' @export +adjust_caption <- function(plot, caption = ggplot2::waiver()) { + plot %>% adjust_description(caption = caption) +} + adjust_description <- function(plot, title = ggplot2::waiver(), x_axis_title = ggplot2::waiver(), - y_axis_title = ggplot2::waiver(), legend_title = ggplot2::waiver(), - caption = ggplot2::waiver(), ...) { - check_tidyplot(plot) + y_axis_title = ggplot2::waiver(), legend_title = ggplot2::waiver(), + caption = ggplot2::waiver(), ...) { + plot <- check_tidyplot(plot) if (!is_waiver(title)) title <- tidyplot_parser(as.character(title)) if (!is_waiver(x_axis_title)) x_axis_title <- tidyplot_parser(as.character(x_axis_title)) if (!is_waiver(y_axis_title)) y_axis_title <- tidyplot_parser(as.character(y_axis_title)) @@ -472,5 +496,5 @@ adjust_description <- function(plot, title = ggplot2::waiver(), x_axis_title = g colour <- fill <- legend_title plot + ggplot2::labs(x = x_axis_title, y = y_axis_title, colour = colour, fill = fill, - title = title, caption = caption, ...) + title = title, caption = caption, ...) } diff --git a/R/colors.R b/R/colors.R index 9811855a..924adabb 100644 --- a/R/colors.R +++ b/R/colors.R @@ -1,5 +1,6 @@ #' Adjust colors #' @param new_colors A character vector of new hex colors to use. Can be a named character vector of hex colors to assign certain data labels to specific colors. +#' @param downsample If too many colors are provided, whether to downsample `evenly`, or use the `first`, the `last` or the `middle` colors of the color vector. Defaults to `evenly`. #' @param ... Arguments passed on to the ggplot2 `scale` function. #' @inherit common_arguments #' @inheritParams ggplot2::scale_x_continuous @@ -51,8 +52,10 @@ #' @export adjust_colors <- function(plot, new_colors = NULL, saturation = 1, - labels = tidyplot_parse_labels(), ...) { - check_tidyplot(plot) + labels = tidyplot_parse_labels(), + downsample = c("evenly", "first", "last", "middle"), + ...) { + plot <- check_tidyplot(plot) out <- plot if (is_discrete(plot, "colour")) { @@ -82,7 +85,7 @@ adjust_colors <- function(plot, new_colors = NULL, # Too many colors if (n_ratio > 1) { # cli::cli_alert_info("adjust_colors: Too many colors. {n_provided} colors provided, but only {n_requested} needed.") - new_colors <- downsample_vector(new_colors, n_requested) + new_colors <- downsample_vector(new_colors, n_requested, downsample = downsample) } suppressMessages(out <- out + ggplot2::scale_color_manual(values = new_colors, drop = FALSE, labels = labels, ...)) diff --git a/R/helpers.R b/R/helpers.R index 379cbd6c..6728517c 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -106,7 +106,7 @@ as_tidyplot <- function(gg, width = 50, height = 50, dodge_width = 0.8) { #' #' @export flip_plot <- function(plot, ...) { - check_tidyplot(plot) + plot <- check_tidyplot(plot) plot + ggplot2::coord_flip(...) } @@ -391,15 +391,18 @@ get_plottype <- function(plot) { pt } -check_tidyplot <- function(x, arg = rlang::caller_arg(x), call = rlang::caller_env()) { - if (!inherits(x, "tidyplot")) { +check_tidyplot <- function(plot, arg = rlang::caller_arg(plot), call = rlang::caller_env()) { + if (!inherits(plot, "tidyplot")) { msg <- c("{.arg {arg}} must be a tidyplot.") - if (inherits(x, "list") || inherits(x, "patchwork")) + if (inherits(plot, "list") || inherits(plot, "patchwork")) msg <- c(msg, "i" = "After using `split_plot()`, only `save_plot()` is allowed.") else msg <- c(msg, "i" = "Use `tidyplot()` to create a tidyplot.") cli::cli_abort(msg, call = call) } + # message(parent_function(-1)) + plot$tidyplot$history <- c(plot$tidyplot$history, parent_function()) + plot } # check_tidyplot(c(22,22)) diff --git a/R/labels.R b/R/labels.R index d27f3b0d..923779d5 100644 --- a/R/labels.R +++ b/R/labels.R @@ -1,7 +1,7 @@ ff_rename_axis_labels <- function(axis) { function(plot, new_names) { - check_tidyplot(plot) + plot <- check_tidyplot(plot) scale_type <- get_scale_type(plot, axis) if (scale_type != "discrete") cli::cli_abort("Axis must be discrete not {scale_type}!") @@ -103,7 +103,7 @@ rename_color_labels <- ff_rename_axis_labels(axis = "colour") ff_reorder_axis_labels <- function(axis) { function(plot, ...) { - check_tidyplot(plot) + plot <- check_tidyplot(plot) scale_type <- get_scale_type(plot, axis) if (scale_type != "discrete") cli::cli_abort("Axis must be discrete not {scale_type}!") @@ -176,17 +176,52 @@ reorder_y_axis_labels <- ff_reorder_axis_labels(axis = "y") reorder_color_labels <- ff_reorder_axis_labels(axis = "colour") -ff_sort_axis_labels <- function(axis) { - function(plot, ...) { - check_tidyplot(plot) +ff_sort_labels <- function(axis) { + function(plot, ..., .fun = NULL, .reverse = FALSE) { + plot <- check_tidyplot(plot) scale_type <- get_scale_type(plot, axis) if (scale_type != "discrete") cli::cli_abort("Axis must be discrete not {scale_type}!") - var <- get_variable(plot, axis) - new_data <- - plot$data %>% - dplyr::arrange(...) %>% - dplyr::mutate("{var}" := forcats::fct_reorder(.data[[var]], dplyr::row_number())) + + var_a <- get_variable(plot, axis) + + if (!missing(..1)) { + # sort by variables passed into '...' + new_data <- + plot$data %>% + dplyr::arrange(...) %>% + dplyr::mutate("{var_a}" := forcats::fct_reorder(.f = .data[[var_a]], + .x = dplyr::row_number(), + .desc = .reverse)) + } else { + # sort by statistic entity (mean, median, sum, count) used in plot + if (any(stringr::str_detect(plot$tidyplot$history, "count"))) + auto_fun <- length + else if (any(stringr::str_detect(plot$tidyplot$history, "mean"))) + auto_fun <- mean + else if (any(stringr::str_detect(plot$tidyplot$history, "sum"))) + auto_fun <- sum + else + auto_fun <- median + + .fun <- .fun %||% auto_fun + + if (get_scale_type(plot, "x") == "continuous") + var_b <- get_variable(plot, "x") + else if (get_scale_type(plot, "y") == "continuous") + var_b <- get_variable(plot, "y") + else if (get_scale_type(plot, "colour") == "continuous") + var_b <- get_variable(plot, "colour") + else + var_b <- get_variable(plot, axis) + + new_data <- + plot$data %>% + dplyr::mutate("{var_a}" := forcats::fct_reorder(.f = .data[[var_a]], + .x = .data[[var_b]], + .fun = .fun, + .desc = .reverse)) + } plot %+% new_data } } @@ -206,7 +241,7 @@ ff_sort_axis_labels <- function(axis) { #' add_data_points() %>% #' add_mean_bar(alpha = 0.4) %>% #' add_sem_errorbar() %>% -#' sort_x_axis_labels(score) +#' sort_x_axis_labels() #' #' # Before adjustments #' study %>% @@ -221,7 +256,7 @@ ff_sort_axis_labels <- function(axis) { #' add_data_points() %>% #' add_mean_bar(alpha = 0.4) %>% #' add_sem_errorbar() %>% -#' sort_y_axis_labels(score) +#' sort_y_axis_labels() #' #' # Before adjustment #' study %>% @@ -236,23 +271,24 @@ ff_sort_axis_labels <- function(axis) { #' add_data_points() %>% #' add_mean_bar(alpha = 0.4) %>% #' add_sem_errorbar() %>% -#' sort_color_labels(score) +#' sort_color_labels() #' #' @inherit common_arguments -#' @param ... Arguments passed on to `forcats::fct_reorder()`. +#' @param ... Optional variables to use for sorting. +#' @param .fun Override the function used for sorting. Is automatically determined from the plot. #' @export -sort_x_axis_labels <- ff_sort_axis_labels(axis = "x") +sort_x_axis_labels <- ff_sort_labels(axis = "x") #' @rdname sort_x_axis_labels #' @export -sort_y_axis_labels <- ff_sort_axis_labels(axis = "y") +sort_y_axis_labels <- ff_sort_labels(axis = "y") #' @rdname sort_x_axis_labels #' @export -sort_color_labels <- ff_sort_axis_labels(axis = "colour") +sort_color_labels <- ff_sort_labels(axis = "colour") ff_reverse_axis_labels <- function(axis) { function(plot) { - check_tidyplot(plot) + plot <- check_tidyplot(plot) scale_type <- get_scale_type(plot, axis) if (scale_type != "discrete") cli::cli_abort("Axis must be discrete not {scale_type}!") diff --git a/R/plot.R b/R/plot.R index 29ee5173..c1b708bd 100644 --- a/R/plot.R +++ b/R/plot.R @@ -44,6 +44,8 @@ tidyplot <- function(data, ..., width = 50, height = 50, dodge_width = 0.8) { plot$tidyplot$mapping <- extract_mapping(plot) + plot$tidyplot$history <- c("tidyplot") + plot$tidyplot$padding_x <- c(0.05, 0.05) plot$tidyplot$padding_y <- c(0.05, 0.05) @@ -107,7 +109,7 @@ tidyplot <- function(data, ..., width = 50, height = 50, dodge_width = 0.8) { split_plot <- function(plot, by, ncol = NULL, nrow = NULL, byrow = NULL, widths = 30, heights = 25, guides = "collect", tag_level = NULL, design = NULL, unit = "mm") { - check_tidyplot(plot) + plot <- check_tidyplot(plot) if(missing(by)) cli::cli_abort("Argument {.arg by} missing without default.") @@ -187,7 +189,7 @@ split_plot <- function(plot, by, ncol = NULL, nrow = NULL, byrow = NULL, #' #' @export view_plot <- function(plot, data = all_rows(), title = ggplot2::waiver(), ...) { - check_tidyplot(plot) + plot <- check_tidyplot(plot) input <- plot if (inherits(data, "function")) plot <- plot %+% (plot$data %>% data()) + ggplot2::ggtitle(title) if (inherits(data, "data.frame")) plot <- plot %+% data + ggplot2::ggtitle(title) @@ -263,15 +265,6 @@ save_plot <- function(plot = ggplot2::last_plot(), filename, else dimensions <- list(width = NA, height = NA) - # width_defined_by <- dplyr::case_when(is.na(width) && is.na(dimensions[["width"]]) ~ "was not defined - system default used", - # !is.na(width) ~ "was provided as argument 'width'", - # TRUE ~ "was inferred from plot dimensions") - # height_defined_by <- dplyr::case_when(is.na(height) && is.na(dimensions[["height"]]) ~ "was not defined - system default used", - # !is.na(height) ~ "was provided as argument 'height'", - # TRUE ~ "was inferred from plot dimensions") - # cli::cli_alert_success("save_plot: {.pkg page width} {width_defined_by}") - # cli::cli_alert_success("save_plot: {.pkg page height} {height_defined_by}") - if (is.na(width)) width <- dimensions[["width"]] * 1.1 if (is.na(height)) height <- dimensions[["height"]] * 1.1 diff --git a/R/remove.R b/R/remove.R index 854bc7f4..ff29a379 100644 --- a/R/remove.R +++ b/R/remove.R @@ -21,14 +21,14 @@ #' #' @export remove_legend <- function(plot) { - check_tidyplot(plot) + plot <- check_tidyplot(plot) plot + ggplot2::theme(legend.position="none") } #' @rdname remove_legend #' @export remove_legend_title <- function(plot) { - check_tidyplot(plot) + plot <- check_tidyplot(plot) plot + ggplot2::theme(legend.title = ggplot2::element_blank()) } @@ -69,7 +69,7 @@ remove_legend_title <- function(plot) { #' #' @export remove_x_axis <- function(plot) { - check_tidyplot(plot) + plot <- check_tidyplot(plot) plot %>% remove_x_axis_line() %>% remove_x_axis_ticks() %>% @@ -80,28 +80,28 @@ remove_x_axis <- function(plot) { #' @rdname remove_x_axis #' @export remove_x_axis_line <- function(plot) { - check_tidyplot(plot) + plot <- check_tidyplot(plot) plot + ggplot2::theme(axis.line.x = ggplot2::element_blank()) } #' @rdname remove_x_axis #' @export remove_x_axis_ticks <- function(plot) { - check_tidyplot(plot) + plot <- check_tidyplot(plot) plot + ggplot2::theme(axis.ticks.x = ggplot2::element_blank()) } #' @rdname remove_x_axis #' @export remove_x_axis_labels <- function(plot) { - check_tidyplot(plot) + plot <- check_tidyplot(plot) plot + ggplot2::theme(axis.text.x = ggplot2::element_blank()) } #' @rdname remove_x_axis #' @export remove_x_axis_title <- function(plot) { - check_tidyplot(plot) + plot <- check_tidyplot(plot) plot + ggplot2::theme(axis.title.x = ggplot2::element_blank()) } @@ -143,7 +143,7 @@ remove_x_axis_title <- function(plot) { #' #' @export remove_y_axis <- function(plot) { - check_tidyplot(plot) + plot <- check_tidyplot(plot) plot %>% remove_y_axis_line() %>% remove_y_axis_ticks() %>% @@ -154,28 +154,28 @@ remove_y_axis <- function(plot) { #' @rdname remove_y_axis #' @export remove_y_axis_line <- function(plot) { - check_tidyplot(plot) + plot <- check_tidyplot(plot) plot + ggplot2::theme(axis.line.y = ggplot2::element_blank()) } #' @rdname remove_y_axis #' @export remove_y_axis_ticks <- function(plot) { - check_tidyplot(plot) + plot <- check_tidyplot(plot) plot + ggplot2::theme(axis.ticks.y = ggplot2::element_blank()) } #' @rdname remove_y_axis #' @export remove_y_axis_labels <- function(plot) { - check_tidyplot(plot) + plot <- check_tidyplot(plot) plot + ggplot2::theme(axis.text.y = ggplot2::element_blank()) } #' @rdname remove_y_axis #' @export remove_y_axis_title <- function(plot) { - check_tidyplot(plot) + plot <- check_tidyplot(plot) plot + ggplot2::theme(axis.title.y = ggplot2::element_blank()) } @@ -196,9 +196,47 @@ remove_y_axis_title <- function(plot) { #' #' @export remove_padding <- function(plot, force_continuous = FALSE) { - check_tidyplot(plot) + plot <- check_tidyplot(plot) plot %>% adjust_x_axis(padding = c(0, 0), force_continuous = force_continuous) %>% adjust_y_axis(padding = c(0, 0), force_continuous = force_continuous) } +#' Remove plot title or caption +#' @inherit common_arguments +#' +#' @examples +#' # Before removing +#' animals %>% +#' tidyplot(x = weight, y = speed, color = family) %>% +#' add_data_points() %>% +#' add_title("Name of the plot") %>% +#' add_caption("This is the caption") +#' +#' # After removing +#' animals %>% +#' tidyplot(x = weight, y = speed, color = family) %>% +#' add_data_points() %>% +#' add_title("Name of the plot") %>% +#' add_caption("This is the caption") %>% +#' remove_title() +#' +#' animals %>% +#' tidyplot(x = weight, y = speed, color = family) %>% +#' add_data_points() %>% +#' add_title("Name of the plot") %>% +#' add_caption("This is the caption") %>% +#' remove_caption() +#' +#' @export +remove_title <- function(plot) { + plot <- check_tidyplot(plot) + plot + ggplot2::theme(plot.title = ggplot2::element_blank()) +} +#' @rdname remove_title +#' @export +remove_caption <- function(plot) { + plot <- check_tidyplot(plot) + plot + ggplot2::theme(plot.caption = ggplot2::element_blank()) +} + diff --git a/R/themes.R b/R/themes.R index 13301c82..8380ef28 100644 --- a/R/themes.R +++ b/R/themes.R @@ -40,7 +40,7 @@ #' #' @export theme_tidyplot <- function(plot, fontsize = 7) { - check_tidyplot(plot) + plot <- check_tidyplot(plot) plot %>% style_just_xy() %>% adjust_font(fontsize) @@ -48,7 +48,7 @@ theme_tidyplot <- function(plot, fontsize = 7) { #' @rdname theme_tidyplot #' @export theme_ggplot2 <- function(plot, fontsize = 7) { - check_tidyplot(plot) + plot <- check_tidyplot(plot) plot <- plot + ggplot2::theme_gray() if (get_variable(plot, "colour") == ".single_color") plot <- plot %>% remove_legend() @@ -57,7 +57,7 @@ theme_ggplot2 <- function(plot, fontsize = 7) { #' @rdname theme_tidyplot #' @export theme_minimal_xy <- function(plot, fontsize = 7) { - check_tidyplot(plot) + plot <- check_tidyplot(plot) plot <- plot + ggplot2::theme_minimal() if (get_variable(plot, "colour") == ".single_color") plot <- plot %>% remove_legend() @@ -73,7 +73,7 @@ theme_minimal_xy <- function(plot, fontsize = 7) { #' @rdname theme_tidyplot #' @export theme_minimal_x <- function(plot, fontsize = 7) { - check_tidyplot(plot) + plot <- check_tidyplot(plot) plot <- plot + ggplot2::theme_minimal() if (get_variable(plot, "colour") == ".single_color") plot <- plot %>% remove_legend() @@ -89,7 +89,7 @@ theme_minimal_x <- function(plot, fontsize = 7) { #' @rdname theme_tidyplot #' @export theme_minimal_y <- function(plot, fontsize = 7) { - check_tidyplot(plot) + plot <- check_tidyplot(plot) plot <- plot + ggplot2::theme_minimal() if (get_variable(plot, "colour") == ".single_color") plot <- plot %>% remove_legend() diff --git a/R/tidycolor.R b/R/tidycolor.R index 122d98ec..f9e41741 100644 --- a/R/tidycolor.R +++ b/R/tidycolor.R @@ -211,13 +211,34 @@ colors_diverging_icefire <- new_color_scheme( # not exported -downsample_vector <- function(x, n) { +downsample_vector <- function(x, n, downsample = c("evenly", "first", "last", "middle")) { if (length(x) <= n) return(x) - by <- (length(x) / (n-1)) - (1 / (n-1)) - i <- floor(cumsum(c(1, rep(by, n-1)))) - x[i] + downsample <- match.arg(downsample) + if (downsample == "evenly") { + by <- (length(x) / (n-1)) - (1 / (n-1)) + i <- floor(cumsum(c(1, rep(by, n-1)))) + x[i] + } else if (downsample == "first") { + x[1:n] + } else if (downsample == "last") { + x[(length(x) - n + 1):length(x)] + } else { + start_index <- ceiling((length(x) - n) / 2) + 1 + end_index <- start_index + n - 1 + x[start_index:end_index] + } } +# downsample_vector(1:11, 6, downsample = "evenly") +# downsample_vector(1:11, 6, downsample = "first") +# downsample_vector(1:11, 6, downsample = "last") +# downsample_vector(1:11, 6, downsample = "middle") +# downsample_vector(1:5, 4, downsample = "evenly") +# downsample_vector(1:5, 4, downsample = "first") +# downsample_vector(1:5, 4, downsample = "last") +# downsample_vector(1:5, 4, downsample = "middle") + + generate_html <- function(x, max_colors) { name <- attr(x, "tidycolor.name") size <- length(x) diff --git a/_pkgdown.yml b/_pkgdown.yml index 459683f8..344c1359 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -53,7 +53,7 @@ reference: - starts_with("add_barstack") - starts_with("add_areastack") - starts_with("add_pie") -- subtitle: Statistical comparison +- subtitle: Statistical test - contents: - starts_with("add_test") - subtitle: Annotation @@ -72,7 +72,7 @@ reference: - starts_with("adjust_colors") - starts_with("adjust_font") - starts_with("adjust_legend") - - starts_with("adjust_description") + - starts_with("adjust_title") - starts_with("adjust_size") - starts_with("adjust_padding") - starts_with("adjust_x_axis") diff --git a/data-raw/old_stuff.R b/data-raw/old_stuff.R deleted file mode 100644 index 849526ee..00000000 --- a/data-raw/old_stuff.R +++ /dev/null @@ -1,33 +0,0 @@ - - -print_color <- function(hex, show_hex_code = TRUE) { - bg_style <- cli::make_ansi_style(hex, bg = TRUE) - text_color <- dplyr::if_else(as(colorspace::hex2RGB(hex), "HLS")@coords[,2] > 0.6, "#000000", "#FFFFFF") - text_style <- cli::make_ansi_style(text_color) - if (show_hex_code) - cat(bg_style(text_style(paste0('"',hex,'"')))) - else - cat(bg_style(text_style(paste0(' ')))) -} - -preview_colors_in_console <- function(x, max_colors = 64) { - if (length(x) > max_colors) { - cat(paste0(length(x), " colors downsampled to ",max_colors," colors:\n")) - x <- downsample_vector(x, max_colors) - } - - n_per_line <- floor(cli::console_width() / 3) - for (i in 1:length(x)) { - print_color(x[i], show_hex_code = FALSE) - if (i %% n_per_line == 0 && i != length(x)) cat("\n") - } - n_per_line <- floor(cli::console_width() / (nchar(x[[1]]) + 3)) - cat("\n\nc(") - for (i in 1:length(x)) { - print_color(x[i]) - if (i != length(x)) cat(",") - if (i %% n_per_line == 0 && i != length(x)) cat("\n") - } - cat(")\n\nDisclaimer: Color preview in the console is not accurate.\nUse `view()` for accurate color preview.") - cat("\n") -} diff --git a/data-raw/study.R b/data-raw/study.R index 4b1f6a63..6f0b7067 100644 --- a/data-raw/study.R +++ b/data-raw/study.R @@ -11,38 +11,4 @@ study <- sex = rep(c("female", "male", "female", "male", "female"), 4), score = c(2,4,5,4,6,9,8,12,15,16,32,35,24,45,56,23,25,21,22,23)) -study %>% - tidyplot(treatment, score, color = treatment) %>% - add_mean_bar(alpha = 0.4) %>% - add_sem_errorbar() %>% - add_data_points_beeswarm() - -study %>% - tidyplot(treatment, score) %>% - add_mean_bar(alpha = 0.4) %>% - add_sem_errorbar() %>% - add_data_points() %>% - add_line() - -study %>% - tidyplot(treatment, score) %>% - add_mean_bar(alpha = 0.4) %>% - add_sem_errorbar() %>% - add_data_points() %>% - add_line(group = participant) - -study %>% - tidyplot(dose, score, color = group) %>% - add_mean_bar(alpha = 0.4) %>% - add_sem_errorbar() %>% - add_data_points_beeswarm() - -study %>% - tidyplot(treatment, score, color = group) %>% - add_mean_bar(alpha = 0.4) %>% - add_sem_errorbar() %>% - add_data_points() %>% - add_line(group = participant) %>% - adjust_data_labels(treatment, sort_by = dose) - usethis::use_data(study, overwrite = TRUE) diff --git a/data-raw/testing.R b/data-raw/testing.R deleted file mode 100644 index 1ea40cd1..00000000 --- a/data-raw/testing.R +++ /dev/null @@ -1,425 +0,0 @@ - -library(tidyverse) - - -study %>% - tidyplot(group, score, color = dose) %>% - add_data_points() %>% - adjust_y_axis(transform = "log10") - -# orientation -# orientation is only determined when the plot is rendered - -p1 <- - study %>% - tidyplot(group, score, color = dose) %>% - add_mean_bar() - -p2 <- - study %>% - tidyplot(score, group, color = dose) %>% - add_mean_bar() - -p3 <- - study %>% - tidyplot(group, score, color = dose) %>% - add_mean_bar(orientation = "y") - -is_flipped(p1) -is_flipped(p2) -is_flipped(p3) - -study %>% - tidyplot(group, score, color = dose) %>% - add_mean_bar() - -study %>% - tidyplot(score, group, color = dose) %>% - add_mean_bar() - -study %>% - tidyplot(group, score, color = dose) %>% - add_mean_bar(orientation = "y") - -# investigate saturation -# alpha only works on fill for box, bar and violin! -# is "saturation" really needed? - -study %>% - ggplot(aes(treatment, score, color = treatment, fill = treatment)) + - geom_boxplot(alpha = 0.2) - -study %>% - ggplot(aes(treatment, score, color = treatment, fill = treatment)) + - geom_col(alpha = 0.2) - -study %>% - ggplot(aes(treatment, score, color = treatment, fill = treatment)) + - geom_violin(alpha = 0.2) - - -# saturation overwrites fill_scale with pale colors. -# coord_grid is not visible through geoms - -study %>% - tidyplot(treatment, score, color = treatment) %>% - add_mean_bar(alpha = 0.4) %>% - theme_ggplot2() - -study %>% - tidyplot(treatment, score, color = treatment) %>% - add(geom_col(alpha = 0.4, color = NA, width = 0.6)) %>% - theme_ggplot2() - -study %>% - tidyplot(treatment, score, color = treatment) %>% - add(geom_col(alpha = 0.4, color = NA, width = 0.6)) %>% - add_sem_errorbar() %>% - add_data_points(jitter_width = 0.2) - -study %>% - tidyplot(treatment, score, color = treatment) %>% - add_mean_bar(alpha = 0.2) %>% - add_sem_errorbar() %>% - add_data_points(jitter_width = 0.2) - -mapping <- ggplot2::aes(color = dose, fill = ggplot2::after_scale(apply_saturation(colour, saturation))) - - -# conclusion: keep saturation - -## -# try to use after_scale to get lighter bars -# not possible for bars with color = NA - -library(tidyverse) -# this works -mpg %>% - mutate(cyl = factor(cyl)) %>% - tidyplot(cty, displ, colour = cyl) %>% - add(geom_col(aes(fill = after_scale(apply_saturation(colour, 0.3))))) - -# BUT: -# self reference of fill to fill -> grey fill -mpg %>% - mutate(cyl = factor(cyl)) %>% - tidyplot(cty, displ, colour = cyl) %>% - add(geom_col(aes(fill = after_scale(apply_saturation(fill, 0.3))))) - -# fixed color overrides colour, which now can not be used in after_scale() any more -mpg %>% - mutate(cyl = factor(cyl)) %>% - tidyplot(cty, displ, colour = cyl) %>% - add(geom_col(aes(fill = after_scale(apply_saturation(colour, 0.3))), color = "#FF00FF")) - -# NA color kills colour, which now can not be used in after_scale() any more -mpg %>% - mutate(cyl = factor(cyl)) %>% - tidyplot(cty, displ, colour = cyl) %>% - add(geom_col(aes(fill = after_scale(apply_saturation(colour, 0.3))), color = NA)) - - -# testing lines - -study %>% - tidyplot(group, score, color = dose) %>% - add_line() %>% - add_data_points() - -# order in data set defines how geom_line connects points -study %>% - dplyr::arrange(score) %>% - tidyplot(group, score, color = dose) %>% - add_line() %>% - add_data_points() - -study %>% - tidyplot(group, score, color = dose, dodge_width = 0, group = dose) %>% - add_area() %>% - add_data_points() - -study %>% - tidyplot(group, score, color = dose, group = participant) %>% - add_area() %>% - add_data_points() - -study %>% - tidyplot(group, score, color = dose, group = participant, dodge_width = 0) %>% - add_area() %>% - add_data_points() - - -study %>% - dplyr::arrange(score) %>% - tidyplot(score, group, color = dose) %>% - add_line() %>% - add_data_points() - -study %>% - tidyplot(score, group, color = dose, dodge_width = 0, group = dose) %>% - add_area() %>% - add_data_points() - -study %>% - tidyplot(score, group, color = dose, group = participant) %>% - add_area() %>% - add_data_points() - -study %>% - tidyplot(score, group, color = dose, group = participant, dodge_width = 0) %>% - add_area() %>% - add_data_points() - - - -study %>% - tidyplot(group, score, color = dose) %>% - add_areastack_absolute(alpha = 0.1) - -animals %>% - tidyplot(number_of_legs) %>% - add_count_area() - -# stat_count and stat_sum are ignoring categories with no data -# this is fixed - -vars <- c("number_of_legs", "family") - -df <- - animals %>% - dplyr::summarize(count = dplyr::n(), .by = all_of(vars)) %>% - tidyr::complete(.data[[vars[1]]], .data[[vars[2]]], fill = list(count = 0)) - -animals %>% - tidyplot(number_of_legs, color = family) %>% - add_areastack_absolute() - -df %>% - tidyplot(count, number_of_legs, color = family) %>% - add_areastack_absolute() - -animals %>% - tidyplot(number_of_legs, color = family) %>% - add_areastack_relative() - - -# function calls as aesthetics: - -gg <- - study %>% - ggplot(aes(treatment, cumsum(score))) + - geom_point() - -gg$data -gg$mapping - -# meta programming - -# https://trinkerrstuff.wordpress.com/2014/08/19/hijacking-r-functions-changing-default-arguments-3/ -# https://coolbutuseless.github.io/2018/04/11/changing-the-default-arguments-to-a-function/ - -# ff with if condition - -ff <- function(fun, alert = FALSE) { - function(x = c(0.5, 5, 10), y = NULL, z = NA) { - if(alert) message("alert = TRUE") - fun(x) - } -} - -f_mean_silent <- ff(fun = mean, alert = FALSE) -f_mean_loud <- ff(fun = mean, alert = TRUE) -f_mean_silent() -f_mean_silent(c(5,200)) -f_mean_loud() -f_mean_loud(c(5,200)) - -# function factories -# mean, median, sum, count(=length?), (min, max) - -ff <- function(fun) { - function(x = c(0.5, 5, 10), y = NULL, z = NA) { - fun(x) - } -} - -f_mean <- ff(mean) -f_mean() -f_mean(c(5,200)) - -# alternative -# easier to document in roxygen -# fun is exposed for hijacking by the user - -gf <- function(x = c(0.5, 5, 10), y = NULL, z = NA, fun = NULL) { - fun(x) -} - -f_mean2 <- function(x = c(0.5, 5, 10), y = NULL, z = NA, fun = mean) { - gf(x = x, y = y, z = z, fun = fun) -} - -f_mean2() -f_mean2(c(5,200)) - -# add_pie_labels() -# add_barstack_absolute_labels() - -spendings %>% - tidyplot(y = amount, color = category) %>% - add_pie() %>% - add(geom_text(aes(x = 3, label = amount), color = "black", position = "stack")) - -spendings %>% - tidyplot(y = amount, color = category) %>% - add_barstack_absolute() %>% - add(geom_text(aes(x = 1.5, label = amount), color = "black", position = "stack")) - - -# position_dodge2(width = dodge_width, preserve = "single") -# all bars have the same width -# BUT: -# dodge_width is ignored -# interpretation of bar width is different between dodge and dodge2 -# violins a crippled - -# for the sake of consistency I will stick with position_dodge() as default - -p <- - study %>% - dplyr::filter(!treatment == "A") %>% - tidyplot(dose, score, color = group) - -p %>% add_boxplot() %>% add_data_points() -p %>% add_violin() %>% add_data_points() # preserve = "single" destroys violins, therefore not implemented here -p %>% add_sem_errorbar() %>% add_data_points() -p %>% add_mean_dash() %>% add_data_points() -p %>% add_mean_bar() %>% add_data_points() - -p <- study %>% - dplyr::filter(!treatment == "A") %>% - tidyplot(dose, score, color = group) - -p %>% add(geom_boxplot(position = position_dodge(width = 0.2))) -p %>% add(geom_boxplot(position = position_dodge2(width = 0.2, preserve = "single"))) - -p %>% add(geom_violin(scale = "width", position = position_dodge(width = 0.2))) -p %>% add(geom_violin(scale = "width", position = position_dodge(width = 0.2, preserve = "single"))) - -p %>% add(geom_col(position = position_dodge(width = 0.2))) -p %>% add(geom_col(position = position_dodge2(width = 0.2, preserve = "single"))) - -p %>% add(stat_summary(fun = mean, width = 0.8, geom = "bar", color = NA, position = position_dodge(width = 0.2))) -p %>% add(stat_summary(fun = mean, width = 0.8, geom = "bar", color = NA, position = position_dodge2(width = 0.2, preserve = "single"))) -p %>% add(stat_summary(fun = mean, width = 0.8, geom = "bar", color = NA, position = position_dodge(width = 0.9))) - -# grouped data -# with facets - -library(tidyverse) -study %>% - ggplot(aes(x = group, y = score, group = participant, color = dose)) + - geom_point() + - geom_line() + - facet_wrap(facets = vars(dose)) - -# testing heatmaps - -library(tidyverse) - -gene_expression %>% - dplyr::mutate(row_zscore = (expression - mean(expression)) / sd(expression), .by = external_gene_name) %>% - tidyplot(x = sample, y = external_gene_name, color = row_zscore) %>% - add_heatmap() %>% - adjust_x_axis(rotate_labels = 90) %>% - adjust_data_labels(external_gene_name, sort_by = -dplyr::desc(direction)) %>% - adjust_data_labels(direction, sort_by = dplyr::desc(direction)) %>% - adjust_colors(c("blue", "white", "red")) %>% - adjust_size(height = 90) - -h1 <- - gene_expression %>% - dplyr::mutate(row_zscore = (expression - mean(expression)) / sd(expression), .by = external_gene_name) %>% - dplyr::mutate(replicate = stringr::str_sub(sample, -1)) %>% - tidyplot(x = replicate, y = external_gene_name, color = row_zscore) %>% - add_heatmap() %>% - adjust_x_axis(rotate_labels = 90) %>% - adjust_data_labels(external_gene_name, sort_by = -dplyr::desc(direction)) %>% - adjust_data_labels(direction, sort_by = dplyr::desc(direction)) %>% - adjust_colors(c("blue", "white", "red")) %>% - adjust_size(height = 90) - -h1 -h1 + ggplot2::facet_grid(cols = dplyr::vars(group), rows = dplyr::vars(direction), scales = "free_y") -h1 + ggplot2::facet_grid(cols = dplyr::vars(sample_type, condition), rows = dplyr::vars(direction), scales = "free_y") - -h2 <- h1 + - ggplot2::facet_grid(cols = dplyr::vars(condition), rows = dplyr::vars(direction), scales = "free_y") -h2 %>% split_plot(sample_type, heights = 90) - -h3 <- h1 %>% - adjust_colors(c("blue", "white", "red"), limits = c(-3, 3)) + - ggplot2::facet_grid(cols = dplyr::vars(condition), rows = dplyr::vars(direction), scales = "free_y") -h3 %>% split_plot(sample_type, heights = 90) - -# handling of incoming orientation argument - - -custom_stat_summary <- function(mapping = NULL, data = NULL, - geom = "bar", fun = sum, ...) { - - args <- list(...) - if (!"orientation" %in% names(args)) args$orientation <- NA - - do.call(ggplot2::stat_summary, c(list(mapping = mapping, data = data, geom = geom, - fun = fun), args)) -} - -custom_stat_summary2 <- function(mapping = NULL, data = NULL, - geom = "bar", fun = sum, ...) { - args <- list(...) - if (!"orientation" %in% names(args)) args$orientation <- NA - - rlang::inject(ggplot2::stat_summary(mapping = mapping, data = data, geom = geom, - fun = fun, !!!args)) -} - -library(ggplot2) - -data <- data.frame( - category = c("A", "B", "C", "A", "B", "C"), - value = c(10, 20, 30, 40, 50, 60) -) - -ggplot(data, aes(x = category, y = value)) + - custom_stat_summary(orientation = "y") - -ggplot(data, aes(x = category, y = value)) + - custom_stat_summary2(orientation = "y") - -### - -gene_expression %>% - tidyplot(x = sample_type, y = expression, color = condition) %>% - add_mean_dash() %>% - add_sem_errorbar() %>% - add_data_points() %>% - add_test_asterisks(hide_info = TRUE) %>% - split_plot(by = external_gene_name, ncol = 3, nrow = 3) %>% - save_plot("multipage2.pdf") - -gene_expression %>% - tidyplot(x = sample_type, y = expression, color = condition) %>% - add_mean_dash() %>% - add_sem_errorbar() %>% - add_data_points() %>% - add_test_asterisks() %>% - split_plot(by = external_gene_name, ncol = 3, nrow = 3) %>% - save_plot("multipage3.pdf", units = "cm") - -gene_expression %>% - tidyplot(x = sample_type, y = expression, color = condition) %>% - add_mean_dash() %>% - add_sem_errorbar() %>% - split_plot(by = external_gene_name, ncol = 3, nrow = 3) %>% - save_plot("multipage4.pdf", units = "in") diff --git a/man/add_data_points.Rd b/man/add_data_points.Rd index ceedfee4..1796e434 100644 --- a/man/add_data_points.Rd +++ b/man/add_data_points.Rd @@ -76,7 +76,7 @@ values range between \code{1} and \code{3}.} a position, or the width of a \code{"single"} element?} \item{rasterize}{If \code{FALSE} (the default) the layer will be constructed of -vector shapes. If \code{TRUE} the layer will be rastered to a pixel image. This can +vector shapes. If \code{TRUE} the layer will be rasterized to a pixel image. This can be useful when plotting many individual objects (1,000 or more) compromises the performance of the generated PDF file.} @@ -111,7 +111,7 @@ Add data points \itemize{ \item \code{add_data_points_beeswarm()} is based on \code{ggbeeswarm::geom_beeswarm()}. Check there for additional arguments. -\item \code{add_data_points()} and friends support rasterizing. See examples and \href{https://jbengler.github.io/tidyplots/articles/Advanced-plotting.html#rasterizing}{Advanced plotting}. +\item \code{add_data_points()} and friends support rasterization. See examples and \href{https://jbengler.github.io/tidyplots/articles/Advanced-plotting.html#rasterization}{Advanced plotting}. \item \code{add_data_points()} and friends support data subsetting. See examples and \href{https://jbengler.github.io/tidyplots/articles/Advanced-plotting.html#data-subsetting}{Advanced plotting}. } } @@ -141,7 +141,7 @@ animals \%>\% tidyplot(x = weight, y = size) \%>\% add_data_points(alpha = 0.4) -# Rasterizing +# Rasterization animals \%>\% tidyplot(x = weight, y = size) \%>\% add_data_points(rasterize = TRUE, rasterize_dpi = 50) diff --git a/man/add_heatmap.Rd b/man/add_heatmap.Rd index a4c5dfac..09d68759 100644 --- a/man/add_heatmap.Rd +++ b/man/add_heatmap.Rd @@ -21,7 +21,7 @@ add_heatmap( \item{rotate_labels}{Degree to rotate the x axis labels. Defaults to \code{90}.} \item{rasterize}{If \code{FALSE} (the default) the layer will be constructed of -vector shapes. If \code{TRUE} the layer will be rastered to a pixel image. This can +vector shapes. If \code{TRUE} the layer will be rasterized to a pixel image. This can be useful when plotting many individual objects (1,000 or more) compromises the performance of the generated PDF file.} @@ -38,7 +38,7 @@ Add heatmap } \details{ \itemize{ -\item \code{add_heatmap()} supports rasterizing. See examples and \href{https://jbengler.github.io/tidyplots/articles/Advanced-plotting.html#rasterizing}{Advanced plotting}. +\item \code{add_heatmap()} supports rasterization. See examples and \href{https://jbengler.github.io/tidyplots/articles/Advanced-plotting.html#rasterization}{Advanced plotting}. } } \examples{ diff --git a/man/add_test_pvalue.Rd b/man/add_test_pvalue.Rd index 384e9359..c57cb221 100644 --- a/man/add_test_pvalue.Rd +++ b/man/add_test_pvalue.Rd @@ -3,7 +3,7 @@ \name{add_test_pvalue} \alias{add_test_pvalue} \alias{add_test_asterisks} -\title{Add statistics} +\title{Add statistical test} \usage{ add_test_pvalue( plot, @@ -130,7 +130,7 @@ independently. P-values are adjusted by panel when \code{p.adjust.by = A \code{tidyplot} object } \description{ -Add statistics +Add statistical test } \details{ \itemize{ diff --git a/man/adjust_colors.Rd b/man/adjust_colors.Rd index 0ed71c9a..b309d437 100644 --- a/man/adjust_colors.Rd +++ b/man/adjust_colors.Rd @@ -9,6 +9,7 @@ adjust_colors( new_colors = NULL, saturation = 1, labels = tidyplot_parse_labels(), + downsample = c("evenly", "first", "last", "middle"), ... ) } @@ -31,6 +32,8 @@ as output. Also accepts rlang \link[rlang:as_function]{lambda} function notation. }} +\item{downsample}{If too many colors are provided, whether to downsample \code{evenly}, or use the \code{first}, the \code{last} or the \code{middle} colors of the color vector. Defaults to \code{evenly}.} + \item{...}{Arguments passed on to the ggplot2 \code{scale} function.} } \value{ diff --git a/man/adjust_description.Rd b/man/adjust_description.Rd deleted file mode 100644 index 96b668a3..00000000 --- a/man/adjust_description.Rd +++ /dev/null @@ -1,78 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/adjust.R -\name{adjust_description} -\alias{adjust_description} -\title{Adjust description} -\usage{ -adjust_description( - plot, - title = ggplot2::waiver(), - x_axis_title = ggplot2::waiver(), - y_axis_title = ggplot2::waiver(), - legend_title = ggplot2::waiver(), - caption = ggplot2::waiver(), - ... -) -} -\arguments{ -\item{plot}{A \code{tidyplot} generated with the function \code{tidyplot()}.} - -\item{title}{Plot title.} - -\item{x_axis_title}{X axis title.} - -\item{y_axis_title}{Y axis title.} - -\item{legend_title}{Legend title.} - -\item{caption}{Plot caption text.} - -\item{...}{Arguments passed on to \code{ggplot2::labs()}.} -} -\value{ -A \code{tidyplot} object -} -\description{ -Adjust description -} -\details{ -\itemize{ -\item \code{adjust_description()} supports \href{https://www.rdocumentation.org/packages/grDevices/versions/3.6.2/topics/plotmath}{plotmath expressions} to include special characters. -See examples and \href{https://jbengler.github.io/tidyplots/articles/Advanced-plotting.html#special-characters}{Advanced plotting}. -} -} -\examples{ -# Plot without adjustments -study \%>\% - tidyplot(x = treatment, y = score, color = treatment) \%>\% - add_data_points() \%>\% - add_mean_bar(alpha = 0.4) \%>\% - add_sem_errorbar() - -# Adjust description -study \%>\% - tidyplot(x = treatment, y = score, color = treatment) \%>\% - add_data_points() \%>\% - add_mean_bar(alpha = 0.4) \%>\% - add_sem_errorbar() \%>\% - adjust_description( - title = "This is my fantastic plot title", - x_axis_title = "Treatment group", - y_axis_title = "Disease score", - legend_title = "Legend title", - caption = "Here goes the caption") - -# Plotmath expressions -study \%>\% - tidyplot(x = treatment, y = score, color = treatment) \%>\% - add_data_points() \%>\% - add_mean_bar(alpha = 0.4) \%>\% - add_sem_errorbar() \%>\% - adjust_description( - title = "$H[2]*O$", - x_axis_title = "$H[2]*O$", - y_axis_title = "$H[2]*O$", - legend_title = "$H[2]*O$", - caption = "$H[2]*O$") - -} diff --git a/man/adjust_legend.Rd b/man/adjust_legend_title.Rd similarity index 75% rename from man/adjust_legend.Rd rename to man/adjust_legend_title.Rd index 832b97fd..e23c1c46 100644 --- a/man/adjust_legend.Rd +++ b/man/adjust_legend_title.Rd @@ -1,10 +1,13 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/adjust.R -\name{adjust_legend} -\alias{adjust_legend} +\name{adjust_legend_title} +\alias{adjust_legend_title} +\alias{adjust_legend_position} \title{Adjust legend} \usage{ -adjust_legend(plot, title = ggplot2::waiver(), position = "right") +adjust_legend_title(plot, title = ggplot2::waiver()) + +adjust_legend_position(plot, position = "right") } \arguments{ \item{plot}{A \code{tidyplot} generated with the function \code{tidyplot()}.} @@ -22,7 +25,7 @@ Adjust legend } \details{ \itemize{ -\item The \code{title} argument of \code{adjust_legend()} supports \href{https://www.rdocumentation.org/packages/grDevices/versions/3.6.2/topics/plotmath}{plotmath expressions} to include special characters. +\item The \code{title} argument of \code{adjust_legend_title()} supports \href{https://www.rdocumentation.org/packages/grDevices/versions/3.6.2/topics/plotmath}{plotmath expressions} to include special characters. See examples and \href{https://jbengler.github.io/tidyplots/articles/Advanced-plotting.html#special-characters}{Advanced plotting}. } } @@ -40,7 +43,7 @@ study \%>\% add_data_points_beeswarm() \%>\% add_mean_bar(alpha = 0.4) \%>\% add_sem_errorbar() \%>\% - adjust_legend(title = "My new legend title") + adjust_legend_title("My new legend title") # New title with plotmath expression study \%>\% @@ -48,7 +51,7 @@ study \%>\% add_data_points_beeswarm() \%>\% add_mean_bar(alpha = 0.4) \%>\% add_sem_errorbar() \%>\% - adjust_legend(title = "$E==m*c^{2}$") + adjust_legend_title("$E==m*c^{2}$") # Alternative legend positions study \%>\% @@ -56,21 +59,21 @@ study \%>\% add_data_points_beeswarm() \%>\% add_mean_bar(alpha = 0.4) \%>\% add_sem_errorbar() \%>\% - adjust_legend(position = "left") + adjust_legend_position("left") study \%>\% tidyplot(x = treatment, y = score, color = treatment) \%>\% add_data_points_beeswarm() \%>\% add_mean_bar(alpha = 0.4) \%>\% add_sem_errorbar() \%>\% - adjust_legend(position = "top") + adjust_legend_position("top") study \%>\% tidyplot(x = treatment, y = score, color = treatment) \%>\% add_data_points_beeswarm() \%>\% add_mean_bar(alpha = 0.4) \%>\% add_sem_errorbar() \%>\% - adjust_legend(position = "bottom") + adjust_legend_position("bottom") # `position = "none"` hides the legend study \%>\% @@ -78,6 +81,6 @@ study \%>\% add_data_points_beeswarm() \%>\% add_mean_bar(alpha = 0.4) \%>\% add_sem_errorbar() \%>\% - adjust_legend(position = "none") + adjust_legend_position("none") } diff --git a/man/adjust_title.Rd b/man/adjust_title.Rd new file mode 100644 index 00000000..307447f8 --- /dev/null +++ b/man/adjust_title.Rd @@ -0,0 +1,70 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/adjust.R +\name{adjust_title} +\alias{adjust_title} +\alias{adjust_x_axis_title} +\alias{adjust_y_axis_title} +\alias{adjust_caption} +\title{Adjust titles and caption} +\usage{ +adjust_title(plot, title = ggplot2::waiver()) + +adjust_x_axis_title(plot, title = ggplot2::waiver()) + +adjust_y_axis_title(plot, title = ggplot2::waiver()) + +adjust_caption(plot, caption = ggplot2::waiver()) +} +\arguments{ +\item{plot}{A \code{tidyplot} generated with the function \code{tidyplot()}.} + +\item{title}{Plot or axes title.} + +\item{caption}{Plot caption.} +} +\value{ +A \code{tidyplot} object +} +\description{ +Adjust titles and caption +} +\details{ +Adjust the plot title, axis titles and caption +\itemize{ +\item All functions support \href{https://www.rdocumentation.org/packages/grDevices/versions/3.6.2/topics/plotmath}{plotmath expressions} to include special characters. +See examples and \href{https://jbengler.github.io/tidyplots/articles/Advanced-plotting.html#special-characters}{Advanced plotting}. +} +} +\examples{ +# Plot without adjustments +study \%>\% + tidyplot(x = treatment, y = score, color = treatment) \%>\% + add_data_points() \%>\% + add_mean_bar(alpha = 0.4) \%>\% + add_sem_errorbar() + +# Adjust description +study \%>\% + tidyplot(x = treatment, y = score, color = treatment) \%>\% + add_data_points() \%>\% + add_mean_bar(alpha = 0.4) \%>\% + add_sem_errorbar() \%>\% + adjust_title("This is my fantastic plot title") \%>\% + adjust_x_axis_title("Treatment group") \%>\% + adjust_y_axis_title("Disease score") \%>\% + adjust_legend_title("Legend title") \%>\% + adjust_caption("Here goes the caption") + +# Plotmath expressions +study \%>\% + tidyplot(x = treatment, y = score, color = treatment) \%>\% + add_data_points() \%>\% + add_mean_bar(alpha = 0.4) \%>\% + add_sem_errorbar() \%>\% + adjust_title("$H[2]*O$") \%>\% + adjust_x_axis_title("$H[2]*O$") \%>\% + adjust_y_axis_title("$H[2]*O$") \%>\% + adjust_legend_title("$H[2]*O$") \%>\% + adjust_caption("$H[2]*O$") + +} diff --git a/man/common_arguments.Rd b/man/common_arguments.Rd index 811622f6..e7bec2a1 100644 --- a/man/common_arguments.Rd +++ b/man/common_arguments.Rd @@ -19,7 +19,7 @@ a position, or the width of a \code{"single"} element?} \item{rasterize}{If \code{FALSE} (the default) the layer will be constructed of -vector shapes. If \code{TRUE} the layer will be rastered to a pixel image. This can +vector shapes. If \code{TRUE} the layer will be rasterized to a pixel image. This can be useful when plotting many individual objects (1,000 or more) compromises the performance of the generated PDF file.} @@ -50,6 +50,8 @@ values range between \code{1} and \code{3}.} \item{reverse}{Whether the order should be reversed or not. Defaults to \code{FALSE}, meaning not reversed.} +\item{.reverse}{Whether the order should be reversed or not. Defaults to \code{FALSE}, meaning not reversed.} + \item{scale_cut}{Scale cut function to be applied. See \code{scales::cut_short_scale()} and friends.} \item{fontsize}{Font size in points. Defaults to \code{7}.} diff --git a/man/remove_title.Rd b/man/remove_title.Rd new file mode 100644 index 00000000..1798c2e3 --- /dev/null +++ b/man/remove_title.Rd @@ -0,0 +1,44 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/remove.R +\name{remove_title} +\alias{remove_title} +\alias{remove_caption} +\title{Remove plot title or caption} +\usage{ +remove_title(plot) + +remove_caption(plot) +} +\arguments{ +\item{plot}{A \code{tidyplot} generated with the function \code{tidyplot()}.} +} +\value{ +A \code{tidyplot} object +} +\description{ +Remove plot title or caption +} +\examples{ +# Before removing +animals \%>\% + tidyplot(x = weight, y = speed, color = family) \%>\% + add_data_points() \%>\% + add_title("Name of the plot") \%>\% + add_caption("This is the caption") + +# After removing +animals \%>\% + tidyplot(x = weight, y = speed, color = family) \%>\% + add_data_points() \%>\% + add_title("Name of the plot") \%>\% + add_caption("This is the caption") \%>\% + remove_title() + +animals \%>\% + tidyplot(x = weight, y = speed, color = family) \%>\% + add_data_points() \%>\% + add_title("Name of the plot") \%>\% + add_caption("This is the caption") \%>\% + remove_caption() + +} diff --git a/man/sort_x_axis_labels.Rd b/man/sort_x_axis_labels.Rd index 598ce9ff..f51938c5 100644 --- a/man/sort_x_axis_labels.Rd +++ b/man/sort_x_axis_labels.Rd @@ -6,16 +6,20 @@ \alias{sort_color_labels} \title{Sort axis or color labels} \usage{ -sort_x_axis_labels(plot, ...) +sort_x_axis_labels(plot, ..., .fun = NULL, .reverse = FALSE) -sort_y_axis_labels(plot, ...) +sort_y_axis_labels(plot, ..., .fun = NULL, .reverse = FALSE) -sort_color_labels(plot, ...) +sort_color_labels(plot, ..., .fun = NULL, .reverse = FALSE) } \arguments{ \item{plot}{A \code{tidyplot} generated with the function \code{tidyplot()}.} -\item{...}{Arguments passed on to \code{forcats::fct_reorder()}.} +\item{...}{Optional variables to use for sorting.} + +\item{.fun}{Override the function used for sorting. Is automatically determined from the plot.} + +\item{.reverse}{Whether the order should be reversed or not. Defaults to \code{FALSE}, meaning not reversed.} } \value{ A \code{tidyplot} object @@ -37,7 +41,7 @@ study \%>\% add_data_points() \%>\% add_mean_bar(alpha = 0.4) \%>\% add_sem_errorbar() \%>\% - sort_x_axis_labels(score) + sort_x_axis_labels() # Before adjustments study \%>\% @@ -52,7 +56,7 @@ study \%>\% add_data_points() \%>\% add_mean_bar(alpha = 0.4) \%>\% add_sem_errorbar() \%>\% - sort_y_axis_labels(score) + sort_y_axis_labels() # Before adjustment study \%>\% @@ -67,6 +71,6 @@ study \%>\% add_data_points() \%>\% add_mean_bar(alpha = 0.4) \%>\% add_sem_errorbar() \%>\% - sort_color_labels(score) + sort_color_labels() } diff --git a/tests/testthat/_snaps/labels/combined-color.svg b/tests/testthat/_snaps/labels/combined-color.svg index 1cfeb756..302c3cff 100644 --- a/tests/testthat/_snaps/labels/combined-color.svg +++ b/tests/testthat/_snaps/labels/combined-color.svg @@ -50,26 +50,26 @@ - + - + - + + + - - diff --git a/tests/testthat/_snaps/labels/combined-x.svg b/tests/testthat/_snaps/labels/combined-x.svg index 891bd0ac..e0e5b208 100644 --- a/tests/testthat/_snaps/labels/combined-x.svg +++ b/tests/testthat/_snaps/labels/combined-x.svg @@ -50,25 +50,25 @@ - + + + - - - + - + diff --git a/tests/testthat/_snaps/labels/combined-y.svg b/tests/testthat/_snaps/labels/combined-y.svg index 071d5dc0..13f478f0 100644 --- a/tests/testthat/_snaps/labels/combined-y.svg +++ b/tests/testthat/_snaps/labels/combined-y.svg @@ -50,25 +50,25 @@ - + + + - - - + - + diff --git a/tests/testthat/_snaps/labels/sort-color-1.svg b/tests/testthat/_snaps/labels/sort-color-1.svg index 49f17aad..65c2a864 100644 --- a/tests/testthat/_snaps/labels/sort-color-1.svg +++ b/tests/testthat/_snaps/labels/sort-color-1.svg @@ -52,22 +52,22 @@ - + - + + + - - - + diff --git a/tests/testthat/_snaps/labels/sort-x-1.svg b/tests/testthat/_snaps/labels/sort-x-1.svg index a0a38326..7a21e065 100644 --- a/tests/testthat/_snaps/labels/sort-x-1.svg +++ b/tests/testthat/_snaps/labels/sort-x-1.svg @@ -52,22 +52,22 @@ - + - + + + - - - + diff --git a/tests/testthat/_snaps/labels/sort-y-1.svg b/tests/testthat/_snaps/labels/sort-y-1.svg index 88cf6c49..99f133e1 100644 --- a/tests/testthat/_snaps/labels/sort-y-1.svg +++ b/tests/testthat/_snaps/labels/sort-y-1.svg @@ -52,22 +52,22 @@ - + - + + + - - - + diff --git a/tests/testthat/test-adjust.R b/tests/testthat/test-adjust.R index 392f542f..edfec47c 100644 --- a/tests/testthat/test-adjust.R +++ b/tests/testthat/test-adjust.R @@ -71,9 +71,10 @@ test_that("adjust legend works", { add_sem_errorbar() %>% add_data_points_beeswarm() - p %>% adjust_legend(title = "My legend title") %>% + p %>% adjust_legend_title("My legend title") %>% vdiffr::expect_doppelganger("adjust legend title", .) - p %>% adjust_legend(title = "My legend title", position = "top") %>% + p %>% adjust_legend_title("My legend title") %>% + adjust_legend_position("top") %>% vdiffr::expect_doppelganger("adjust legend title and position", .) }) @@ -89,11 +90,11 @@ test_that("plotmath expressions work", { vdiffr::expect_doppelganger("plotmath expression title", .) p %>% add_caption(caption = "$E==m*c^{2}~H[2]*O$") %>% vdiffr::expect_doppelganger("plotmath expression caption", .) - p %>% adjust_legend(title = "$E==m*c^{2}~H[2]*O$") %>% + p %>% adjust_legend_title("$E==m*c^{2}~H[2]*O$") %>% vdiffr::expect_doppelganger("plotmath expression legend title", .) - p %>% adjust_x_axis(title = "$Domino~E==m*c^{2}$") %>% + p %>% adjust_x_axis_title("$Domino~E==m*c^{2}$") %>% vdiffr::expect_doppelganger("plotmath expression x axis title", .) - p %>% adjust_y_axis(title = "$Domino~E==m*c^{2}$") %>% + p %>% adjust_y_axis_title("$Domino~E==m*c^{2}$") %>% vdiffr::expect_doppelganger("plotmath expression y axis title", .) new_labels <- diff --git a/tests/testthat/test-labels.R b/tests/testthat/test-labels.R index 9f7b1e32..0905b0ca 100644 --- a/tests/testthat/test-labels.R +++ b/tests/testthat/test-labels.R @@ -14,13 +14,13 @@ test_that("x labels work", { study %>% tidyplot(treatment, score, color = treatment) %>% add_data_points_beeswarm() %>% - sort_x_axis_labels(score) %>% + sort_x_axis_labels() %>% vdiffr::expect_doppelganger("sort x 1", .) animals %>% tidyplot(family, size, color = family) %>% add_mean_bar() %>% - sort_x_axis_labels(size) %>% + sort_x_axis_labels() %>% vdiffr::expect_doppelganger("sort x 2", .) animals %>% @@ -33,7 +33,7 @@ test_that("x labels work", { tidyplot(treatment, score, color = treatment) %>% add_data_points_beeswarm() %>% reorder_x_axis_labels("D") %>% - sort_x_axis_labels(score) %>% + sort_x_axis_labels() %>% reverse_x_axis_labels() %>% rename_x_axis_labels(c("A" = "Hallo")) %>% vdiffr::expect_doppelganger("combined x", .) @@ -55,13 +55,13 @@ test_that("y labels work", { study %>% tidyplot(score, treatment, color = treatment) %>% add_data_points_beeswarm() %>% - sort_y_axis_labels(score) %>% + sort_y_axis_labels() %>% vdiffr::expect_doppelganger("sort y 1", .) animals %>% tidyplot(size, family, color = family) %>% add_mean_bar() %>% - sort_y_axis_labels(size) %>% + sort_y_axis_labels() %>% vdiffr::expect_doppelganger("sort y 2", .) animals %>% @@ -74,7 +74,7 @@ test_that("y labels work", { tidyplot(score, treatment, color = treatment) %>% add_data_points_beeswarm() %>% reorder_y_axis_labels("D") %>% - sort_y_axis_labels(score) %>% + sort_y_axis_labels() %>% reverse_y_axis_labels() %>% rename_y_axis_labels(c("A" = "Hallo")) %>% vdiffr::expect_doppelganger("combined y", .) @@ -96,13 +96,13 @@ test_that("color labels work", { study %>% tidyplot(group, score, color = treatment) %>% add_data_points_beeswarm() %>% - sort_color_labels(score) %>% + sort_color_labels() %>% vdiffr::expect_doppelganger("sort color 1", .) animals %>% tidyplot(family, size, color = family) %>% add_mean_bar() %>% - sort_color_labels(size) %>% + sort_color_labels() %>% vdiffr::expect_doppelganger("sort color 2", .) animals %>% @@ -115,7 +115,7 @@ test_that("color labels work", { tidyplot(group, score, color = treatment) %>% add_data_points_beeswarm() %>% reorder_color_labels("D") %>% - sort_color_labels(score) %>% + sort_color_labels() %>% reverse_color_labels() %>% rename_color_labels(c("A" = "Hallo")) %>% vdiffr::expect_doppelganger("combined color", .) diff --git a/vignettes/articles/Advanced-plotting.Rmd b/vignettes/articles/Advanced-plotting.Rmd index 80ebb4c9..5acb9e0f 100644 --- a/vignettes/articles/Advanced-plotting.Rmd +++ b/vignettes/articles/Advanced-plotting.Rmd @@ -17,16 +17,16 @@ knitr::opts_chunk$set( ``` ::: {.lead} -In this article, we will explore advanced plotting techniques offered in tidyplots. We will cover the rasterizing of plot components, data subsetting for highlighting selected data points, and the construction of powerful plotting pipelines. Moreover, we will discuss the visualization of paired and missing data, generate multiplot layouts and introduce the concepts of plot orientation, dodging, coloring, plot area padding, and more. We will conclude by discussing the compatibility of tidyplots with ggplot2. +In this article, we will explore advanced plotting techniques offered in tidyplots. We will cover the rasterization of plot components, data subsetting for highlighting selected data points, and the construction of powerful plotting pipelines. Moreover, we will discuss the visualization of paired and missing data, generate multiplot layouts and introduce the concepts of plot orientation, dodging, coloring, plot area padding, and more. We will conclude by discussing the compatibility of tidyplots with ggplot2. ::: -# Rasterizing +# Rasterization Generally, vector graphics like PDF and SVG are superior to raster images like PNG and JPG because they maintain high quality and sharpness at any scale. This makes them ideal for printing, resizing, and zooming without losing detail. -However, in plots with many data points, such as busy scatter plots or heatmaps, the presence of too many vector shapes can slow down performance without providing extra information. In these cases, rasterizing individual layers of the plot can be beneficial, as it reduces file size and rendering time, making the graphs more manageable and quicker to load or display. +However, in plots with many data points, such as busy scatter plots or heatmaps, the presence of too many vector shapes can slow down performance without providing extra information. In these cases, rasterization of individual layers of the plot can be beneficial, as it reduces file size and rendering time, making the graphs more manageable and quicker to load or display. -Ideally, the rasterizing only affects the problematic layers of the plot, while the rest of the plot still uses vector shapes. In tidyplots this can be achieved with the arguments `rasterize = TRUE` and `rasterize_dpi` which are available in `add_heatmap()` and `add_data_points()` functions. +Ideally, the rasterization only affects the problematic layers of the plot, while the rest of the plot still uses vector shapes. In tidyplots this can be achieved with the arguments `rasterize = TRUE` and `rasterize_dpi` which are available in `add_heatmap()` and `add_data_points()` functions. In the examples below I intentionally chose a low resolution of of 30 to 50 dpi, to make the rastering more obvious. A typical resolution for print would be 300 dpi. @@ -175,7 +175,7 @@ study %>% add_sem_errorbar() %>% add_data_points() %>% add_line(group = participant, color = "grey") %>% - sort_x_axis_labels(dose) + sort_x_axis_labels() ``` # Missing data @@ -462,10 +462,9 @@ study %>% add_data_points() %>% add_mean_bar(alpha = 0.4) %>% add_sem_errorbar() %>% - adjust_description(title = "$H[2]*O$", - x_axis_title = "$E==m*c^{2}$", - y_axis_title = "$TNF*alpha~level$", - legend_title = "") + adjust_title("$H[2]*O$") %>% + adjust_x_axis_title("$E==m*c^{2}$") %>% + adjust_y_axis_title("$TNF*alpha~level$") ``` # ggplot2 compatibiliy diff --git a/vignettes/tidyplots.Rmd b/vignettes/tidyplots.Rmd index 5c2d781b..76031190 100644 --- a/vignettes/tidyplots.Rmd +++ b/vignettes/tidyplots.Rmd @@ -182,7 +182,7 @@ study %>% adjust_size(width = 20, height = 20) ``` -Another common adjustment is to change the titles of the plot, axes, or legend. For this we will use the function `adjust_description()`. +Another common adjustment is to change the titles of the plot, axes, or legend. For this we will use the function `adjust_title()` and friends. ```{r} study %>% @@ -190,13 +190,14 @@ study %>% add_data_points() %>% add_mean_bar(alpha = 0.4) %>% add_sem_errorbar() %>% - adjust_description(title = "This is my fantastic plot", - x_axis_title = "Treatment group", - y_axis_title = "Disease score", - legend_title = "") + adjust_title("This is my fantastic plot title") %>% + adjust_x_axis_title("Treatment group") %>% + adjust_y_axis_title("Disease score") %>% + adjust_legend_title("") %>% + adjust_caption("Here goes the caption") ``` -Note that I removed the legend title by setting it to an empty string `legend_title = ""`. This is alternative to `remove_legend_title()`, however the result is not exactly the same. I am sure you will figure out the difference. +Note that I removed the legend title by setting it to an empty string `adjust_legend_title("")`. This is alternative to `remove_legend_title()`, however the result is not exactly the same. I am sure you will figure out the difference. Another common task is to adjust the colors in your plot. You can do this using the `adjust_colors()` function. @@ -261,7 +262,7 @@ study %>% add_data_points() %>% add_mean_bar(alpha = 0.4) %>% add_sem_errorbar() %>% - sort_x_axis_labels(score) + sort_x_axis_labels() ``` Or simply reverse the order of the labels.