Test with NAs; Add completeness summary

R/table1_numeric.R

@@ -10,6 +10,7 @@
 #' @param range A \code{logical} scalar: Compute Range?
 #' @param quantiles A \code{vector} of \code{numeric} values: Quantiles to
 #' compute
+#' @param completeness A \code{logical} scalar: Compute completeness?
 #' @param na.rm \code{logical} scalar: Remove \code{NA} values?
 #' @param quantile_type A \code{numeric} scalar, indicating the method of
 #' computing quantiles with [stats::quantile()].
@@ -22,7 +23,7 @@
 #'
 #' @examples
 #' table1_numeric(
-#'   x = 1:100,
+#'   x = c(1:100, NA),
 #'   quantiles = c(0.05, 0.95)
 #' )
 
@@ -33,7 +34,8 @@ table1_numeric <-
     median_iqr = TRUE,
     range = TRUE,
     quantiles = NULL,
-    na.rm = FALSE,
+    completeness = TRUE,
+    na.rm = TRUE,
     quantile_type = 7,
     digits = 2
   ){
@@ -126,5 +128,16 @@ table1_numeric <-
         c(results, q_result)
     }
 
+    if(completeness){
+      results <-
+        c(results,
+          `Complete (N%)` =
+            sprintf("%s (%s%%)",
+                    sum(!is.na(x)),
+                    round(x = (100*mean(!is.na(x))), digits = digits)
+            )
+        )
+    }
+
     return(results)
   }

R/table1_pvalue.R

@@ -32,7 +32,51 @@
 #' @export
 #'
 #' @examples
-#' # To be added
+#'
+#' set.seed(12345)
+#' n_obs <- 200
+#'
+#' jfbr_test <-
+#'   data.frame(
+#'     numbers = 1:n_obs,
+#'     continuous = runif(n = n_obs),
+#'     binary = rbinom(n = n_obs, size = 1, prob = 0.5),
+#'     binary_factor =
+#'       factor(
+#'         x = rbinom(n = n_obs, size = 1, prob = 0.5),
+#'         levels = 0:1,
+#'         labels = c("0. No", "1. Yes")
+#'       ),
+#'     categorical = factor(sample(x = 1:4, size = n_obs, replace = TRUE)),
+#'     ordered = ordered(sample(x = 1:4, size = n_obs, replace = TRUE))
+#'   )
+#'
+#'
+#' table1::table1(
+#'   x = ~ numbers + continuous + binary + ordered | categorical,
+#'   data = jfbr_test,
+#'   overall = FALSE,
+#'   extra.col =
+#'     list("p-value" = table1_pvalue)
+#' )
+#'
+#' table1::table1(
+#'   x = ~ numbers + continuous + binary + ordered | binary_factor,
+#'   data = jfbr_test,
+#'   overall = FALSE,
+#'   extra.col =
+#'     list("p-value" =
+#'            function(x, value) table1_pvalue(
+#'              x = x,
+#'              variable = variable,
+#'              test_numeric_2_levels = wilcox.test,
+#'              test_numeric_more_than_2_levels = kruskal.test,
+#'              test_categorical_2_levels = fisher.test,
+#'              test_categorical_more_than_2_levels = fisher.test
+#'            )
+#'     )
+#' )
+
 
 table1_pvalue <-
   function(

README.Rmd

@@ -32,7 +32,9 @@ devtools::install_github("jbetz-jhu/jfbr")
 ```
 
 
-## Examples: Tabulation
+## Examples: 
+
+### Tabulation {.tabset}
 
 Convenience functions have been added for the `table1::table1()` function to make it easier to do different summaries and add hypothesis testing.
 
@@ -64,6 +66,11 @@ library(table1)
 library(knitr)
 ```
 
+
+
+
+#### `table1()`: Default
+
 The default for `table1::table1()` is to produce Mean (SD) and Median [Min, Max]. Note: saving the result of `table1::table1()` and using `knitr::kable()`is only necessary when HTML output is not possible:
 
 ```{r table1-Defaults}
@@ -77,6 +84,11 @@ my_table <-
 kable(my_table)
 ```
 
+
+
+
+#### `table1()` + `table1_numeric`
+
 Using the argument `render.continuous = table1_numeric` adds Median [IQR] and [Max, Min]:
 
 ```{r table1-table1_numeric-Default}
@@ -127,6 +139,10 @@ kable(my_table)
 ```
 
 
+
+
+#### `table1()` + `table1_pvalue`
+
 Hypothesis tests can be added to `table1` using the `extra.col` argument: there is a worked example of including `t.test` and `chisq.test` in the [table1 documentation](https://cran.r-project.org/web/packages/table1/vignettes/table1-examples.html#example-a-column-of-p-values). The `table1_pvalue` function is a convenience function that allows users to supply their own tests to be computed in `table1`. The defaults include `t.test` and ANOVA omnibus test (via a `lm` and `anova` wrapper) for continuous variables, and `chisq.test` for categorical variables:
 
 ```{r table1-pvalues-defaults}

README.md

@@ -113,10 +113,12 @@ kable(my_table)
 | Mean (SD)      | 0.51 (0.29)     | 0.52 (0.28)     | 0.51 (0.28)    |
 | Median \[IQR\] | 0.51 (0.29)     | 0.53 (0.28)     | 0.52 (0.28)    |
 | \[Min, Max\]   | \[0, 1\]        | \[0, 0.99\]     | \[0, 1\]       |
+| Complete (N%)  | 503 (100%)      | 497 (100%)      | 1000 (100%)    |
 | numbers        |                 |                 |                |
 | Mean (SD)      | 492.08 (289.16) | 509.02 (288.52) | 500.5 (288.82) |
 | Median \[IQR\] | 490 (289.16)    | 509 (288.52)    | 500.5 (288.82) |
 | \[Min, Max\]   | \[5, 1000\]     | \[1, 999\]      | \[1, 1000\]    |
+| Complete (N%)  | 503 (100%)      | 497 (100%)      | 1000 (100%)    |
 
 The arguments `mean_sd`, `median_iqr`, and `range` control which
 summaries are computed. Quantiles can be added optionally with the
@@ -140,13 +142,15 @@ my_table <-
 kable(my_table)
 ```
 
-|            | 0\. No          | 1\. Yes         | Overall        |
-|:-----------|:----------------|:----------------|:---------------|
-|            | (N=503)         | (N=497)         | (N=1000)       |
-| continuous |                 |                 |                |
-| Mean (SD)  | 0.51 (0.29)     | 0.52 (0.28)     | 0.51 (0.28)    |
-| numbers    |                 |                 |                |
-| Mean (SD)  | 492.08 (289.16) | 509.02 (288.52) | 500.5 (288.82) |
+|               | 0\. No          | 1\. Yes         | Overall        |
+|:--------------|:----------------|:----------------|:---------------|
+|               | (N=503)         | (N=497)         | (N=1000)       |
+| continuous    |                 |                 |                |
+| Mean (SD)     | 0.51 (0.29)     | 0.52 (0.28)     | 0.51 (0.28)    |
+| Complete (N%) | 503 (100%)      | 497 (100%)      | 1000 (100%)    |
+| numbers       |                 |                 |                |
+| Mean (SD)     | 492.08 (289.16) | 509.02 (288.52) | 500.5 (288.82) |
+| Complete (N%) | 503 (100%)      | 497 (100%)      | 1000 (100%)    |
 
 ``` r
 
@@ -167,15 +171,17 @@ my_table <-
 kable(my_table)
 ```
 
-|            | 0\. No          | 1\. Yes         | Overall        |
-|:-----------|:----------------|:----------------|:---------------|
-|            | (N=503)         | (N=497)         | (N=1000)       |
-| continuous |                 |                 |                |
-| Mean (SD)  | 0.51 (0.29)     | 0.52 (0.28)     | 0.51 (0.28)    |
-| 5%, 95%    | 0.04, 0.94      | 0.06, 0.95      | 0.05, 0.94     |
-| numbers    |                 |                 |                |
-| Mean (SD)  | 492.08 (289.16) | 509.02 (288.52) | 500.5 (288.82) |
-| 5%, 95%    | 52.3, 948.9     | 50.6, 950.2     | 50.95, 950.05  |
+|               | 0\. No          | 1\. Yes         | Overall        |
+|:--------------|:----------------|:----------------|:---------------|
+|               | (N=503)         | (N=497)         | (N=1000)       |
+| continuous    |                 |                 |                |
+| Mean (SD)     | 0.51 (0.29)     | 0.52 (0.28)     | 0.51 (0.28)    |
+| 5%, 95%       | 0.04, 0.94      | 0.06, 0.95      | 0.05, 0.94     |
+| Complete (N%) | 503 (100%)      | 497 (100%)      | 1000 (100%)    |
+| numbers       |                 |                 |                |
+| Mean (SD)     | 492.08 (289.16) | 509.02 (288.52) | 500.5 (288.82) |
+| 5%, 95%       | 52.3, 948.9     | 50.6, 950.2     | 50.95, 950.05  |
+| Complete (N%) | 503 (100%)      | 497 (100%)      | 1000 (100%)    |
 
 #### `table1()` + `table1_pvalue`
 

tests/testthat/helper-data.R

@@ -7,12 +7,19 @@ jfbr_test <-
     numbers = 1:n_obs,
     continuous = runif(n = n_obs),
     binary = rbinom(n = n_obs, size = 1, prob = 0.5),
+    ordered = ordered(sample(x = 1:4, size = n_obs, replace = TRUE)),
     binary_factor =
       factor(
         x = rbinom(n = n_obs, size = 1, prob = 0.5),
         levels = 0:1,
         labels = c("0. No", "1. Yes")
       ),
-    categorical = factor(sample(x = 1:4, size = n_obs, replace = TRUE)),
-    ordered = ordered(sample(x = 1:4, size = n_obs, replace = TRUE))
+    categorical = factor(sample(x = 1:4, size = n_obs, replace = TRUE))
   )
+
+# Add missing value to each column
+missing_cols <- c("numbers", "continuous", "binary", "ordered")
+jfbr_test[
+  cbind(sample(x = 1:n_obs, size = length(missing_cols), replace = TRUE),
+    which(names(jfbr_test) %in% missing_cols))
+] <- NA

tests/testthat/test-table1_numeric.R

@@ -1,3 +1,38 @@
+test_that(
+  desc = "table1_numeric error handling works",
+  code = {
+    expect_error(
+      object =
+        table1_numeric(
+          x = 0:100,
+          mean_sd = TRUE,
+          median_iqr = TRUE,
+          range = TRUE,
+          quantiles = c(-2, 3),
+          na.rm = FALSE,
+          quantile_type = 4,
+          digits = 2
+        ),
+      regexp = "Quantiles must be numeric values in range"
+    )
+
+    expect_error(
+      object =
+        table1_numeric(
+          x = 0:100,
+          mean_sd = TRUE,
+          median_iqr = TRUE,
+          range = TRUE,
+          quantiles = c(0.05, NA, 0.95),
+          na.rm = FALSE,
+          quantile_type = 4,
+          digits = 2
+        ),
+      regexp = "Quantiles must be numeric values in range"
+    )
+  }
+)
+
 test_that(
   desc = "table1_numeric works in isolation",
   code = {
@@ -28,7 +63,7 @@ test_that(
     expect_no_condition(
       object =
         table1(
-          x = ~ continuous | binary_factor,
+          x = ~ continuous + numbers | binary_factor,
           data = jfbr_test,
           render.continuous = table1_numeric
         )
@@ -37,7 +72,7 @@ test_that(
     expect_no_condition(
       object =
         table1(
-          x = ~ continuous | binary_factor,
+          x = ~ continuous + numbers | binary_factor,
           data = jfbr_test,
           render.continuous =
             function(x) table1_numeric(x = x, quantiles = c(0.05, 0.95))
@@ -47,7 +82,7 @@ test_that(
     expect_error(
       object =
         table1(
-          x = ~ continuous | binary_factor,
+          x = ~ continuous + numbers | binary_factor,
           data = jfbr_test,
           render.continuous =
             function(x) table1_numeric(