mirror of
https://github.com/agdamsbo/FreesearchR.git
synced 2025-09-12 09:59:39 +02:00
97 lines
3.1 KiB
R
97 lines
3.1 KiB
R
#' Print a flexible baseline characteristics table
|
|
#'
|
|
#' @param data data set
|
|
#' @param fun Name of function as character vector or function to use for model creation.
|
|
#' @param vars character vector of variables to include
|
|
#' @param outcome.str Name of outcome variable. Character vector.
|
|
#' @param auto.mode Make assumptions on function dependent on outcome data format.
|
|
#' @param formula.str Formula as string. Passed through 'glue::glue'. If given, 'outcome.str' and 'vars' are ignored. Optional.
|
|
#' @param args.list List of arguments passed to 'fun' with 'do.call'.
|
|
#'
|
|
#' @importFrom stats as.formula
|
|
#'
|
|
#' @return object of standard class for fun
|
|
#' @export
|
|
#'
|
|
#' @examples
|
|
#' gtsummary::trial |>
|
|
#' regression_model(outcome.str = "age")
|
|
#' gtsummary::trial |>
|
|
#' regression_model(
|
|
#' outcome.str = "age",
|
|
#' fun = "stats::lm",
|
|
#' formula.str = "{outcome.str}~.",
|
|
#' args.list = NULL
|
|
#' )
|
|
#' gtsummary::trial |> regression_model(
|
|
#' outcome.str = "trt",
|
|
#' fun = "stats::glm",
|
|
#' args.list = list(family = binomial(link = "logit"))
|
|
#' )
|
|
regression_model <- function(data,
|
|
outcome.str,
|
|
auto.mode = TRUE,
|
|
formula.str = NULL,
|
|
args.list = NULL,
|
|
fun = NULL,
|
|
vars = NULL) {
|
|
if (!is.null(formula.str) | formula.str != "") {
|
|
formula.str <- glue::glue(formula.str)
|
|
} else {
|
|
assertthat::assert_that(outcome.str %in% names(data),
|
|
msg = "Outcome variable is not present in the provided dataset"
|
|
)
|
|
formula.str <- glue::glue("{outcome.str}~.")
|
|
|
|
if (!is.null(vars)) {
|
|
if (outcome.str %in% vars) {
|
|
vars <- vars[vars %in% outcome.str]
|
|
}
|
|
data <- data |> dplyr::select(dplyr::all_of(c(vars, outcome.str)))
|
|
}
|
|
}
|
|
|
|
# Formatting character variables as factor
|
|
# Improvement should add a missing vector to format as NA
|
|
data <- data |> dplyr::mutate(dplyr::across(dplyr::where(is.character), as.factor))
|
|
|
|
# browser()
|
|
if (auto.mode) {
|
|
if (is.numeric(data[[outcome.str]])) {
|
|
fun <- "stats::lm"
|
|
} else if (is.factor(data[[outcome.str]])) {
|
|
if (length(levels(data[[outcome.str]])) == 2) {
|
|
fun <- "stats::glm"
|
|
args.list <- list(family = binomial(link = "logit"))
|
|
} else if (length(levels(data[[outcome.str]])) > 2) {
|
|
fun <- "MASS::polr"
|
|
args.list <- list(
|
|
Hess = TRUE,
|
|
method = "logistic"
|
|
)
|
|
} else {
|
|
stop("The provided output variable only has one level")
|
|
}
|
|
} else {
|
|
stop("Output variable should be either numeric or factor for auto.mode")
|
|
}
|
|
}
|
|
|
|
assertthat::assert_that("character" %in% class(fun),
|
|
msg = "Please provide the function as a character vector."
|
|
)
|
|
|
|
out <- do.call(
|
|
getfun(fun),
|
|
c(
|
|
list(data = data),
|
|
list(formula = as.formula(formula.str)),
|
|
args.list
|
|
)
|
|
)
|
|
|
|
# Recreating the call
|
|
# out$call <- match.call(definition=eval(parse(text=fun)), call(fun, data = 'data',formula = as.formula(formula.str),args.list))
|
|
|
|
return(out)
|
|
}
|