Skip to content

Add mockable wrappers for external dependencies #8

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

Merged
M-Colley merged 1 commit into from
Nov 22, 2025
Merged

Add mockable wrappers for external dependencies #8

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
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
45 changes: 27 additions & 18 deletions r_functionality.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -220,10 +220,10 @@ n_fun <- function(x){
#' @export
#'
#' @examples
havingIP <- function() {
if (requireNamespace("curl", quietly = TRUE)) {
return(isTRUE(tryCatch(curl::has_internet(), error = function(...) FALSE)))
}
havingIP <- function() {
if (requireNamespace("curl", quietly = TRUE)) {
return(isTRUE(tryCatch(curl_has_internet(), error = function(...) FALSE)))
}

warning("Package 'curl' is not available; assuming no internet connection.")
FALSE
Expand Down Expand Up @@ -411,7 +411,7 @@ ggwithinstatsWithPriorNormalityCheck <- function(data, x, y, ylab, xlabels = NUL
sufficient_sample <- length(subset_data) >= 3

if (sufficient_sample && has_variation) {
normality_test[[group]] <- shapiro.test(subset_data)
normality_test[[group]] <- shapiro_test_wrapper(subset_data)
} else {
normality_test[[group]] <- NULL
if (!sufficient_sample) {
Expand Down Expand Up @@ -441,7 +441,7 @@ ggwithinstatsWithPriorNormalityCheck <- function(data, x, y, ylab, xlabels = NUL



plot <- ggstatsplot::ggwithinstats(
plot <- ggwithinstats_wrapper(
data = data, x = !!x, y = !!y, type = type, centrality.type = "p", ylab = ylab, xlab = "", pairwise.comparisons = showPairwiseComp, var.equal = group_all_data_equal,
centrality.point.args = list(size = 5, alpha = 0.5, color = "darkblue"), package = "pals", palette = "glasbey",
p.adjust.method = "holm", ggplot.component = list(theme(text = element_text(size = 16), plot.subtitle = element_text(size = 17, face = "bold"))), ggsignif.args = list(textsize = 4, tip_length = 0.01)
Expand Down Expand Up @@ -499,7 +499,7 @@ ggbetweenstatsWithPriorNormalityCheck <- function(data, x, y, ylab, xlabels, sho
sufficient_sample <- length(subset_data) >= 3

if (sufficient_sample && has_variation) {
normality_test[[group]] <- shapiro.test(subset_data)
normality_test[[group]] <- shapiro_test_wrapper(subset_data)
} else {
normality_test[[group]] <- NULL
if (!sufficient_sample) {
Expand Down Expand Up @@ -528,7 +528,7 @@ ggbetweenstatsWithPriorNormalityCheck <- function(data, x, y, ylab, xlabels, sho
type <- ifelse(normallyDistributed, "p", "np")

# if one group_all_data_equal then we use the var.equal = TRUE, see here: https://github.com/IndrajeetPatil/ggstatsplot/issues/880
ggstatsplot::ggbetweenstats(
ggbetweenstats_wrapper(
data = data, x = !!x, y = !!y, type = type, centrality.type = "p", ylab = ylab, xlab = "", pairwise.comparisons = showPairwiseComp, var.equal = group_all_data_equal,
centrality.point.args = list(size = 5, alpha = 0.5, color = "darkblue"), package = "pals", palette = "glasbey", plot.type = plotType,
p.adjust.method = "holm", ggplot.component = list(theme(text = element_text(size = 16), plot.subtitle = element_text(size = 17, face = "bold"))), ggsignif.args = list(textsize = 4, tip_length = 0.01)
Expand Down Expand Up @@ -580,7 +580,7 @@ ggbetweenstatsWithPriorNormalityCheckAsterisk <- function(data, x, y, ylab, xlab
sufficient_sample <- length(subset_data) >= 3

if (sufficient_sample && has_variation) {
normality_test[[group]] <- shapiro.test(subset_data)
normality_test[[group]] <- shapiro_test_wrapper(subset_data)
} else {
normality_test[[group]] <- NULL
if (!sufficient_sample) {
Expand Down Expand Up @@ -609,7 +609,7 @@ ggbetweenstatsWithPriorNormalityCheckAsterisk <- function(data, x, y, ylab, xlab


(df <-
pairwise_comparisons(data = data, x = !!x, y = !!y, type = type, p.adjust.method = "holm") %>%
pairwise_comparisons_wrapper(data = data, x = !!x, y = !!y, type = type, p.adjust.method = "holm") %>%
dplyr::mutate(groups = purrr::pmap(.l = list(group1, group2), .f = c)) %>%
dplyr::arrange(group1) %>%
dplyr::mutate(asterisk_label = ifelse(`p.value` < 0.05 & `p.value` > 0.01, "*", ifelse(`p.value` < 0.01 & `p.value` > 0.001, "**", ifelse(`p.value` < 0.001, "***", NA)))))
Expand All @@ -632,13 +632,13 @@ ggbetweenstatsWithPriorNormalityCheckAsterisk <- function(data, x, y, ylab, xlab
}


p <- ggstatsplot::ggbetweenstats(
p <- ggbetweenstats_wrapper(
data = data, x = !!x, y = !!y, type = type, centrality.type = "p", ylab = ylab, xlab = "", pairwise.display = "none", var.equal = group_all_data_equal,
centrality.point.args = list(size = 5, alpha = 0.5, color = "darkblue"), package = "pals", palette = "glasbey", plot.type = plotType,
p.adjust.method = "holm", ggplot.component = list(theme(text = element_text(size = 16), plot.subtitle = element_text(size = 17, face = "bold"))), ggsignif.args = list(textsize = 4, tip_length = 0.01)
) + scale_x_discrete(labels = xlabels)

p + ggsignif::geom_signif(
p + geom_signif_wrapper(
comparisons = df$groups,
map_signif_level = TRUE,
annotations = df$asterisk_label,
Expand Down Expand Up @@ -677,7 +677,7 @@ ggwithinstatsWithPriorNormalityCheckAsterisk <- function(data, x, y, ylab, xlabe
sufficient_sample <- length(subset_data) >= 3

if (sufficient_sample && has_variation) {
normality_test[[group]] <- shapiro.test(subset_data)
normality_test[[group]] <- shapiro_test_wrapper(subset_data)
} else {
normality_test[[group]] <- NULL
normality_assessable <- FALSE
Expand All @@ -700,7 +700,7 @@ ggwithinstatsWithPriorNormalityCheckAsterisk <- function(data, x, y, ylab, xlabe


(df <-
pairwise_comparisons(data = data, x = !!x, y = !!y, type = type, p.adjust.method = "holm") %>%
pairwise_comparisons_wrapper(data = data, x = !!x, y = !!y, type = type, p.adjust.method = "holm") %>%
dplyr::mutate(groups = purrr::pmap(.l = list(group1, group2), .f = c)) %>%
dplyr::arrange(group1) %>%
dplyr::mutate(asterisk_label = ifelse(`p.value` < 0.05 & `p.value` > 0.01, "*", ifelse(`p.value` < 0.01 & `p.value` > 0.001, "**", ifelse(`p.value` < 0.001, "***", NA)))))
Expand All @@ -723,13 +723,13 @@ ggwithinstatsWithPriorNormalityCheckAsterisk <- function(data, x, y, ylab, xlabe
}


p <- ggstatsplot::ggwithinstats(
p <- ggwithinstats_wrapper(
data = data, x = !!x, y = !!y, type = type, centrality.type = "p", ylab = ylab, xlab = "", pairwise.display = "none",
centrality.point.args = list(size = 5, alpha = 0.5, color = "darkblue"), package = "pals", palette = "glasbey", plot.type = plotType,
p.adjust.method = "holm", ggplot.component = list(theme(text = element_text(size = 16), plot.subtitle = element_text(size = 17, face = "bold"))), ggsignif.args = list(textsize = 4, tip_length = 0.01)
) + scale_x_discrete(labels = xlabels)

p + ggsignif::geom_signif(
p + geom_signif_wrapper(
comparisons = df$groups,
map_signif_level = TRUE,
annotations = df$asterisk_label,
Expand Down Expand Up @@ -1878,7 +1878,7 @@ reportggstatsplot <- function(p, iv = "independent", dv = "Testdependentvariable
not_empty(dv)
not_empty(iv)

stats <- extract_stats(p)$subtitle_data
stats <- extract_stats_wrapper(p)$subtitle_data
resultString <- ""

effectSize <- round(stats$estimate, digits = 2)
Expand Down Expand Up @@ -2687,7 +2687,7 @@ reportggstatsplotPostHoc <- function(data, p, iv = "testiv", dv = "testdv", labe
not_empty(dv)

# Extract stats from the ggstatsplot object
stats <- extract_stats(p)$pairwise_comparisons_data
stats <- extract_stats_wrapper(p)$pairwise_comparisons_data

if (!any(stats$p.value < 0.05, na.rm = TRUE)) {
cat(paste0("A post-hoc test found no significant differences for ", dv, ". "))
Expand Down Expand Up @@ -2757,3 +2757,12 @@ reportggstatsplotPostHoc <- function(data, p, iv = "testiv", dv = "testdv", labe



# Helper wrappers around external functions so they can be mocked in tests
curl_has_internet <- function(...) curl::has_internet(...)
ggwithinstats_wrapper <- function(...) ggstatsplot::ggwithinstats(...)
ggbetweenstats_wrapper <- function(...) ggstatsplot::ggbetweenstats(...)
pairwise_comparisons_wrapper <- function(...) ggstatsplot::pairwise_comparisons(...)
geom_signif_wrapper <- function(...) ggsignif::geom_signif(...)
shapiro_test_wrapper <- function(...) stats::shapiro.test(...)
extract_stats_wrapper <- function(...) ggstatsplot::extract_stats(...)

36 changes: 18 additions & 18 deletions tests/testthat/test_r_functionality.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -74,8 +74,8 @@ posthoc_stats <- list(
basic_plot <- ggplot2::ggplot(sample_df, ggplot2::aes(x = ConditionID, y = value)) + ggplot2::geom_point()

# Helper wrapper to avoid relying on pkgload/devtools metadata when mocking
with_mock <- function(..., .env = parent.frame()) {
testthat::with_mocked_bindings(..., .package = "base", .env = .env)
with_mock <- function(..., .env = globalenv()) {
testthat::with_mocked_bindings(..., .env = .env)
}


Expand All @@ -97,7 +97,7 @@ test_that("basic utility helpers behave", {
expect_s3_class(n_result, "data.frame")
expect_equal(n_result$label, paste0("n = ", length(sample_df$value)))

with_mock(`curl::has_internet` = function(...) TRUE, {
with_mock(curl_has_internet = function(...) TRUE, {
expect_true(havingIP())
})

Expand Down Expand Up @@ -136,19 +136,19 @@ test_that("within and between wrappers choose correct type", {
expect_equal(result$type, "p")

np_result <- with_mock(
`ggstatsplot::ggwithinstats` = function(..., type) list(type = type),
shapiro.test = function(...) list(p.value = 0.001),
ggwithinstats_wrapper = function(..., type) list(type = type),
shapiro_test_wrapper = function(...) list(p.value = 0.001),
{
ggwithinstatsWithPriorNormalityCheck(data, "group", "value", "Value")
}
)
expect_equal(np_result$type, "np")

between <- with_mock(
`ggstatsplot::ggbetweenstats` = function(..., type) list(type = type),
shapiro.test = function(...) list(p.value = 0.001),
pairwise_comparisons = function(...) data.frame(group1 = "A", group2 = "B", `p.value` = 0.01, stringsAsFactors = FALSE),
`ggsignif::geom_signif` = function(...) ggplot2::geom_blank(),
ggbetweenstats_wrapper = function(..., type) list(type = type),
shapiro_test_wrapper = function(...) list(p.value = 0.001),
pairwise_comparisons_wrapper = function(...) data.frame(group1 = "A", group2 = "B", `p.value` = 0.01, stringsAsFactors = FALSE),
geom_signif_wrapper = function(...) ggplot2::geom_blank(),
{
ggbetweenstatsWithPriorNormalityCheck(data, "group", "value", "Value", c("A", "B"))
}
Expand All @@ -157,9 +157,9 @@ test_that("within and between wrappers choose correct type", {

expect_s3_class(
with_mock(
`ggstatsplot::ggbetweenstats` = function(...) ggplot2::ggplot(),
pairwise_comparisons = function(...) data.frame(group1 = "A", group2 = "B", `p.value` = 0.01, stringsAsFactors = FALSE),
`ggsignif::geom_signif` = function(...) ggplot2::geom_blank(),
ggbetweenstats_wrapper = function(...) ggplot2::ggplot(),
pairwise_comparisons_wrapper = function(...) data.frame(group1 = "A", group2 = "B", `p.value` = 0.01, stringsAsFactors = FALSE),
geom_signif_wrapper = function(...) ggplot2::geom_blank(),
{
ggbetweenstatsWithPriorNormalityCheckAsterisk(data, "group", "value", "Value", c("A", "B"))
}
Expand All @@ -169,10 +169,10 @@ test_that("within and between wrappers choose correct type", {

expect_s3_class(
with_mock(
`ggstatsplot::ggwithinstats` = function(...) ggplot2::ggplot(),
pairwise_comparisons = function(...) data.frame(group1 = "A", group2 = "B", `p.value` = 0.01, stringsAsFactors = FALSE),
`ggsignif::geom_signif` = function(...) ggplot2::geom_blank(),
shapiro.test = function(...) list(p.value = 0.2),
ggwithinstats_wrapper = function(...) ggplot2::ggplot(),
pairwise_comparisons_wrapper = function(...) data.frame(group1 = "A", group2 = "B", `p.value` = 0.01, stringsAsFactors = FALSE),
geom_signif_wrapper = function(...) ggplot2::geom_blank(),
shapiro_test_wrapper = function(...) list(p.value = 0.2),
{
ggwithinstatsWithPriorNormalityCheckAsterisk(data, "group", "value", "Value", c("A", "B"))
}
Expand Down Expand Up @@ -222,7 +222,7 @@ test_that("reporting helpers include effect sizes", {
expect_match(
capture.output(
with_mock(
extract_stats = function(...) posthoc_stats,
extract_stats_wrapper = function(...) posthoc_stats,
{
reportggstatsplot(basic_plot, iv = "group", dv = "score")
}
Expand All @@ -233,7 +233,7 @@ test_that("reporting helpers include effect sizes", {

expect_output(
with_mock(
extract_stats = function(...) posthoc_stats,
extract_stats_wrapper = function(...) posthoc_stats,
{
reportggstatsplotPostHoc(report_data, basic_plot, iv = "group", dv = "score")
}
Expand Down
Loading