Add argument 'as_spss' to 'significance_cpct' (issue #100)

R/custom_tables_significance.R

@@ -21,7 +21,9 @@ tab_significance_options = function(data,
                                     digits = get_expss_digits(),
                                     na_as_zero = FALSE,
                                     var_equal = FALSE,
-                                    mode = c("replace", "append")){
+                                    mode = c("replace", "append"),
+                                    as_spss = FALSE
+                                    ){
     data = check_class(data)
     sig_options = match.call()[-2]
     sig_options[[1]] = quote(list)
@@ -57,6 +59,7 @@ tab_last_sig_cpct = function(data,
                              total_marker = "#",
                              total_row = 1,
                              digits = get_expss_digits(),
+                             as_spss = FALSE,
                              mode = c("replace", "append"),
                              label = NULL
 ){

R/significance_cpct.R

@@ -135,7 +135,9 @@ KEEP_STAT = c("percent", "cases", "means", "bases", "sd", "none")
 #' @param var_equal a logical variable indicating whether to treat the two
 #'   variances as being equal. For details see \link[stats]{t.test}.
 #' @param digits an integer indicating how much digits after decimal separator 
-#'   will be shown in the final table.
+#' @param as_spss a logical. FALSE by default. If TRUE, proportions which
+#'   are equal to zero or one will be ignored. Also will be ignored categories
+#'   with bases less than 2.
 #' @param data data.frame/intermediate_table for \code{tab_*} functions.
 #' @param mode character. One of \code{replace}(default) or \code{append}. In
 #'   the first case the previous result in the sequence of table calculation
@@ -268,7 +270,8 @@ significance_cpct = function(x,
                              na_as_zero = FALSE,
                              total_marker = "#",
                              total_row = 1,
-                             digits = get_expss_digits()
+                             digits = get_expss_digits(),
+                             as_spss = FALSE
                              ){
     UseMethod("significance_cpct")
 }
@@ -290,7 +293,8 @@ significance_cpct.etable = function(x,
                                     na_as_zero = FALSE,
                                     total_marker = "#",
                                     total_row = 1,
-                                    digits = get_expss_digits()
+                                    digits = get_expss_digits(),
+                                    as_spss = FALSE
 ){
 
 
@@ -304,6 +308,10 @@ significance_cpct.etable = function(x,
     keep = match.arg(keep, KEEP_STAT, several.ok = TRUE)
     keep_percent = "percent" %in% keep
     keep_bases = "bases" %in% keep
+    if(as_spss) {
+        min_base = max(min_base, 2)
+        na_as_zero = FALSE
+    }
     if(NCOL(x)>1){
         groups = header_groups(colnames(x))
         if("subtable" %in% compare_type){
@@ -326,6 +334,9 @@ significance_cpct.etable = function(x,
             if(na_as_zero){
                 if_na(curr_props[,-1]) = 0
             }
+            if(as_spss){
+                recode(curr_props[,-1]) = list(c(0, 1) ~ NA)
+            }
             if(any(c("first_column", "adjusted_first_column") %in% compare_type)){
                 sig_section = section_sig_first_column(sig_section = sig_section, 
                                                        curr_props = curr_props, 

tests/testthat/test_significance_cpct.R

@@ -495,4 +495,27 @@ if(isTRUE(getOption("covr"))) {
         significance_cpct(mtcars_table5), "rds/signif_cpct38.rds",  update = FALSE)
 
 
+    context("significance_cpct issue #100")
+    expss_digits(0)
+    target = c(65.5, 34.5)*10
+    odd_df = data.frame(
+        a = c(rep(1:2, times = target), rep(2:1, times = target), rep(1, sum(target)), rep(1:2, times = c(1, sum(target)-1)), 1), 
+        b = rep(1:5, times = c(sum(target), sum(target), sum(target), sum(target), 1))
+    )
+    expss_round_half_to_even(TRUE)
+    res = as.data.frame(cross_cpct(odd_df, a, b) %>% significance_cpct(digits = 0, min_base = 0))
+    expect_equal(trimws(res[2,2]), "34")
+    expect_equal(trimws(res[1,4]), "100 A B D")
+    expect_equal(trimws(res[1,6]), "100 D")
+
+    expss_round_half_to_even(FALSE)
+    res = as.data.frame(cross_cpct(odd_df, a, b) %>% significance_cpct(digits = 0, min_base = 0, as_spss = TRUE))
+    expect_equal(trimws(res[2,2]), "35")
+    expect_equal(trimws(res[1,4]), "100")
+    expect_equal(trimws(res[1,6]), "100")
+
+    expss_round_half_to_even(TRUE)
+
+
+
 }