andreas/FreesearchR
1
0
Fork 0
mirror of https://github.com/agdamsbo/FreesearchR.git synced 2026-06-19 04:27:30 +02:00
Code Issues Projects Releases Packages Wiki Activity

chore: prepare baseline table for an even more compact version without empty levels in categorical

Browse source
This commit is contained in:
Andreas Gammelgaard Damsbo 2026-03-30 20:18:10 +02:00
commit 163cbffeaf
No known key found for this signature in database
2 changed files with 30 additions and 21 deletions
Download patch file Download diff file Expand all files Collapse all files

48
R/baseline_table.R
View file

@ -11,7 +11,10 @@
#' @examples #' @examples
#' mtcars |> baseline_table() #' mtcars |> baseline_table()
#' mtcars |> baseline_table(fun.args = list(by = "gear")) #' mtcars |> baseline_table(fun.args = list(by = "gear"))
baseline_table <- function(data, fun.args = NULL, fun = gtsummary::tbl_summary, vars = NULL) { baseline_table <- function(data,
fun.args = NULL,
fun = gtsummary::tbl_summary,
vars = NULL) {
out <- do.call(fun, c(list(data = data), fun.args)) out <- do.call(fun, c(list(data = data), fun.args))
return(out) return(out)
} }
@ -37,7 +40,15 @@ baseline_table <- function(data, fun.args = NULL, fun = gtsummary::tbl_summary,
#' mtcars |> create_baseline(by.var = "gear", detail_level = "extended",type = list(gtsummary::all_dichotomous() ~ "categorical"),theme="nejm") #' mtcars |> create_baseline(by.var = "gear", detail_level = "extended",type = list(gtsummary::all_dichotomous() ~ "categorical"),theme="nejm")
#' #'
#' create_baseline(default_parsing(mtcars), by.var = "am", add.p = FALSE, add.overall = FALSE, theme = "lancet") #' create_baseline(default_parsing(mtcars), by.var = "am", add.p = FALSE, add.overall = FALSE, theme = "lancet")
create_baseline <- function(data, ..., by.var, add.p = FALSE, add.diff=FALSE, add.overall = FALSE, theme = c("jama", "lancet", "nejm", "qjecon"), detail_level = c("minimal", "extended")) { create_baseline <- function(data,
...,
by.var,
add.p = FALSE,
add.diff = FALSE,
add.overall = FALSE,
theme = c("jama", "lancet", "nejm", "qjecon"),
detail_level = c("minimal", "extended"),
drop_empty = FALSE) {
theme <- match.arg(theme) theme <- match.arg(theme)
detail_level <- match.arg(detail_level) detail_level <- match.arg(detail_level)
@ -64,31 +75,28 @@ create_baseline <- function(data, ..., by.var, add.p = FALSE, add.diff=FALSE, ad
if (!any(hasName(args, c("type", "statistic")))) { if (!any(hasName(args, c("type", "statistic")))) {
if (detail_level == "extended") { if (detail_level == "extended") {
args <- args <-
modifyList( modifyList(args, list(
args, type = list(
list( gtsummary::all_continuous() ~ "continuous2",
type = list(gtsummary::all_continuous() ~ "continuous2", gtsummary::all_dichotomous() ~ "categorical"
gtsummary::all_dichotomous() ~ "categorical"), ),
statistic = list(gtsummary::all_continuous() ~ c( statistic = list(
"{median} ({p25}, {p75})", gtsummary::all_continuous() ~ c("{median} ({p25}, {p75})", "{mean} ({sd})", "{min}, {max}")
"{mean} ({sd})",
"{min}, {max}"))
) )
) ))
} }
} }
parameters <- list( if (isTRUE(drop_empty)) {
data = data, ## Drops empty levels if minimal
fun.args = purrr::list_flatten(list(by = by.var, args)) data <- data |> REDCapCAST::fct_drop()
) }
parameters <- list(data = data, fun.args = purrr::list_flatten(list(by = by.var, args)))
# browser() # browser()
out <- do.call( out <- do.call(baseline_table, parameters)
baseline_table,
parameters
)
if (!is.null(by.var)) { if (!is.null(by.var)) {

3
man/create_baseline.Rd
View file

@ -12,7 +12,8 @@ create_baseline(
add.diff = FALSE, add.diff = FALSE,
add.overall = FALSE, add.overall = FALSE,
theme = c("jama", "lancet", "nejm", "qjecon"), theme = c("jama", "lancet", "nejm", "qjecon"),
detail_level = c("minimal", "extended") detail_level = c("minimal", "extended"),
drop_empty = FALSE
) )
} }
\arguments{ \arguments{