Make sure extract_stats() and cousins work out of the box with grouped plots (#955)

Author: IndrajeetPatil

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, ...)

NEWS.md

@@ -5,6 +5,14 @@ N.B. All statistical analysis in `{ggstatsplot}` is carried out in
 read the `NEWS` for that package:
 <https://indrajeetpatil.github.io/statsExpressions/news/index.html>
 
+## 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

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,27 +45,45 @@
 #'
 #' 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")) purrr::map(.extract_plots(p), .extract_stats) else .extract_stats(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             = 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)
-  )
+  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_component) {
+  function(p) {
+    dat <- extract_stats(p)
+    .pluck_expression <- function(x) purrr::pluck(x, data_component, "expression", 1L)
+    if (inherits(dat, "ggstatsplot_stats")) .pluck_expression(dat) else purrr::map(dat, .pluck_expression)
+  }
+}
+
 #' @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")

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}`

man/extract_stats.Rd

@@ -128,3 +128,27 @@
       NULL
       
 
+# checking if extract_stats works for grouped plots
+
+    Code
+      p8 <- grouped_ggpiestats(mtcars, x = cyl, grouping.var = am)
+      extracted_data <- extract_stats(p8)
+      summary(extracted_data)
+    Output
+           Length Class             Mode
+      [1,] 7      ggstatsplot_stats list
+      [2,] 7      ggstatsplot_stats list
+    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")
+      
+

tests/testthat/_snaps/extract-stats.md

@@ -75,3 +75,23 @@ test_that(
     })
   }
 )
+
+
+test_that(
+  "checking if extract_stats works for grouped plots",
+  {
+    expect_snapshot({
+      p8 <- grouped_ggpiestats(mtcars, x = cyl, grouping.var = am)
+      extracted_data <- extract_stats(p8)
+      summary(extracted_data)
+      extract_subtitle(p8)
+    })
+  }
+)
+
+test_that(
+  "checking if extract_stats produces NULL on supported objects",
+  {
+    expect_length(purrr::compact(extract_stats(iris)), 0L)
+  }
+)