From fc646dd0d49968a9ddcd0899eb568aa305b24c2c Mon Sep 17 00:00:00 2001
From: Melkiades <davide.garolini@roche.com>
Date: Wed, 6 Sep 2023 09:15:29 +0200
Subject: [PATCH] final fix

---
 R/analyze_variables.R                         | 17 +++-
 R/compare_variables.R                         |  2 +-
 R/utils_defaults_handling.R                   | 10 +-
 .../_snaps/utils_defaults_handling.md         | 93 +++++++++++++++++++
 4 files changed, 111 insertions(+), 11 deletions(-)
 create mode 100644 tests/testthat/_snaps/utils_defaults_handling.md

diff --git a/R/analyze_variables.R b/R/analyze_variables.R
index df7e3e13a4..8bc3ca1d16 100644
--- a/R/analyze_variables.R
+++ b/R/analyze_variables.R
@@ -446,6 +446,18 @@ a_summary_internal <- function(x,
                                na.rm, # nolint
                                na_level,
                                ...) {
+  if (is.numeric(x)) {
+    type <- "numeric"
+    if (!is.null(.stats) && any(grepl("^pval", .stats))) {
+      .stats[grepl("^pval", .stats)] <- "pval" # tmp fix xxx
+    }
+  } else {
+    type <- "counts"
+    if (!is.null(.stats) && any(grepl("^pval", .stats))) {
+      .stats[grepl("^pval", .stats)] <- "pval_counts" # tmp fix xxx
+    }
+  }
+
   # If one col has NA vals, must add NA row to other cols (using placeholder lvl `fill-na-level`)
   if (any(is.na(.df_row[[.var]])) && !any(is.na(x)) && !na.rm) levels(x) <- c(levels(x), "fill-na-level")
 
@@ -557,11 +569,6 @@ a_summary <- function(x,
                       na.rm = TRUE, # nolint
                       na_level = NA_character_,
                       ...) {
-  type <- if (is.numeric(x)) {
-    "numeric"
-  } else {
-    "counts"
-  }
   a_summary_internal(
     x = x,
     .N_col = .N_col,
diff --git a/R/compare_variables.R b/R/compare_variables.R
index a1c71e674f..87284918cc 100644
--- a/R/compare_variables.R
+++ b/R/compare_variables.R
@@ -379,7 +379,7 @@ compare_vars <- function(lyt,
                          .formats = NULL,
                          .labels = NULL,
                          .indent_mods = NULL) {
-  .stats <- .stats[!grepl("pval", .stats)] # tmp fix xxx
+
   extra_args <- list(.stats = .stats, na.rm = na.rm, na_level = na_level, compare = TRUE, ...)
   if (!is.null(.formats)) extra_args[[".formats"]] <- .formats
   if (!is.null(.labels)) extra_args[[".labels"]] <- .labels
diff --git a/R/utils_defaults_handling.R b/R/utils_defaults_handling.R
index e232f4d387..e0799a488b 100644
--- a/R/utils_defaults_handling.R
+++ b/R/utils_defaults_handling.R
@@ -132,11 +132,6 @@ get_stats <- function(method_groups, type = NULL, stats_in = NULL, add_pval = FA
     add_pval <- TRUE
   }
 
-  # Filtering for stats_in (character vector)
-  if (!is.null(stats_in)) {
-    out <- intersect(stats_in, out) # It orders them too
-  }
-
   # Mainly used in "analyze_vars" but it could be necessary elsewhere
   if (isTRUE(add_pval)) {
     if (length(type) > 1) {
@@ -150,6 +145,11 @@ get_stats <- function(method_groups, type = NULL, stats_in = NULL, add_pval = FA
     }
   }
 
+  # Filtering for stats_in (character vector)
+  if (!is.null(stats_in)) {
+    out <- intersect(stats_in, out) # It orders them too
+  }
+
   # If intersect did not find matches (and no pval?) -> error
   if (length(out) == 0) {
     stop(
diff --git a/tests/testthat/_snaps/utils_defaults_handling.md b/tests/testthat/_snaps/utils_defaults_handling.md
new file mode 100644
index 0000000000..fbb0e857de
--- /dev/null
+++ b/tests/testthat/_snaps/utils_defaults_handling.md
@@ -0,0 +1,93 @@
+# get_stats works as expected for defaults
+
+    Code
+      res
+    Output
+      [1] "count"                   "count_fraction_fixed_dp"
+      [3] "fraction"               
+
+---
+
+    Code
+      res
+    Output
+      [1] "unique"       "nonunique"    "unique_count"
+
+---
+
+    Code
+      res
+    Output
+      [1] "n"              "count"          "count_fraction" "n_blq"         
+
+---
+
+    Code
+      res
+    Output
+       [1] "n"            "sum"          "mean"         "sd"           "se"          
+       [6] "mean_sd"      "mean_se"      "mean_ci"      "mean_sei"     "mean_sdi"    
+      [11] "mean_pval"    "median"       "mad"          "median_ci"    "quantiles"   
+      [16] "iqr"          "range"        "min"          "max"          "median_range"
+      [21] "cv"           "geom_mean"    "geom_mean_ci" "geom_cv"     
+
+# get_format_from_stats works as expected
+
+    Code
+      res
+    Output
+      $count
+      [1] "xx."
+      
+      $count_fraction_fixed_dp
+      function(x, ...) {
+        attr(x, "label") <- NULL
+      
+        if (any(is.na(x))) {
+          return("NA")
+        }
+      
+        checkmate::assert_vector(x)
+        checkmate::assert_integerish(x[1])
+        assert_proportion_value(x[2], include_boundaries = TRUE)
+      
+        result <- if (x[1] == 0) {
+          "0"
+        } else if (x[2] == 1) {
+          sprintf("%d (100%%)", x[1])
+        } else {
+          sprintf("%d (%.1f%%)", x[1], x[2] * 100)
+        }
+      
+        return(result)
+      }
+      <environment: namespace:tern>
+      
+      $fraction
+      function(x, ...) {
+        attr(x, "label") <- NULL
+        checkmate::assert_vector(x)
+        checkmate::assert_count(x["num"])
+        checkmate::assert_count(x["denom"])
+      
+        result <- if (x["num"] == 0) {
+          paste0(x["num"], "/", x["denom"])
+        } else {
+          paste0(
+            x["num"], "/", x["denom"],
+            " (", sprintf("%.1f", round(x["num"] / x["denom"] * 100, 1)), "%)"
+          )
+        }
+        return(result)
+      }
+      <environment: namespace:tern>
+      
+
+# get_label_from_stats works as expected
+
+    Code
+      res
+    Output
+                        count count_fraction_fixed_dp                fraction 
+                      "count"                      ""                      "" 
+