Don't remove all-NA columns; retain NAs in labels (#226)

* Don't remove all-NA columns Closes IndrajeetPatil/ggstatsplot#833 * don't remove NAs from labels Closes #176 * Apply automatic changes * Update print.R * suppress messages in docs Co-authored-by: IndrajeetPatil <[email protected]>
IndrajeetPatil · Jan 14, 2023 · 0722e36 · 0722e36
1 parent 4e4f573
commit 0722e36
Show file tree

Hide file tree

Showing 21 changed files with 107 additions and 65 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -5,6 +5,13 @@ NEW FEATURES
 - All returned data frames from `{statsExpressions}` get a new
   `statsExpressions` class and a print method for this class.
 
+MINOR CHANGES
+
+- `tidy_model_parameters()` no longer removes columns which contain only missing
+  values.
+
+- Wilcox tests no longer provide exact *p*-values.
+
 # statsExpressions 1.3.6
 
 - Maintenance release.

diff --git a/R/add_expression_col.R b/R/add_expression_col.R
@@ -166,12 +166,15 @@ add_expression_col <- function(data,
 .data_to_char <- function(data, k = 2L, k.df = 0L, k.df.error = 0L) {
   data %>%
     mutate(
-      across(.fns = ~ format_value(.x, k), .cols = matches("^est|^sta|p.value|.scale$|.low$|.high$|^log")),
-      across(.fns = ~ format_value(.x, k.df), .cols = matches("^df$")),
-      across(.fns = ~ format_value(.x, k.df.error), .cols = matches("^df.error$")),
+      across(.fns = ~ .to_char(.x, k), .cols = matches("^est|^sta|p.value|.scale$|.low$|.high$|^log")),
+      across(.fns = ~ .to_char(.x, k.df), .cols = matches("^df$")),
+      across(.fns = ~ .to_char(.x, k.df.error), .cols = matches("^df.error$")),
       across(.fns = ~ paste0(.x * 100, "%"), .cols = matches("^conf.level$"))
     )
 }
 
 #' @noRd
 .prettyNum <- function(x) prettyNum(x, big.mark = ",", scientific = FALSE)
+
+#' @noRd
+.to_char <- function(x, digits = 2L) format_value(x, digits, missing = "NA")
diff --git a/R/helpers_easystats.R b/R/helpers_easystats.R
@@ -10,7 +10,7 @@
 tidy_model_parameters <- function(model, ...) {
   stats_df <- model_parameters(model, verbose = FALSE, ...) %>%
     mutate(conf.method = . %@% "ci_method") %>%
-    select(where(~ !all(is.na(.x))), -matches("Difference")) %>% # remove columns where all rows are NAs
+    select(-matches("Difference")) %>%
     standardize_names(style = "broom") %>%
     rename_all(~ gsub("cramers.", "", .x)) %>%
     rename_all(.funs = recode, "bayes.factor" = "bf10") %>%

diff --git a/R/oneway_anova.R b/R/oneway_anova.R
@@ -45,7 +45,7 @@
 #' # for reproducibility
 #' set.seed(123)
 #' library(statsExpressions)
-#' library(afex) # for within-subjects parametric ANOVA
+#' suppressPackageStartupMessages(library(afex)) # for within-subjects parametric ANOVA
 #'
 #' # ----------------------- parametric -------------------------------------
 #'

diff --git a/R/print.R b/R/print.R
@@ -1,16 +1,8 @@
 #' @export
 print.statsExpressions <- function(x, ...) {
   withr::with_options(
-    list(
-      tibble.width      = Inf,
-      pillar.bold       = TRUE,
-      pillar.neg        = TRUE,
-      pillar.subtle_num = TRUE,
-      pillar.min_chars  = Inf
-    ),
-    code = {
-      NextMethod()
-    }
+    list(pillar.width = Inf, pillar.bold = TRUE, pillar.subtle_num = TRUE),
+    NextMethod()
   )
 
   invisible(x)

diff --git a/R/tidy_model_expressions.R b/R/tidy_model_expressions.R
@@ -59,7 +59,7 @@ tidy_model_expressions <- function(data,
   if (statistic == "t") {
     df %<>% mutate(
       expression = case_when(
-        df.error %in% c("", "Inf") ~ glue("list({es.text}=='{estimate}', italic(t)=='{statistic}', italic(p)=='{p.value}')"),
+        df.error %in% c("NA", "Inf") ~ glue("list({es.text}=='{estimate}', italic(t)=='{statistic}', italic(p)=='{p.value}')"),
         TRUE ~ glue("list({es.text}=='{estimate}', italic(t)('{df.error}')=='{statistic}', italic(p)=='{p.value}')")
       )
     )

diff --git a/R/two_sample_test.R b/R/two_sample_test.R
@@ -24,7 +24,7 @@
 #' ```{r child="man/rmd-fragments/return.Rmd"}
 #' ```
 #'
-#' @examples identical(Sys.getenv("NOT_CRAN"), "true")
+#' @examplesIf identical(Sys.getenv("NOT_CRAN"), "true")
 #' # for reproducibility
 #' set.seed(123)
 #' library(statsExpressions)

diff --git a/man/contingency_table.Rd b/man/contingency_table.Rd
diff --git a/man/corr_test.Rd b/man/corr_test.Rd
diff --git a/man/meta_analysis.Rd b/man/meta_analysis.Rd
diff --git a/man/one_sample_test.Rd b/man/one_sample_test.Rd
diff --git a/man/oneway_anova.Rd b/man/oneway_anova.Rd
diff --git a/man/pairwise_comparisons.Rd b/man/pairwise_comparisons.Rd
diff --git a/man/rmd-fragments/return.Rmd b/man/rmd-fragments/return.Rmd
@@ -30,6 +30,4 @@ The returned tibble data frame can contain some or all of the following columns
 
   - `expression`: pre-formatted expression containing statistical details
 
-For examples of dataframe outputs, see examples and [this vignette](https://indrajeetpatil.github.io/statsExpressions/articles/web_only/dataframe_outputs.html).
-
-Note that all examples are preceded by `set.seed()` calls for reproducibility.
+For examples, see [data frame output vignette](https://indrajeetpatil.github.io/statsExpressions/articles/web_only/dataframe_outputs.html).
diff --git a/man/two_sample_test.Rd b/man/two_sample_test.Rd
diff --git a/tests/testthat/_snaps/meta_random_bayes.md b/tests/testthat/_snaps/meta_random_bayes.md
@@ -3,23 +3,23 @@
     Code
       dplyr::select(df, -expression)
     Output
-      # A tibble: 2 x 16
+      # A tibble: 2 x 19
         term    effectsize                       estimate std.error conf.level
         <chr>   <chr>                               <dbl>     <dbl>      <dbl>
       1 Overall meta-analytic posterior estimate   -0.650     0.222       0.95
       2 tau     meta-analytic posterior estimate    0.486     0.184       0.95
-        conf.low conf.high  bf10 component prior.distribution prior.location
-           <dbl>     <dbl> <dbl> <chr>     <chr>                       <dbl>
-      1   -1.12     -0.251  53.0 meta      Student's t                     0
-      2    0.205     0.917  53.0 meta      Inverse gamma                   1
-        prior.scale method                                 conf.method log_e_bf10
-              <dbl> <chr>                                  <chr>            <dbl>
-      1       0.707 Bayesian meta-analysis using 'metaBMA' ETI               3.97
-      2       0.15  Bayesian meta-analysis using 'metaBMA' ETI               3.97
-        n.obs
-        <int>
-      1    16
-      2    16
+        conf.low conf.high weight  bf10  rhat   ess component prior.distribution
+           <dbl>     <dbl>  <dbl> <dbl> <dbl> <dbl> <chr>     <chr>             
+      1   -1.12     -0.251     NA  53.0    NA    NA meta      Student's t       
+      2    0.205     0.917     NA  53.0    NA    NA meta      Inverse gamma     
+        prior.location prior.scale method                                 conf.method
+                 <dbl>       <dbl> <chr>                                  <chr>      
+      1              0       0.707 Bayesian meta-analysis using 'metaBMA' ETI        
+      2              1       0.15  Bayesian meta-analysis using 'metaBMA' ETI        
+        log_e_bf10 n.obs
+             <dbl> <int>
+      1       3.97    16
+      2       3.97    16
 
 ---
 

diff --git a/tests/testthat/_snaps/meta_random_parametric.md b/tests/testthat/_snaps/meta_random_parametric.md
@@ -3,13 +3,16 @@
     Code
       select(df, -expression)
     Output
-      # A tibble: 1 x 12
+      # A tibble: 1 x 13
         term    effectsize                     estimate std.error conf.level conf.low
         <chr>   <chr>                             <dbl>     <dbl>      <dbl>    <dbl>
       1 Overall meta-analytic summary estimate   -0.767     0.212       0.95    -1.18
-        conf.high statistic  p.value method                        conf.method n.obs
-            <dbl>     <dbl>    <dbl> <chr>                         <chr>       <int>
-      1    -0.351     -3.62 0.000295 Meta-analysis using 'metafor' Wald           16
+        conf.high statistic  p.value weight method                        conf.method
+            <dbl>     <dbl>    <dbl>  <dbl> <chr>                         <chr>      
+      1    -0.351     -3.62 0.000295     NA Meta-analysis using 'metafor' Wald       
+        n.obs
+        <int>
+      1    16
 
 ---
 

diff --git a/tests/testthat/_snaps/meta_random_robust.md b/tests/testthat/_snaps/meta_random_robust.md
@@ -3,13 +3,13 @@
     Code
       select(df, -expression)
     Output
-      # A tibble: 1 x 12
+      # A tibble: 1 x 13
         term    effectsize                     estimate std.error conf.low conf.high
         <chr>   <chr>                             <dbl>     <dbl>    <dbl>     <dbl>
       1 Overall meta-analytic summary estimate   -0.746     0.234    -1.26    -0.343
-        statistic  p.value conf.level method                               
-            <dbl>    <dbl>      <dbl> <chr>                                
-      1     -3.20 0.000501       0.95 Robust meta-analysis using 'metaplus'
+        statistic  p.value weight conf.level method                               
+            <dbl>    <dbl>  <dbl>      <dbl> <chr>                                
+      1     -3.20 0.000501     NA       0.95 Robust meta-analysis using 'metaplus'
         conf.method n.obs
         <chr>       <int>
       1 Wald           16

diff --git a/tests/testthat/_snaps/oneway_anova_robust.md b/tests/testthat/_snaps/oneway_anova_robust.md
@@ -90,3 +90,33 @@
           italic("n")["pairs"] == "88")
       
 
+---
+
+    Code
+      select(df2, -expression)
+    Output
+      # A tibble: 1 x 11
+        statistic    df df.error p.value
+            <dbl> <dbl>    <dbl>   <dbl>
+      1      22.1     1        3  0.0182
+        method                                                             
+        <chr>                                                              
+      1 A heteroscedastic one-way repeated measures ANOVA for trimmed means
+        effectsize                                                      estimate
+        <chr>                                                              <dbl>
+      1 Algina-Keselman-Penfield robust standardized difference average     -Inf
+        conf.level conf.low conf.high n.obs
+             <dbl>    <dbl>     <dbl> <int>
+      1       0.95     -Inf       NaN     4
+
+---
+
+    Code
+      df2[["expression"]]
+    Output
+      [[1]]
+      list(italic("F")["trimmed-means"](1, 3) == "22.09", italic(p) == 
+          "0.02", widehat(delta)["R-avg"]^"AKP" == "-Inf", CI["95%"] ~ 
+          "[" * "-Inf", "NA" * "]", italic("n")["pairs"] == "4")
+      
+
diff --git a/tests/testthat/test-oneway_anova_robust.R b/tests/testthat/test-oneway_anova_robust.R
@@ -55,5 +55,27 @@ test_that(
     set.seed(123)
     expect_snapshot(select(df1, -expression))
     expect_snapshot(df1[["expression"]])
+
+    # edge case with few cases
+
+    dat <- tibble(
+      cases = c(1, 1, 2, 2, 3, 3, 4, 4),
+      groups = c("b", "a", "b", "a", "b", "a", "b", "a"),
+      values = c(2, 5, 3, 4, 4, 6, 5, 8)
+    )
+
+    set.seed(123)
+    df2 <- oneway_anova(
+      data = dat,
+      x = groups,
+      y = values,
+      type = "r",
+      conf.level = 0.99,
+      paired = TRUE
+    )
+
+    set.seed(123)
+    expect_snapshot(select(df2, -expression))
+    expect_snapshot(df2[["expression"]])
   }
 )
diff --git a/vignettes/web_only/dataframe_outputs.Rmd b/vignettes/web_only/dataframe_outputs.Rmd
@@ -215,7 +215,7 @@ two_sample_test(
 
 ```{r}
 #| label = "anova_w"
-library(afex)
+suppressPackageStartupMessages(library(afex))
 
 # ----------------------- parametric ---------------------------------------