Skip to content

Allow users to input their own colour schemes, fixes for problems with >9 groups. #189

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
quantixed wants to merge 5 commits into
base: master
Choose a base branch
from
Open

Allow users to input their own colour schemes, fixes for problems with >9 groups. #189

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
5 commits
Select commit Hold shift + click to select a range
11b1d15
Modify dabestr print to make greeting/ending optional and fix formatting
quantixed Jan 29, 2026
07ad2d8
Feat: adds the ability to use custom colours with dabestr
quantixed Jan 30, 2026
2c355d9
Fix: colouring for groups of 10 or more
quantixed Jan 31, 2026
802e65b
Fix: ggplot2 colours and circumventing the ggplot2 warning about "No …
quantixed Feb 1, 2026
13a1e74
Docs: add Roxygen comments to 999_plot_palettes.R
quantixed Feb 1, 2026
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion DESCRIPTION
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -74,4 +74,4 @@ Config/testthat/edition: 3
Encoding: UTF-8
LazyData: true
Roxygen: list(markdown = TRUE)
RoxygenNote: 7.2.3
RoxygenNote: 7.3.3
25 changes: 16 additions & 9 deletions R/001_api.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -301,6 +301,7 @@ load <- function(
#' @noRd
#'
#' @param x a dabest object, set as x to tally with method signature for print functions
#' @param print_greet_end a boolean value for printing with greeting/ending.
#' @param ... S3 signature for generic plot function.
#'
#' @return A summary of the experimental designs.
Expand All @@ -319,29 +320,35 @@ load <- function(
#' print(dabest_obj)
#'
#' @export
print.dabest <- function(x, ...) {
print.dabest <- function(x, print_greet_end = TRUE, ...) {

dabest_obj <- x

check_dabest_object(dabest_obj)

print_greeting_header()
cat("\n")
if (print_greet_end) {
print_greeting_header()
}
else cat("\n")

paired <- dabest_obj$paired
ci <- dabest_obj$ci

# Use a lookup table for rm_status and paired_status
rm_status_lookup <- c(NULL = "", "sequential" = "for the sequential design of repeated-measures experiment \\n", "baseline" = "for repeated measures against baseline \\n")
paired_status_lookup <- c(NULL = "E", "sequential" = "Paired e", "baseline" = "Paired e")
rm_status_lookup <- c(NULL = "", "sequential" = "for the sequential design of repeated-measures experiment \n", "baseline" = "for repeated measures against baseline \n")
paired_status_lookup <- c(NULL = "Unpaired ", "sequential" = "Paired ", "baseline" = "Paired ")

rm_status <- rm_status_lookup[paired]
paired_status <- paired_status_lookup[paired]
rm_status <- rm_status_lookup[[format(paired)]]
paired_status <- paired_status_lookup[[format(paired)]]

# Create strings
line1 <- paste0(paired_status, "ffect size(s) ", rm_status)
line1 <- paste0(paired_status, "effect size(s) ", rm_status)
line2 <- paste0("with ", ci, "% confidence intervals will be computed for:")
cat(line1)
cat(line2)
cat("\n")
print_each_comparism(dabest_obj)
print_ending(dabest_obj)
if (print_greet_end) {
print_ending(dabest_obj)
}
}
13 changes: 9 additions & 4 deletions R/001_effsize_func.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -307,6 +307,7 @@ cohens_h <- function(dabest_obj, perm_count = 5000) {
#' @noRd
#'
#' @param x a dabest_effectsize_obj object, set as x to tally with method signature for print functions
#' @param print_greet_end a boolean value for printing greeting/ending.
#' @param ... S3 signature for generic plot function.
#'
#' @return A summary of the effect sizes and respective confidence intervals.
Expand All @@ -327,14 +328,18 @@ cohens_h <- function(dabest_obj, perm_count = 5000) {
#' print(dabest_obj.mean_diff)
#'
#' @export
print.dabest_effectsize <- function(x, ...) {
print.dabest_effectsize <- function(x, print_greet_end = TRUE, ...) {
dabest_effectsize_obj <- x

check_effectsize_object(dabest_effectsize_obj)

print_greeting_header()
if (print_greet_end) {
print_greeting_header()
}
else cat("\n")

es <- dabest_effectsize_obj$effect_size_type
print_each_comparism_effectsize(dabest_effectsize_obj, es)
print_ending(dabest_effectsize_obj)
if (print_greet_end) {
print_ending(dabest_effectsize_obj)
}
}
8 changes: 5 additions & 3 deletions R/001_plotter.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -42,15 +42,17 @@ dabest_plot <- function(dabest_effectsize_obj, float_contrast = TRUE, ...) {

plot_kwargs <- assign_plot_kwargs(dabest_effectsize_obj, plot_kwargs)
custom_palette <- plot_kwargs$custom_palette
palette_values <- plot_kwargs$palette_values

is_colour <- dabest_effectsize_obj$is_colour
is_deltadelta <- plot_kwargs$show_delta2
is_mini_meta <- plot_kwargs$show_mini_meta
show_legend <- plot_kwargs$show_legend
idx <- dabest_effectsize_obj$idx
raw_legend <- NULL
total_groups <- length(unlist(idx))

if (length(unlist(idx)) >= 3) {
if (total_groups >= 3) {
float_contrast <- FALSE
}

Expand All @@ -59,8 +61,8 @@ dabest_plot <- function(dabest_effectsize_obj, float_contrast = TRUE, ...) {

delta_plot <- delta_plot$delta_plot

raw_plot <- apply_palette(raw_plot, custom_palette)
delta_plot <- apply_palette(delta_plot, custom_palette)
raw_plot <- apply_palette(raw_plot, custom_palette, palette_values, total_groups, delta = FALSE)
delta_plot <- apply_palette(delta_plot, custom_palette, palette_values, total_groups, delta = TRUE)

if (float_contrast) {
final_plot <- cowplot::plot_grid(
Expand Down
6 changes: 3 additions & 3 deletions R/002_plot_utils.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -423,7 +423,7 @@ add_swarm_bars_to_raw_plot <- function(dabest_effectsize_obj, plot_kwargs, x_val
swarm_bars_colours <- rep("black", length(x_values))
custom_colour <- "black"
} else {
swarm_bars_colours <- as.character(x_values)
swarm_bars_colours <- as.factor(x_values)
}

# Define width and height for each rectangle
Expand Down Expand Up @@ -497,7 +497,7 @@ add_contrast_bars_to_delta_plot <- function(dabest_effectsize_obj, plot_kwargs,
custom_colour <- "black"
} else {
# use the default palette colours of the ggplot violin plot object
contrast_bars_colours <- as.character((x_values))
contrast_bars_colours <- as.character(x_values)
# contrast_bars_colours <- factor(as.character(x_values), levels = group_levels)
}

Expand Down Expand Up @@ -621,7 +621,7 @@ add_delta_text_to_delta_plot <- function(delta_plot,
custom_colour <- "black"
} else {
# use the default palette colours of the ggplot violin plot object
colours <- get_palette_colours(plot_kwargs$custom_palette, max(x_values))
colours <- get_palette_colours(plot_kwargs$custom_palette, max(x_values), plot_kwargs$palette_values)
# Select colors at positions specified by x_values
delta_text_colours <- colours[x_values]
}
Expand Down
12 changes: 6 additions & 6 deletions R/005_printing.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -107,11 +107,11 @@ print_each_comparism_effectsize <- function(dabest_effectsize_obj, effectsize) {
pvalue <- dabest_effectsize_obj$permtest_pvals$pval_for_tests

# Use a lookup table for rm_status and paired_status
rm_status_lookup <- c(NULL = "", "sequential" = "for the sequential design of repeated-measures experiment \\n", "baseline" = "for repeated measures against baseline \\n")
rm_status_lookup <- c(NULL = "", "sequential" = "for the sequential design of repeated-measures experiment \n", "baseline" = "for repeated measures against baseline \n")
paired_status_lookup <- c(NULL = "unpaired", "sequential" = "paired", "baseline" = "paired")

rm_status <- rm_status_lookup[paired]
paired_status <- paired_status_lookup[paired]
rm_status <- rm_status_lookup[[format(paired)]] # make sure even NULL gets converted to string
paired_status <- paired_status_lookup[[format(paired)]] # make sure even NULL gets converted to string

if (is.list(dabest_effectsize_obj$idx)) {
for (group in dabest_effectsize_obj$idx) {
Expand All @@ -133,7 +133,7 @@ print_each_comparism_effectsize <- function(dabest_effectsize_obj, effectsize) {
current_ci <- ci[i]
current_pval <- pvalue[i]

cat(stringr::str_interp("The ${paired_status} ${es} between ${current_test_group} and ${control_group} is ${current_difference} [${current_ci}%CI ${current_bca_low}, ${current_bca_high}].\n"))
cat(stringr::str_interp("The ${paired_status} ${es} between ${current_test_group} and ${control_group} is ${current_difference}, ${current_ci}% CI [${current_bca_low}, ${current_bca_high}].\n"))
cat(stringr::str_interp("The p-value of the two-sided permutation t-test is ${sprintf(current_pval, fmt = '%#.4f')}, calculated for legacy purposes only."))
cat("\n\n")
i <- i + 1
Expand All @@ -149,7 +149,7 @@ print_each_comparism_effectsize <- function(dabest_effectsize_obj, effectsize) {
current_ci <- ci[i]
current_pval <- pvalue[i]

cat(stringr::str_interp("The ${paired_status} ${es} between ${current_group} and ${previous_group} is ${current_difference} [${current_ci}%CI ${current_bca_low}, ${current_bca_high}].\n"))
cat(stringr::str_interp("The ${paired_status} ${es} between ${current_group} and ${previous_group} is ${current_difference}, ${current_ci}% CI [${current_bca_low}, ${current_bca_high}].\n"))
cat(stringr::str_interp("The p-value of the two-sided permutation t-test is ${sprintf(current_pval, fmt = '%#.4f')}, calculated for legacy purposes only."))
cat("\n\n")
i <- i + 1
Expand All @@ -161,7 +161,7 @@ print_each_comparism_effectsize <- function(dabest_effectsize_obj, effectsize) {
test_groups <- dabest_effectsize_obj$idx[2:length(dabest_effectsize_obj$idx)]

for (current_test_group in test_groups) {
cat(stringr::str_interp("The ${paired_status} ${es} between ${current_test_group} and ${control_group} is ${difference} [${ci}%CI ${bca_low}, ${bca_high}].\n"))
cat(stringr::str_interp("The ${paired_status} ${es} between ${current_test_group} and ${control_group} is ${difference}, ${ci}% CI [${bca_low}, ${bca_high}].\n"))
cat(stringr::str_interp("The p-value of the two-sided permutation t-test is ${sprintf(current_pval, fmt = '%#.4f')}, calculated for legacy purposes only.\n"))
}
}
Expand Down
8 changes: 7 additions & 1 deletion R/999_plot_kwargs.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -44,7 +44,8 @@
#' paired proportion plot.
#' - `flow` Default TRUE. Boolean value determining whether the bars will be plotted in pairs.
#' - `custom_palette` Default "d3". String. The following palettes are available for use:
#' npg, aaas, nejm, lancet, jama, jco, ucscgb, d3, locuszoom, igv, cosmic, uchicago, brewer, ordinal, viridis_d.
#' npg, aaas, nejm, lancet, jama, jco, ucscgb, d3, locuszoom, igv, cosmic, uchicago, brewer, ordinal, viridis_d, manual.
#' - `palette_values` Default NULL. A vector of colors to be used, when the manual palette is selected.
#' - `contrast_bars` Default TRUE. Whether or not to display the contrast bars at the delta plot.
#' - `params_contrast_bars`. Default value: list(color = NULL, alpha = 0.3). Pass relevant keyword arguments to the contrast bars.
#' - `swarm_bars` Default TRUE. Whether or not to display the swarm bars.
Expand All @@ -61,6 +62,7 @@ NULL
assign_plot_kwargs <- function(dabest_effectsize_obj, plot_kwargs) {
check_effectsize_object(dabest_effectsize_obj)
custom_palette <- "d3"
palette_values <- NULL

swarm_label <- dabest_effectsize_obj$raw_y_labels
contrast_label <- dabest_effectsize_obj$delta_y_labels
Expand Down Expand Up @@ -105,6 +107,9 @@ assign_plot_kwargs <- function(dabest_effectsize_obj, plot_kwargs) {
if (!(is.null(plot_kwargs$custom_palette))) {
custom_palette <- plot_kwargs$custom_palette
}
if (!(is.null(plot_kwargs$palette_values))) {
palette_values <- plot_kwargs$palette_values
}
if (!(is.null(plot_kwargs$swarm_ylim))) {
swarm_ylim <- plot_kwargs$swarm_ylim
}
Expand Down Expand Up @@ -271,6 +276,7 @@ assign_plot_kwargs <- function(dabest_effectsize_obj, plot_kwargs) {
swarm_label = swarm_label,
contrast_label = contrast_label,
custom_palette = custom_palette,
palette_values = palette_values,
swarm_ylim = swarm_ylim,
contrast_ylim = contrast_ylim,
delta2_ylim = delta2_ylim,
Expand Down
Loading