From 359a5258e80131de945e8313cf8aa15420714eb4 Mon Sep 17 00:00:00 2001 From: Indrajeet Patil Date: Sat, 27 Jul 2024 12:53:48 +0200 Subject: [PATCH 1/6] Make `extract_stats()` work with grouped plots --- R/extract-stats.R | 29 ++++++++++++++++---------- man/extract_stats.Rd | 7 ++----- tests/testthat/_snaps/extract-stats.md | 10 +++++++++ tests/testthat/test-extract-stats.R | 15 +++++++++++++ 4 files changed, 45 insertions(+), 16 deletions(-) diff --git a/R/extract-stats.R b/R/extract-stats.R index 8a99fb6c0..1316c248e 100644 --- a/R/extract-stats.R +++ b/R/extract-stats.R @@ -21,7 +21,6 @@ #' The exact details included will depend on the function. #' #' @param p A plot from `{ggstatsplot}` package -#' @param ... Ignored #' #' @autoglobal #' @@ -46,19 +45,27 @@ #' #' extract_stats(p1) #' -#' extract_stats(p2[[1L]]) -#' extract_stats(p2[[2L]]) +#' extract_stats(p2) #' @export -extract_stats <- function(p, ...) { +extract_stats <- function(p) { + if (inherits(p, "patchwork")) { + plots <- purrr::map(seq_along(p), ~ purrr::pluck(p, .x)) + purrr::map(plots, .extract_stats_ggplot) + } else { + .extract_stats_ggplot(p) + } +} + +.extract_stats_ggplot <- function(p) { # styler: off list( - subtitle_data = tryCatch(p$plot_env$subtitle_df, error = function(e) NULL), - caption_data = tryCatch(p$plot_env$caption_df, error = function(e) NULL), - pairwise_comparisons_data = tryCatch(p$plot_env$mpc_df, error = function(e) NULL), - descriptive_data = tryCatch(p$plot_env$descriptive_df, error = function(e) NULL), - one_sample_data = tryCatch(p$plot_env$onesample_df, error = function(e) NULL), - tidy_data = tryCatch(p$plot_env$tidy_df, error = function(e) NULL), - glance_data = tryCatch(p$plot_env$glance_df, error = function(e) NULL) + subtitle_data = purrr::pluck(p, "plot_env", "subtitle_df"), + caption_data = purrr::pluck(p, "plot_env", "caption_df"), + pairwise_comparisons_data = purrr::pluck(p, "plot_env", "mpc_df"), + descriptive_data = purrr::pluck(p, "plot_env", "descriptive_df"), + one_sample_data = purrr::pluck(p, "plot_env", "onesample_df"), + tidy_data = purrr::pluck(p, "plot_env", "tidy_df"), + glance_data = purrr::pluck(p, "plot_env", "glance_df") ) # styler: on } diff --git a/man/extract_stats.Rd b/man/extract_stats.Rd index ad244dad7..a6125423a 100644 --- a/man/extract_stats.Rd +++ b/man/extract_stats.Rd @@ -6,7 +6,7 @@ \alias{extract_caption} \title{Extracting data frames or expressions from \code{{ggstatsplot}} plots} \usage{ -extract_stats(p, ...) +extract_stats(p) extract_subtitle(p) @@ -14,8 +14,6 @@ extract_caption(p) } \arguments{ \item{p}{A plot from \code{{ggstatsplot}} package} - -\item{...}{Ignored} } \value{ A list of tibbles containing summaries of various statistical analyses. @@ -60,7 +58,6 @@ extract_caption(p2) extract_stats(p1) -extract_stats(p2[[1L]]) -extract_stats(p2[[2L]]) +extract_stats(p2) \dontshow{\}) # examplesIf} } diff --git a/tests/testthat/_snaps/extract-stats.md b/tests/testthat/_snaps/extract-stats.md index e03e814c4..164ee1785 100644 --- a/tests/testthat/_snaps/extract-stats.md +++ b/tests/testthat/_snaps/extract-stats.md @@ -128,3 +128,13 @@ NULL +# checking if extract_stats works for grouped plots + + Code + p8 <- grouped_ggpiestats(mtcars, x = cyl, grouping.var = am) + list(length(extract_stats(p8))) + Output + [[1]] + [1] 2 + + diff --git a/tests/testthat/test-extract-stats.R b/tests/testthat/test-extract-stats.R index c96e06fa6..e8e505688 100644 --- a/tests/testthat/test-extract-stats.R +++ b/tests/testthat/test-extract-stats.R @@ -75,3 +75,18 @@ test_that( }) } ) + + +test_that( + "checking if extract_stats works for grouped plots", + { + expect_snapshot({ + p8 <- grouped_ggpiestats(mtcars, x = cyl, grouping.var = am) + list( + length(extract_stats(p8)) + # extract_subtitle(p7), + # extract_caption(p7) + ) + }) + } +) From 23deb3e74a3931f9eaeaa477ff6b57dc329a9ae1 Mon Sep 17 00:00:00 2001 From: Indrajeet Patil Date: Sat, 27 Jul 2024 15:09:45 +0200 Subject: [PATCH 2/6] use function factory for component data --- R/extract-stats.R | 20 +++++++++-------- tests/testthat/_snaps/extract-stats.md | 31 ++++++++++++++++++++++---- tests/testthat/test-extract-stats.R | 16 ++++++++----- 3 files changed, 49 insertions(+), 18 deletions(-) diff --git a/R/extract-stats.R b/R/extract-stats.R index 1316c248e..871655382 100644 --- a/R/extract-stats.R +++ b/R/extract-stats.R @@ -48,15 +48,12 @@ #' extract_stats(p2) #' @export extract_stats <- function(p) { - if (inherits(p, "patchwork")) { - plots <- purrr::map(seq_along(p), ~ purrr::pluck(p, .x)) - purrr::map(plots, .extract_stats_ggplot) - } else { - .extract_stats_ggplot(p) - } + if (inherits(p, "patchwork")) purrr::map(.extract_plots(p), .extract_stats) else .extract_stats(p) } -.extract_stats_ggplot <- function(p) { +.extract_plots <- function(p) purrr::map(seq_along(p), ~ purrr::pluck(p, .x)) + +.extract_stats <- function(p) { # styler: off list( subtitle_data = purrr::pluck(p, "plot_env", "subtitle_df"), @@ -70,10 +67,15 @@ extract_stats <- function(p) { # styler: on } +# function factory to extract particular kind of stats data +.extract_stats_data <- function(data) { + function(p) purrr::pluck(extract_stats(p), data, "expression", 1L) +} + #' @rdname extract_stats #' @export -extract_subtitle <- function(p) purrr::pluck(extract_stats(p), "subtitle_data", "expression", 1L) +extract_subtitle <- .extract_stats_data("subtitle_data") #' @rdname extract_stats #' @export -extract_caption <- function(p) purrr::pluck(extract_stats(p), "caption_data", "expression", 1L) +extract_caption <- .extract_stats_data("caption_data") diff --git a/tests/testthat/_snaps/extract-stats.md b/tests/testthat/_snaps/extract-stats.md index 164ee1785..c13fb1234 100644 --- a/tests/testthat/_snaps/extract-stats.md +++ b/tests/testthat/_snaps/extract-stats.md @@ -132,9 +132,32 @@ Code p8 <- grouped_ggpiestats(mtcars, x = cyl, grouping.var = am) - list(length(extract_stats(p8))) + extracted_data <- extract_stats(p8) + summary(extracted_data) Output - [[1]] - [1] 2 - + Length Class Mode + [1,] 7 -none- list + [2,] 7 -none- list + Code + summary(extracted_data[[1L]]) + Output + Length Class Mode + subtitle_data 13 statsExpressions list + caption_data 4 statsExpressions list + pairwise_comparisons_data 0 -none- NULL + descriptive_data 4 tbl_df list + one_sample_data 0 -none- NULL + tidy_data 0 -none- NULL + glance_data 0 -none- NULL + Code + summary(extracted_data[[2L]]) + Output + Length Class Mode + subtitle_data 13 statsExpressions list + caption_data 4 statsExpressions list + pairwise_comparisons_data 0 -none- NULL + descriptive_data 4 tbl_df list + one_sample_data 0 -none- NULL + tidy_data 0 -none- NULL + glance_data 0 -none- NULL diff --git a/tests/testthat/test-extract-stats.R b/tests/testthat/test-extract-stats.R index e8e505688..3607bb860 100644 --- a/tests/testthat/test-extract-stats.R +++ b/tests/testthat/test-extract-stats.R @@ -82,11 +82,17 @@ test_that( { expect_snapshot({ p8 <- grouped_ggpiestats(mtcars, x = cyl, grouping.var = am) - list( - length(extract_stats(p8)) - # extract_subtitle(p7), - # extract_caption(p7) - ) + extracted_data <- extract_stats(p8) + summary(extracted_data) + summary(extracted_data[[1L]]) + summary(extracted_data[[2L]]) }) } ) + +test_that( + "checking if extract_stats produces NULL on supported objects", + { + expect_length(purrr::compact(extract_stats(iris)), 0L) + } +) From 45d4cb86921062559057a461f54664ae85864229 Mon Sep 17 00:00:00 2001 From: Indrajeet Patil Date: Sat, 27 Jul 2024 16:12:07 +0200 Subject: [PATCH 3/6] make sure extracting subtitle and caption also works --- NEWS.md | 8 +++++++ R/extract-stats.R | 30 ++++++++++++++++---------- README.md | 3 +++ tests/testthat/_snaps/extract-stats.md | 30 +++++++++++++++++++++++--- tests/testthat/test-extract-stats.R | 2 ++ 5 files changed, 59 insertions(+), 14 deletions(-) diff --git a/NEWS.md b/NEWS.md index 1eeb17c8f..8d78c7b97 100644 --- a/NEWS.md +++ b/NEWS.md @@ -5,6 +5,14 @@ N.B. All statistical analysis in `{ggstatsplot}` is carried out in read the `NEWS` for that package: +## MAJOR CHANGES + +- `extract_stats()` returns a list of class `ggstatsplot_stats` which + contains all the statistical summaries and expressions for a given plot. + +- `extract_stats()`, `extract_subtitle()`, `extract_caption()` now works + out of the box for the grouped plots as well. + ## BUG FIXES - `ggpiestats()` and `ggbarstats()` now respect `ratio()` argument for diff --git a/R/extract-stats.R b/R/extract-stats.R index 871655382..22d95130a 100644 --- a/R/extract-stats.R +++ b/R/extract-stats.R @@ -53,23 +53,31 @@ extract_stats <- function(p) { .extract_plots <- function(p) purrr::map(seq_along(p), ~ purrr::pluck(p, .x)) +.pluck_plot_env <- function(p, data) purrr::pluck(p, "plot_env", data) + .extract_stats <- function(p) { # styler: off - list( - subtitle_data = purrr::pluck(p, "plot_env", "subtitle_df"), - caption_data = purrr::pluck(p, "plot_env", "caption_df"), - pairwise_comparisons_data = purrr::pluck(p, "plot_env", "mpc_df"), - descriptive_data = purrr::pluck(p, "plot_env", "descriptive_df"), - one_sample_data = purrr::pluck(p, "plot_env", "onesample_df"), - tidy_data = purrr::pluck(p, "plot_env", "tidy_df"), - glance_data = purrr::pluck(p, "plot_env", "glance_df") - ) + structure(list( + subtitle_data = .pluck_plot_env(p, "subtitle_df"), + caption_data = .pluck_plot_env(p, "caption_df"), + pairwise_comparisons_data = .pluck_plot_env(p, "mpc_df"), + descriptive_data = .pluck_plot_env(p, "descriptive_df"), + one_sample_data = .pluck_plot_env(p, "onesample_df"), + tidy_data = .pluck_plot_env(p, "tidy_df"), + glance_data = .pluck_plot_env(p, "glance_df") + ), class = c("ggstatsplot_stats", "list")) # styler: on } + + # function factory to extract particular kind of stats data -.extract_stats_data <- function(data) { - function(p) purrr::pluck(extract_stats(p), data, "expression", 1L) +.extract_stats_data <- function(data_component) { + function(p) { + data <- extract_stats(p) + .pluck_expression <- function(x) purrr::pluck(x, data_component, "expression", 1L) + if (inherits(data, "ggstatsplot_stats")) .pluck_expression(data) else purrr::map(data, ~ .pluck_expression(.x)) + } } #' @rdname extract_stats diff --git a/README.md b/README.md index 93c824458..c59831e5b 100644 --- a/README.md +++ b/README.md @@ -769,6 +769,9 @@ extract_stats(p) #> #> $glance_data #> NULL +#> +#> attr(,"class") +#> [1] "ggstatsplot_stats" "list" ``` Note that all of this analysis is carried out by `{statsExpressions}` diff --git a/tests/testthat/_snaps/extract-stats.md b/tests/testthat/_snaps/extract-stats.md index c13fb1234..72d5e8c18 100644 --- a/tests/testthat/_snaps/extract-stats.md +++ b/tests/testthat/_snaps/extract-stats.md @@ -135,9 +135,9 @@ extracted_data <- extract_stats(p8) summary(extracted_data) Output - Length Class Mode - [1,] 7 -none- list - [2,] 7 -none- list + Length Class Mode + [1,] 7 ggstatsplot_stats list + [2,] 7 ggstatsplot_stats list Code summary(extracted_data[[1L]]) Output @@ -160,4 +160,28 @@ one_sample_data 0 -none- NULL tidy_data 0 -none- NULL glance_data 0 -none- NULL + Code + extract_subtitle(p8) + Output + [[1]] + list(chi["gof"]^2 * "(" * 2 * ")" == "7.68", italic(p) == "0.02", + widehat(italic("C"))["Pearson"] == "0.54", CI["95%"] ~ "[" * + "0.07", "0.73" * "]", italic("n")["obs"] == "19") + + [[2]] + list(chi["gof"]^2 * "(" * 2 * ")" == "4.77", italic(p) == "0.09", + widehat(italic("C"))["Pearson"] == "0.52", CI["95%"] ~ "[" * + "0.00", "0.74" * "]", italic("n")["obs"] == "13") + + Code + extract_caption(p8) + Output + [[1]] + list(log[e] * (BF["01"]) == "-0.16", italic("a")["Gunel-Dickey"] == + "1.00") + + [[2]] + list(log[e] * (BF["01"]) == "0.82", italic("a")["Gunel-Dickey"] == + "1.00") + diff --git a/tests/testthat/test-extract-stats.R b/tests/testthat/test-extract-stats.R index 3607bb860..475aa66ed 100644 --- a/tests/testthat/test-extract-stats.R +++ b/tests/testthat/test-extract-stats.R @@ -86,6 +86,8 @@ test_that( summary(extracted_data) summary(extracted_data[[1L]]) summary(extracted_data[[2L]]) + extract_subtitle(p8) + extract_caption(p8) }) } ) From eba7ef6ac26a0a6e41e73936d801a42ceb768b94 Mon Sep 17 00:00:00 2001 From: IndrajeetPatil Date: Sat, 27 Jul 2024 14:16:58 +0000 Subject: [PATCH 4/6] Apply automatic changes --- API | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/API b/API index ff7ad1fcb..97d7ffdc6 100644 --- a/API +++ b/API @@ -4,7 +4,7 @@ combine_plots(plotlist, plotgrid.args = list(), annotation.args = list(), guides = "collect", ...) extract_caption(p) -extract_stats(p, ...) +extract_stats(p) extract_subtitle(p) ggbarstats(data, x, y, counts = NULL, type = "parametric", paired = FALSE, results.subtitle = TRUE, label = "percentage", label.args = list(alpha = 1, fill = "white"), sample.size.label.args = list(size = 4), digits = 2L, proportion.test = results.subtitle, digits.perc = 0L, bf.message = TRUE, ratio = NULL, conf.level = 0.95, sampling.plan = "indepMulti", fixed.margin = "rows", prior.concentration = 1, title = NULL, subtitle = NULL, caption = NULL, legend.title = NULL, xlab = NULL, ylab = NULL, ggtheme = ggstatsplot::theme_ggstatsplot(), package = "RColorBrewer", palette = "Dark2", ggplot.component = NULL, ...) ggbetweenstats(data, x, y, type = "parametric", pairwise.display = "significant", p.adjust.method = "holm", effsize.type = "unbiased", bf.prior = 0.707, bf.message = TRUE, results.subtitle = TRUE, xlab = NULL, ylab = NULL, caption = NULL, title = NULL, subtitle = NULL, digits = 2L, var.equal = FALSE, conf.level = 0.95, nboot = 100L, tr = 0.2, centrality.plotting = TRUE, centrality.type = type, centrality.point.args = list(size = 5, color = "darkred"), centrality.label.args = list(size = 3, nudge_x = 0.4, segment.linetype = 4, min.segment.length = 0), point.args = list(position = ggplot2::position_jitterdodge(dodge.width = 0.6), alpha = 0.4, size = 3, stroke = 0, na.rm = TRUE), boxplot.args = list(width = 0.3, alpha = 0.2, na.rm = TRUE), violin.args = list(width = 0.5, alpha = 0.2, na.rm = TRUE), ggsignif.args = list(textsize = 3, tip_length = 0.01, na.rm = TRUE), ggtheme = ggstatsplot::theme_ggstatsplot(), package = "RColorBrewer", palette = "Dark2", ggplot.component = NULL, ...) From 3cb55d472af7a0bf0f8132c91891d105f67d8f96 Mon Sep 17 00:00:00 2001 From: Indrajeet Patil Date: Sat, 27 Jul 2024 16:21:34 +0200 Subject: [PATCH 5/6] delint --- R/extract-stats.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/extract-stats.R b/R/extract-stats.R index 22d95130a..5e568a96a 100644 --- a/R/extract-stats.R +++ b/R/extract-stats.R @@ -74,9 +74,9 @@ extract_stats <- function(p) { # function factory to extract particular kind of stats data .extract_stats_data <- function(data_component) { function(p) { - data <- extract_stats(p) + dat <- extract_stats(p) .pluck_expression <- function(x) purrr::pluck(x, data_component, "expression", 1L) - if (inherits(data, "ggstatsplot_stats")) .pluck_expression(data) else purrr::map(data, ~ .pluck_expression(.x)) + if (inherits(dat, "ggstatsplot_stats")) .pluck_expression(dat) else purrr::map(dat, .pluck_expression) } } From a4e62218a5e0ee0f842aedc5ca9d77a91e091921 Mon Sep 17 00:00:00 2001 From: Indrajeet Patil Date: Sat, 27 Jul 2024 16:47:02 +0200 Subject: [PATCH 6/6] cleaner snapshot --- tests/testthat/_snaps/extract-stats.md | 33 -------------------------- tests/testthat/test-extract-stats.R | 3 --- 2 files changed, 36 deletions(-) diff --git a/tests/testthat/_snaps/extract-stats.md b/tests/testthat/_snaps/extract-stats.md index 72d5e8c18..19825d4d7 100644 --- a/tests/testthat/_snaps/extract-stats.md +++ b/tests/testthat/_snaps/extract-stats.md @@ -138,28 +138,6 @@ Length Class Mode [1,] 7 ggstatsplot_stats list [2,] 7 ggstatsplot_stats list - Code - summary(extracted_data[[1L]]) - Output - Length Class Mode - subtitle_data 13 statsExpressions list - caption_data 4 statsExpressions list - pairwise_comparisons_data 0 -none- NULL - descriptive_data 4 tbl_df list - one_sample_data 0 -none- NULL - tidy_data 0 -none- NULL - glance_data 0 -none- NULL - Code - summary(extracted_data[[2L]]) - Output - Length Class Mode - subtitle_data 13 statsExpressions list - caption_data 4 statsExpressions list - pairwise_comparisons_data 0 -none- NULL - descriptive_data 4 tbl_df list - one_sample_data 0 -none- NULL - tidy_data 0 -none- NULL - glance_data 0 -none- NULL Code extract_subtitle(p8) Output @@ -173,15 +151,4 @@ widehat(italic("C"))["Pearson"] == "0.52", CI["95%"] ~ "[" * "0.00", "0.74" * "]", italic("n")["obs"] == "13") - Code - extract_caption(p8) - Output - [[1]] - list(log[e] * (BF["01"]) == "-0.16", italic("a")["Gunel-Dickey"] == - "1.00") - - [[2]] - list(log[e] * (BF["01"]) == "0.82", italic("a")["Gunel-Dickey"] == - "1.00") - diff --git a/tests/testthat/test-extract-stats.R b/tests/testthat/test-extract-stats.R index 475aa66ed..2cd0ef66a 100644 --- a/tests/testthat/test-extract-stats.R +++ b/tests/testthat/test-extract-stats.R @@ -84,10 +84,7 @@ test_that( p8 <- grouped_ggpiestats(mtcars, x = cyl, grouping.var = am) extracted_data <- extract_stats(p8) summary(extracted_data) - summary(extracted_data[[1L]]) - summary(extracted_data[[2L]]) extract_subtitle(p8) - extract_caption(p8) }) } )