Merge pull request #99 from FredHutch/lemireg-add_quartiles-pairwise_test_cont

Adding median_quartiles to pairwise_test_cont()

Author: slager

NEWS.md

@@ -1,5 +1,9 @@
 # VISCfunctions (development version)
 
+* Add `Median_Quartiles` to `pairwise_test_cont()` output (#99)
+* Minor Changes:
+  * Update `Overview()` to include new `Median_Quartiles` (#99)
+
 # VISCfunctions 1.3.1
 
 * Report loaded and attached packages in package reproducibility table (#132)
@@ -67,7 +71,7 @@
 * New Functions:
   * `escape()` to easily make latex friendly columns with `\` in front of special characters
   * `wilson_ci()` function for Wilson Confident Intervals
-  * `pariwise_test_bin()` for pairwise binary testing comparisons (i.e. pairwise group differences in response rates)
+  * `pairwise_test_bin()` for pairwise binary testing comparisons (i.e. pairwise group differences in response rates)
 * Minor Changes:
   * Adding suffix param to `stat_paste()`. Now easy to add % or something else after each stat, if needed
   * Improved documentation and minor fixes to `two_samp_cont_test()`

R/pairwise_comparisons.R

@@ -262,6 +262,10 @@ pairwise_test_cont <- function(
           Group2_median = 10^stats::median(log10(j_vals), na.rm = T),
           Group1_max = max(i_vals, na.rm = T),
           Group2_max = max(j_vals, na.rm = T),
+          Group1_q1 = stats::quantile(i_vals, probs = c(.25), na.rm = T),
+          Group2_q1 = stats::quantile(j_vals, probs = c(.25), na.rm = T),
+          Group1_q3 = stats::quantile(i_vals, probs = c(.75), na.rm = T),
+          Group2_q3 = stats::quantile(j_vals, probs = c(.75), na.rm = T),
           Group1_mean = 10^mean(log10(i_vals), na.rm = T),
           Group2_mean = 10^mean(log10(j_vals), na.rm = T),
           Group1log_mean = mean(log10(i_vals), na.rm = T),
@@ -283,6 +287,10 @@ pairwise_test_cont <- function(
           Group2_max = max(j_vals, na.rm = T),
           Group1_mean = mean(i_vals, na.rm = T),
           Group2_mean = mean(j_vals, na.rm = T),
+          Group1_q1 = stats::quantile(i_vals, probs = c(.25), na.rm = T),
+          Group2_q1 = stats::quantile(j_vals, probs = c(.25), na.rm = T),
+          Group1_q3 = stats::quantile(i_vals, probs = c(.75), na.rm = T),
+          Group2_q3 = stats::quantile(j_vals, probs = c(.75), na.rm = T),
           Group1_sd = stats::sd(i_vals, na.rm = T),
           Group2_sd = stats::sd(j_vals, na.rm = T)
         )
@@ -328,10 +336,9 @@ pairwise_test_cont <- function(
   if (length(results_list) == 0) return(NULL)
 
   results <- do.call(base::rbind, results_list)
-
   # Pasting together stats
   pasted_results <- paste_tbl_grp(
-    data = results, vars_to_paste = c("n","median_min_max",'mean'),
+    data = results, vars_to_paste = c("n","median_min_max",'mean', "median_quartiles"),
     first_name = 'Group1', second_name = 'Group2', sep_val = sep_val,
     alternative = alternative, digits = digits, trailing_zeros = trailing_zeros,
     keep_all = TRUE, verbose = verbose)
@@ -358,6 +365,7 @@ pairwise_test_cont <- function(
         Comparison = pasted_results$Comparison,
         SampleSizes = pasted_results$n_comparison,
         Median_Min_Max = pasted_results$median_min_max_comparison,
+        Median_Quartiles = pasted_results$median_quartiles,
         Mean = pasted_results$mean_comparison,
         log_Mean_SD = pasted_results_extra$mean_sd_comparison,
         MagnitudeTest = results$MagnitudeTest,
@@ -383,6 +391,7 @@ pairwise_test_cont <- function(
         Comparison = pasted_results$Comparison,
         SampleSizes = pasted_results$n_comparison,
         Median_Min_Max = pasted_results$median_min_max_comparison,
+        Median_Quartiles = pasted_results$median_quartiles_comparison,
         Mean_SD = pasted_results_extra$mean_sd_comparison,
         MagnitudeTest = results$MagnitudeTest,
         PerfectSeparation = results$PerfectSeparation,
@@ -774,10 +783,9 @@ pairwise_test_bin <- function(x,
 #' exampleData_BAMA |>
 #' filter(visitno != 0) |>
 #' group_by(group, visitno) |>
-#'  summarize(
+#'  reframe(
 #'    cor_test_pairs(x = magnitude, pair = antigen, id = pubID,
-#'    method = 'spearman', n_distinct_value = 3, digits = 1, verbose = TRUE),
-#'    .groups = 'drop'
+#'    method = 'spearman', n_distinct_value = 3, digits = 1, verbose = TRUE)
 #'  )
 #'
 #' @export

R/pretty_output_functions.R

@@ -1,7 +1,7 @@
 #' Pasting Together Information for Two Groups
 #'
-#' Paste together information, often statistics, from two groups. There are two
-#' predefined combinations: mean(sd) and median\[min, max\], but user may also
+#' Paste together information, often statistics, from two groups. There are three
+#' predefined combinations: mean(sd) and median\[min, max\] and median\[first quartile, third quartile\], but user may also
 #' paste any single measure together.
 #'
 #'
@@ -32,7 +32,7 @@
 #' @param verbose a logical variable indicating if warnings and messages should be displayed. Default FALSE.
 #' @details
 #'
-#' User must use consistant naming throughout, with a underscore to separate the group names from the measures (i.e. `Group1_mean` and `Group2_mean`). There also must be columns defining the group names (i.e. `Group1` and `Group2`), which are used to form the `Comparison` variable.
+#' User must use consistent naming throughout, with a underscore to separate the group names from the measures (i.e. `Group1_mean` and `Group2_mean`). There also must be columns defining the group names (i.e. `Group1` and `Group2`), which are used to form the `Comparison` variable.
 #'
 #' `alternative` included as a parameter so the direction can easily be seen in one-sided test. If "two.sided" is selected the value to be pasted between the two group names will be set to `sep_val`, where "greater" will use " > " and "less" with use " < " as the pasting value.
 #'
@@ -137,6 +137,9 @@ paste_tbl_grp <- function(
         vars_to_paste_here <- c(vars_to_paste_here, 'median_min_max')
       if (sum(vars_to_paste_here %in% c('mean','sd')) == 2)
         vars_to_paste_here <- c(vars_to_paste_here, 'mean_sd')
+      if (sum(vars_to_paste_here %in% c('median','q1','q3')) == 3)
+        vars_to_paste_here <- c(vars_to_paste_here, 'median_quartiles')
+
 
       if (verbose) message('The following measures will be combined: ',
                            paste0(vars_to_paste_here, collapse = ', '))
@@ -151,11 +154,14 @@ paste_tbl_grp <- function(
 
   # Need to define which variables to check. Special considerations for the predefined values
   vars_to_check <- vars_to_paste_here[!vars_to_paste_here %in%
-                                        c('median_min_max','mean_sd')]
+                                        c('median_min_max','median_quartiles','mean_sd')]
   if (any(vars_to_paste_here == 'median_min_max'))
     vars_to_check <- unique(c(vars_to_check, 'median', 'min', 'max'))
   if (any(vars_to_paste_here == 'mean_sd'))
     vars_to_check <- unique(c(vars_to_check, 'mean', 'sd'))
+  if (any(vars_to_paste_here == 'median_quartiles'))
+    vars_to_check <- unique(c(vars_to_check, 'median', 'q1','q3'))
+
 
   # Need to check the group1 and group2 version of each variable being pasted
   group1_vars_to_check <- paste0(first_name, '_', vars_to_check)
@@ -223,7 +229,23 @@ paste_tbl_grp <- function(
                    trailing_zeros = trailing_zeros
         )
       )
-    } else {
+    } else if (vars_to_paste_here[i] == 'median_quartiles') {
+      pasted_results[[i]] <-  paste0(
+        stat_paste(stat1 = data_here[, paste0(first_name, '_median')],
+                   stat2 = data_here[, paste0(first_name, '_q1')],
+                   stat3 = data_here[, paste0(first_name, '_q3')],
+                   digits = digits, bound_char = '[', sep = ', ',
+                   na_str_out = na_str_out, trailing_zeros = trailing_zeros
+        ),
+        sep_val,
+        stat_paste(stat1 = data_here[, paste0(second_name, '_median')],
+                   stat2 = data_here[, paste0(second_name, '_q1')],
+                   stat3 = data_here[, paste0(second_name, '_q3')],
+                   digits = digits, bound_char = '[', sep = ', ',
+                   na_str_out = na_str_out, trailing_zeros = trailing_zeros
+        )
+      )
+      } else {
       first_var_here <- data_here[, paste0(first_name, '_', vars_to_paste_here[i])]
       second_var_here <- data_here[, paste0(second_name, '_', vars_to_paste_here[i])]
       both_var_here <- c(first_var_here, second_var_here)