2024-11-08 15:13:33 +01:00
|
|
|
#' Print a flexible baseline characteristics table
|
|
|
|
#'
|
|
|
|
#' @param data data set
|
|
|
|
#' @param fun.args list of arguments passed to
|
|
|
|
#' @param fun function to
|
|
|
|
#' @param vars character vector of variables to include
|
|
|
|
#'
|
|
|
|
#' @return object of standard class for fun
|
|
|
|
#' @export
|
|
|
|
#'
|
|
|
|
#' @examples
|
|
|
|
#' mtcars |> baseline_table()
|
|
|
|
#' mtcars |> baseline_table(fun.args = list(by = "gear"))
|
|
|
|
baseline_table <- function(data, fun.args = NULL, fun = gtsummary::tbl_summary, vars = NULL) {
|
|
|
|
if (!is.null(vars)) {
|
2024-11-21 12:34:27 +01:00
|
|
|
data <- data |> dplyr::select(dplyr::all_of(vars))
|
2024-11-08 15:13:33 +01:00
|
|
|
}
|
|
|
|
|
|
|
|
out <- do.call(fun, c(list(data = data), fun.args))
|
|
|
|
return(out)
|
|
|
|
}
|
|
|
|
|
2025-03-24 14:40:30 +01:00
|
|
|
|
|
|
|
|
|
|
|
#' Create a baseline table
|
|
|
|
#'
|
|
|
|
#' @param data data
|
|
|
|
#' @param ... passed as fun.arg to baseline_table()
|
|
|
|
#' @param strat.var grouping/strat variable
|
|
|
|
#' @param add.p add comparison/p-value
|
|
|
|
#' @param add.overall add overall column
|
|
|
|
#'
|
|
|
|
#' @returns gtsummary table list object
|
|
|
|
#' @export
|
|
|
|
#'
|
|
|
|
#' @examples
|
2025-04-02 11:31:04 +02:00
|
|
|
#' mtcars |> create_baseline(by.var = "gear", add.p = "yes" == "yes")
|
|
|
|
create_baseline <- function(data, ..., by.var, add.p = FALSE, add.overall = FALSE, theme=c("jama", "lancet", "nejm", "qjecon")) {
|
|
|
|
theme <- match.arg(theme)
|
|
|
|
|
2025-03-24 14:40:30 +01:00
|
|
|
if (by.var == "none" | !by.var %in% names(data)) {
|
|
|
|
by.var <- NULL
|
|
|
|
}
|
|
|
|
|
|
|
|
## These steps are to handle logicals/booleans, that messes up the order of columns
|
2025-04-02 11:31:04 +02:00
|
|
|
## Has been reported and should be fixed soon (02042025)
|
2025-03-24 14:40:30 +01:00
|
|
|
|
|
|
|
if (!is.null(by.var)) {
|
2025-04-02 11:31:04 +02:00
|
|
|
if (identical("logical", class(data[[by.var]]))) {
|
2025-03-24 14:40:30 +01:00
|
|
|
data[by.var] <- as.character(data[[by.var]])
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2025-04-02 11:31:04 +02:00
|
|
|
gtsummary::theme_gtsummary_journal(journal = theme)
|
|
|
|
|
2025-03-24 14:40:30 +01:00
|
|
|
out <- data |>
|
|
|
|
baseline_table(
|
|
|
|
fun.args =
|
|
|
|
list(
|
|
|
|
by = by.var,
|
|
|
|
...
|
|
|
|
)
|
|
|
|
)
|
|
|
|
|
|
|
|
if (!is.null(by.var)) {
|
2025-04-02 11:31:04 +02:00
|
|
|
if (isTRUE(add.overall)) {
|
|
|
|
out <- out |> gtsummary::add_overall()
|
2025-03-24 14:40:30 +01:00
|
|
|
}
|
|
|
|
if (isTRUE(add.p)) {
|
|
|
|
out <- out |>
|
|
|
|
gtsummary::add_p() |>
|
|
|
|
gtsummary::bold_p()
|
|
|
|
}
|
2025-04-02 11:31:04 +02:00
|
|
|
}
|
2025-03-24 14:40:30 +01:00
|
|
|
|
|
|
|
out
|
|
|
|
}
|