diff --git a/r_functionality.R b/r_functionality.R index 79b35c3..6ce3a71 100644 --- a/r_functionality.R +++ b/r_functionality.R @@ -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 @@ -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) { @@ -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) @@ -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) { @@ -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) @@ -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) { @@ -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))))) @@ -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, @@ -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 @@ -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))))) @@ -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, @@ -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) @@ -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, ". ")) @@ -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(...) + diff --git a/tests/testthat/test_r_functionality.R b/tests/testthat/test_r_functionality.R index 5e2bffc..23fd176 100644 --- a/tests/testthat/test_r_functionality.R +++ b/tests/testthat/test_r_functionality.R @@ -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) } @@ -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()) }) @@ -136,8 +136,8 @@ 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") } @@ -145,10 +145,10 @@ test_that("within and between wrappers choose correct type", { 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")) } @@ -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")) } @@ -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")) } @@ -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") } @@ -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") }