forked from ddsjoberg/gtsummary
-
Notifications
You must be signed in to change notification settings - Fork 0
/
tests.R
163 lines (163 loc) · 6.48 KB
/
tests.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
#' Tests/methods available in `add_p()` and `add_difference()`
#'
#' @description Below is a listing of tests available internally within gtsummary.
#'
#' Tests listed with `...` may have additional arguments
#' passed to them using `add_p(test.args=)`. For example, to
#' calculate a p-value from `t.test()` assuming equal variance, use
#' `tbl_summary(trial, by = trt) %>% add_p(age ~ "t.test", test.args = age ~ list(var.equal = TRUE))`
#'
#' @name tests
#' @keywords internal
#' @section tbl_summary() %>% add_p():
#'
#' ```{r, echo = FALSE}
#' options(knitr.kable.NA = '')
#' remove_na_details_column <- function(data) {
#' if (all(is.na(data[["**details**"]]))) return(dplyr::select(data, -`**details**`))
#' data
#' }
#'
#' gtsummary:::df_add_p_tests %>%
#' dplyr::filter(class == "tbl_summary", add_p == TRUE) %>%
#' dplyr::mutate(test_name = shQuote(test_name) %>% {stringr::str_glue('`{.}`')}) %>%
#' select(`**alias**` = test_name,
#' `**description**` = description,
#' `**pseudo-code**` = pseudo_code,
#' `**details**` = details) %>%
#' remove_na_details_column() %>%
#' knitr::kable()
#' ```
#'
#' @section tbl_svysummary() %>% add_p():
#'
#' ```{r, echo = FALSE}
#' gtsummary:::df_add_p_tests %>%
#' dplyr::filter(class == "tbl_svysummary", add_p == TRUE) %>%
#' dplyr::mutate(test_name = shQuote(test_name) %>% {stringr::str_glue('`{.}`')}) %>%
#' select(`**alias**` = test_name,
#' `**description**` = description,
#' `**pseudo-code**` = pseudo_code,
#' `**details**` = details) %>%
#' remove_na_details_column() %>%
#' knitr::kable()
#' ```
#'
#' @section tbl_survfit() %>% add_p():
#'
#' ```{r, echo = FALSE}
#' gtsummary:::df_add_p_tests %>%
#' dplyr::filter(class == "tbl_survfit", add_p == TRUE) %>%
#' dplyr::mutate(test_name = shQuote(test_name) %>% {stringr::str_glue('`{.}`')}) %>%
#' select(`**alias**` = test_name,
#' `**description**` = description,
#' `**pseudo-code**` = pseudo_code,
#' `**details**` = details) %>%
#' remove_na_details_column() %>%
#' knitr::kable()
#' ```
#'
#' @section tbl_continuous() %>% add_p():
#'
#' ```{r, echo = FALSE}
#' gtsummary:::df_add_p_tests %>%
#' dplyr::filter(class == "tbl_continuous", add_p == TRUE) %>%
#' dplyr::mutate(test_name = shQuote(test_name) %>% {stringr::str_glue('`{.}`')}) %>%
#' select(`**alias**` = test_name,
#' `**description**` = description,
#' `**pseudo-code**` = pseudo_code,
#' `**details**` = details) %>%
#' remove_na_details_column() %>%
#' knitr::kable()
#' ```
#'
#' @section tbl_summary() %>% add_difference():
#'
#' ```{r, echo = FALSE}
#' gtsummary:::df_add_p_tests %>%
#' dplyr::filter(class == "tbl_summary", add_difference == TRUE) %>%
#' dplyr::mutate(test_name = shQuote(test_name) %>% {stringr::str_glue('`{.}`')}) %>%
#' select(`**alias**` = test_name,
#' `**description**` = description,
#' `**difference statistic**` = diff_statistic,
#' `**pseudo-code**` = pseudo_code,
#' `**details**` = details) %>%
#' remove_na_details_column() %>%
#' knitr::kable()
#' ```
#'
#' @section tbl_svysummary() %>% add_difference():
#'
#' ```{r, echo = FALSE}
#' gtsummary:::df_add_p_tests %>%
#' dplyr::filter(class == "tbl_svysummary", add_difference == TRUE) %>%
#' dplyr::mutate(test_name = shQuote(test_name) %>% {stringr::str_glue('`{.}`')}) %>%
#' select(`**alias**` = test_name,
#' `**description**` = description,
#' `**difference statistic**` = diff_statistic,
#' `**pseudo-code**` = pseudo_code,
#' `**details**` = details) %>%
#' remove_na_details_column() %>%
#' knitr::kable()
#' ```
#'
#' @section Custom Functions:
#'
#' To report a p-value (or difference) for a test not available in gtsummary, you can create a
#' custom function. The output is a data frame that is one line long. The
#' structure is similar to the output of `broom::tidy()` of a typical
#' statistical test. The `add_p()` and `add_comparison()` functions will look for columns called
#' `"p.value"`, `"estimate"`, `"conf.low"`, `"conf.high"`, and `"method"` for the
#' p-value, difference, confidence interval, and the test name used in the footnote.
#'
#' Example calculating a p-value from a t-test assuming a common variance
#' between groups.
#'
#' ```r
#' ttest_common_variance <- function(data, variable, by, ...) {
#' data <- data[c(variable, by)] %>% dplyr::filter(complete.cases(.))
#' t.test(data[[variable]] ~ factor(data[[by]]), var.equal = TRUE) %>%
#' broom::tidy()
#' }
#'
#' trial[c("age", "trt")] %>%
#' tbl_summary(by = trt) %>%
#' add_p(test = age ~ "ttest_common_variance")
#' ```
#'
#' A custom `add_difference()` is similar, and accepts arguments `conf.level=`
#' and `adj.vars=` as well.
#'
#' ```r
#' ttest_common_variance <- function(data, variable, by, conf.level, ...) {
#' data <- data[c(variable, by)] %>% dplyr::filter(complete.cases(.))
#' t.test(data[[variable]] ~ factor(data[[by]]), conf.level = conf.level, var.equal = TRUE) %>%
#' broom::tidy()
#' }
#' ```
#'
#' ### Function Arguments
#'
#' For `tbl_summary()` objects, the custom function will be passed the
#' following arguments: `custom_pvalue_fun(data=, variable=, by=, group=, type=, conf.level=, adj.vars=)`.
#' While your function may not utilize each of these arguments, these arguments
#' are passed and the function must accept them. We recommend including `...`
#' to future-proof against updates where additional arguments are added.
#'
#' The following table describes the argument inputs for each gtsummary table type.
#'
#' ```{r, echo = FALSE}
#' tibble::tribble(
#' ~`**argument**`, ~`**tbl_summary**`, ~`**tbl_svysummary**`, ~`**tbl_survfit**`, ~`**tbl_continuous**`,
#' "`data=`", "A data frame", "A survey object", "A `survfit()` object", "A data frame",
#' "`variable=`", "String variable name", "String variable name", "`NA`", "String variable name",
#' "`by=`", "String variable name", "String variable name", "`NA`", "String variable name",
#' "`group=`", "String variable name", "`NA`", "`NA`", "String variable name",
#' "`type=`", "Summary type", "Summary type", "`NA`", "`NA`",
#' "`conf.level=`", "Confidence interval level", "`NA`", "`NA`", "`NA`",
#' "`adj.vars=`", "Character vector of adjustment variable names (e.g. used in ANCOVA)", "`NA`", "`NA`", "Character vector of adjustment variable names (e.g. used in ANCOVA)",
#' "`continuous_variable=`", "`NA`", "`NA`", "`NA`", "String of the continuous variable name"
#' ) %>%
#' knitr::kable()
#' ```
NULL