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

just a bit of additional theming

Browse source
This commit is contained in:
Andreas Gammelgaard Damsbo 2024-12-18 10:37:37 +01:00
commit 7877d95176
No known key found for this signature in database
9 changed files with 2795 additions and 27 deletions
Download patch file Download diff file Expand all files Collapse all files

59
R/regression_table.R
View file

@ -62,24 +62,53 @@
#' purrr::map(regression_table) |>
#' tbl_merge()
#' }
#' regression_table <- function(x, ...) {
#' UseMethod("regression_table")
#' }
#'
#' #' @rdname regression_table
#' #' @export
#' regression_table.list <- function(x, ...) {
#' x |>
#' purrr::map(\(.m){
#' regression_table(x = .m, ...) |>
#' gtsummary::add_n()
#' }) |>
#' gtsummary::tbl_stack()
#' }
#'
#' #' @rdname regression_table
#' #' @export
#' regression_table.default <- function(x, ..., args.list = NULL, fun = "gtsummary::tbl_regression") {
#' # Stripping custom class
#' class(x) <- class(x)[class(x) != "webresearch_model"]
#'
#' if (any(c(length(class(x)) != 1, class(x) != "lm"))) {
#' if (!"exponentiate" %in% names(args.list)) {
#' args.list <- c(args.list, list(exponentiate = TRUE))
#' }
#' }
#'
#' out <- do.call(getfun(fun), c(list(x = x), args.list))
#' out |>
#' gtsummary::add_glance_source_note() # |>
#' # gtsummary::bold_p()
#' }
regression_table <- function(x, ...) {
UseMethod("regression_table")
if ("list" %in% class(x)){
x |>
purrr::map(\(.m){
regression_table_create(x = .m, ...) |>
gtsummary::add_n()
}) |>
gtsummary::tbl_stack()
} else {
regression_table_create(x,...)
}
}
#' @rdname regression_table
#' @export
regression_table.list <- function(x, ...) {
x |>
purrr::map(\(.m){
regression_table(x = .m, ...) |>
gtsummary::add_n()
}) |>
gtsummary::tbl_stack()
}
#' @rdname regression_table
#' @export
regression_table.default <- function(x, ..., args.list = NULL, fun = "gtsummary::tbl_regression") {
regression_table_create <- function(x, ..., args.list = NULL, fun = "gtsummary::tbl_regression") {
# Stripping custom class
class(x) <- class(x)[class(x) != "webresearch_model"]