Skip to content

Modify dabestr print to make greeting/ending optional and fix formatting #185

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
marsiwiec wants to merge 9 commits into
base: dev
Choose a base branch
from
Open

Modify dabestr print to make greeting/ending optional and fix formatting #185

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
9 commits
Select commit Hold shift + click to select a range
b9c034c
Update to v2023.9.12
sunroofgod Sep 12, 2023
d206ef7
Merge pull request #147 from ACCLAB/dev
maiyishan Sep 12, 2023
74a9d60
Merge pull request #153 from ACCLAB/dev
maiyishan Oct 23, 2023
88768ac
Merge pull request #180 from ACCLAB/dev
maiyishan May 8, 2025
da1a5f1
Modify dabestr print to make greeting/ending optional
marsiwiec Jun 2, 2025
7912a22
Don't test plot type
teunbrand Jun 24, 2025
7fb4eee
Merge pull request #187 from teunbrand/compat_ggplot2_400
Jacobluke- Sep 15, 2025
c9a42cd
Merge branch 'ACCLAB:master' into master
marsiwiec Jan 22, 2026
e8b479d
(temp) test bugfix to brewer pal
marsiwiec Jan 23, 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 @@ -49,7 +49,7 @@ Imports:
dplyr,
effsize,
ggbeeswarm,
ggplot2 (>= 3.5.1),
ggplot2 (>= 3.5.2),
ggsci,
grid,
magrittr,
Expand Down
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)
}
}
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
75 changes: 42 additions & 33 deletions R/999_plot_palettes.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -5,45 +5,54 @@
# Applies palettes to <ggplot> objects
# TODO add proper documentation.
apply_palette <- function(ggplot_object, palette_name) {
ggplot_object <- switch(palette_name,
"npg" =
ggplot_object + ggsci::scale_color_npg() + ggsci::scale_fill_npg(),
"aaas" =
ggplot_object + ggsci::scale_color_aaas() + ggsci::scale_fill_aaas(),
"nejm" =
ggplot_object + ggsci::scale_color_nejm() + ggsci::scale_fill_nejm(),
"lancet" =
ggplot_object + ggsci::scale_color_lancet() + ggsci::scale_fill_lancet(),
"jama" =
ggplot_object + ggsci::scale_color_jama() + ggsci::scale_fill_jama(),
"jco" =
ggplot_object + ggsci::scale_color_jco() + ggsci::scale_fill_jco(),
"ucscgb" =
ggplot_object + ggsci::scale_color_ucscgb() + ggsci::scale_fill_ucscgb(),
"d3" =
ggplot_object + ggsci::scale_color_d3() + ggsci::scale_fill_d3(),
"locuszoom" =
ggplot_object + ggsci::scale_color_locuszoom() + ggsci::scale_fill_locuszoom(),
"igv" =
ggplot_object + ggsci::scale_color_igv() + ggsci::scale_fill_igv(),
"cosmic" =
ggplot_object + ggsci::scale_color_cosmic() + ggsci::scale_fill_cosmic(),
"uchicago" =
ggplot_object + ggsci::scale_color_uchicago() + ggsci::scale_fill_uchicago(),
"brewer" =
ggplot_object + ggplot2::scale_color_brewer() + ggplot2::scale_fill_brewer(),
"ordinal" =
ggplot_object + ggplot2::scale_color_ordinal() + ggplot2::scale_fill_ordinal(),
"viridis_d" =
ggplot_object + ggplot2::scale_color_viridis_d() + ggplot2::scale_fill_viridis_d()
ggplot_object <- switch(
palette_name,
"npg" = ggplot_object + ggsci::scale_color_npg() + ggsci::scale_fill_npg(),
"aaas" = ggplot_object +
ggsci::scale_color_aaas() +
ggsci::scale_fill_aaas(),
"nejm" = ggplot_object +
ggsci::scale_color_nejm() +
ggsci::scale_fill_nejm(),
"lancet" = ggplot_object +
ggsci::scale_color_lancet() +
ggsci::scale_fill_lancet(),
"jama" = ggplot_object +
ggsci::scale_color_jama() +
ggsci::scale_fill_jama(),
"jco" = ggplot_object + ggsci::scale_color_jco() + ggsci::scale_fill_jco(),
"ucscgb" = ggplot_object +
ggsci::scale_color_ucscgb() +
ggsci::scale_fill_ucscgb(),
"d3" = ggplot_object + ggsci::scale_color_d3() + ggsci::scale_fill_d3(),
"locuszoom" = ggplot_object +
ggsci::scale_color_locuszoom() +
ggsci::scale_fill_locuszoom(),
"igv" = ggplot_object + ggsci::scale_color_igv() + ggsci::scale_fill_igv(),
"cosmic" = ggplot_object +
ggsci::scale_color_cosmic() +
ggsci::scale_fill_cosmic(),
"uchicago" = ggplot_object +
ggsci::scale_color_uchicago() +
ggsci::scale_fill_uchicago(),
"brewerDark2" = ggplot_object +
ggplot2::scale_color_brewer(palette = "Dark2") +
ggplot2::scale_fill_brewer(palette = "Dark2"),
"ordinal" = ggplot_object +
ggplot2::scale_color_ordinal() +
ggplot2::scale_fill_ordinal(),
"viridis_d" = ggplot_object +
ggplot2::scale_color_viridis_d() +
ggplot2::scale_fill_viridis_d()
)

return(ggplot_object)
}

get_palette_colours <- function(palette_name, num_colours) {
# palette function by name
colours <- switch(palette_name,
colours <- switch(
palette_name,
"npg" = ggsci::pal_npg()(num_colours),
"aaas" = ggsci::pal_aaas()(num_colours),
"nejm" = ggsci::pal_nejm()(num_colours),
Expand All @@ -56,7 +65,7 @@ get_palette_colours <- function(palette_name, num_colours) {
"igv" = ggsci::pal_igv()(num_colours),
"cosmic" = ggsci::pal_cosmic()(num_colours),
"uchicago" = ggsci::pal_uchicago()(num_colours),
"brewer" = RColorBrewer::brewer.pal()(num_colours),
"brewerDark2" = RColorBrewer::brewer.pal(name = "Dark2", n = num_colours),
"ordinal" = viridisLite::viridis(n = num_colours, option = "viridis"),
"viridis_d" = viridisLite::viridis(n = num_colours, option = "viridis")
)
Expand Down
2 changes: 1 addition & 1 deletion tests/testthat/test_002_plot_components.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -12,7 +12,7 @@ describe("Testing add_scaling_component_to_delta_plot function", {
expect_type(result, "list")
expect_equal(length(result), 3) # 3 components returned
# Check delta_plot component
expect_type(result[[1]], "list")
expect_true(ggplot2::is_ggplot(result[[1]]))
# TODO Add specific expectations to check if the components are created correctly
})
})
Expand Down