diff --git a/DESCRIPTION b/DESCRIPTION index 53889d677..893937f56 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -20,6 +20,7 @@ Imports: tidyr (>= 1.3.0) Suggests: broom (>= 1.0.5), + broom.helpers (>= 1.13.0), spelling, testthat (>= 3.2.0), withr diff --git a/NAMESPACE b/NAMESPACE index 46189dca2..d7655978d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,6 @@ # Generated by roxygen2: do not edit by hand +S3method(ard_regression,default) export("%>%") export(all_of) export(any_of) @@ -8,6 +9,7 @@ export(ard_fishertest) export(ard_paired_ttest) export(ard_paired_wilcoxtest) export(ard_proportion_ci) +export(ard_regression) export(ard_ttest) export(ard_wilcoxtest) export(contains) diff --git a/R/ard_regression.R b/R/ard_regression.R new file mode 100644 index 000000000..2b74bbbca --- /dev/null +++ b/R/ard_regression.R @@ -0,0 +1,81 @@ +#' Regression ARD +#' +#' Function takes a regression model object and converts it to a ARD +#' structure using the `broom.helpers` package. +#' +#' @param x regression model object +#' @param tidy_fun (`function`)\cr +#' a tidier. Default is [`broom.helpers::tidy_with_broom_or_parameters`] +#' @param ... Arguments passed to `broom.helpers::tidy_plus_plus()` +#' +#' @return data frame +#' @name ard_regression +#' +#' @examples +#' lm(AGE ~ ARM, data = cards::ADSL) |> +#' ard_regression(add_estimate_to_reference_rows = TRUE) +NULL + +#' @rdname ard_regression +#' @export +ard_regression <- function(x, ...) { + UseMethod("ard_regression") +} + +#' @rdname ard_regression +#' @export +ard_regression.default <- function(x, tidy_fun = broom.helpers::tidy_with_broom_or_parameters, ...) { + # check installed packages --------------------------------------------------- + cards::check_pkg_installed("broom.helpers", reference_pkg = "cards") + + # check inputs --------------------------------------------------------------- + check_not_missing(x, "model") + + # summarize model ------------------------------------------------------------ + broom.helpers::tidy_plus_plus( + model = x, + tidy_fun = tidy_fun, + ... + ) |> + dplyr::mutate( + variable_level = dplyr::if_else(.data$var_type %in% "continuous", NA_character_, .data$label), + dplyr::across(-c("variable", "variable_level"), .fns = as.list) + ) |> + tidyr::pivot_longer( + cols = -c("variable", "variable_level"), + names_to = "stat_name", + values_to = "statistic" + ) |> + dplyr::filter(map_lgl(.data$statistic, Negate(is.na))) |> + dplyr::mutate( + statistic_fmt_fn = + lapply( + .data$statistic, + function(x) { + switch(is.integer(x), 0L) %||% # styler: off + switch(is.numeric(x), 1L) # styler: off + } + ), + context = "regression", + stat_label = + dplyr::case_when( + .data$stat_name %in% "var_label" ~ "Label", + .data$stat_name %in% "var_class" ~ "Class", + .data$stat_name %in% "var_type" ~ "Type", + .data$stat_name %in% "var_nlevels" ~ "N Levels", + .data$stat_name %in% "contrasts_type" ~ "Contrast Type", + .data$stat_name %in% "label" ~ "Level Label", + .data$stat_name %in% "n_obs" ~ "N Obs.", + .data$stat_name %in% "n_event" ~ "N Events", + .data$stat_name %in% "exposure" ~ "Exposure Time", + .data$stat_name %in% "estimate" ~ "Coefficient", + .data$stat_name %in% "std.error" ~ "Standard Error", + .data$stat_name %in% "p.value" ~ "p-value", + .data$stat_name %in% "conf.low" ~ "CI Lower Bound", + .data$stat_name %in% "conf.high" ~ "CI Upper Bound", + TRUE ~ .data$stat_name + ) + ) |> + cards::tidy_ard_column_order() %>% + {structure(., class = c("card", class(.)))} # styler: off +} diff --git a/R/cardx-package.R b/R/cardx-package.R index 637bc249e..644703b55 100644 --- a/R/cardx-package.R +++ b/R/cardx-package.R @@ -5,3 +5,5 @@ ## usethis namespace: start ## usethis namespace: end NULL + +utils::globalVariables(c(".")) diff --git a/_pkgdown.yml b/_pkgdown.yml index 4dc2381d3..35ce4f4a5 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -24,11 +24,15 @@ reference: - title: "ARD Creation" - subtitle: "Inference" - contents: - - ard_ttest - - ard_fishertest - ard_chisqtest + - ard_fishertest + - ard_ttest - ard_wilcoxtest + + - subtitle: "Estimation" + - contents: - ard_proportion_ci + - ard_regression - title: "Helpers" - contents: diff --git a/man/ard_regression.Rd b/man/ard_regression.Rd new file mode 100644 index 000000000..1f6895cf0 --- /dev/null +++ b/man/ard_regression.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ard_regression.R +\name{ard_regression} +\alias{ard_regression} +\alias{ard_regression.default} +\title{Regression ARD} +\usage{ +ard_regression(x, ...) + +\method{ard_regression}{default}(x, tidy_fun = broom.helpers::tidy_with_broom_or_parameters, ...) +} +\arguments{ +\item{x}{regression model object} + +\item{...}{Arguments passed to \code{broom.helpers::tidy_plus_plus()}} + +\item{tidy_fun}{(\code{function})\cr +a tidier. Default is \code{\link[broom.helpers:tidy_with_broom_or_parameters]{broom.helpers::tidy_with_broom_or_parameters}}} +} +\value{ +data frame +} +\description{ +Function takes a regression model object and converts it to a ARD +structure using the \code{broom.helpers} package. +} +\examples{ +lm(AGE ~ ARM, data = cards::ADSL) |> + ard_regression(add_estimate_to_reference_rows = TRUE) +} diff --git a/tests/testthat/test-ard_regression.R b/tests/testthat/test-ard_regression.R new file mode 100644 index 000000000..c6ed8c548 --- /dev/null +++ b/tests/testthat/test-ard_regression.R @@ -0,0 +1,10 @@ +test_that("ard_regression() works", { + expect_snapshot( + lm(AGE ~ ARM, data = cards::ADSL) |> + ard_regression(add_estimate_to_reference_rows = TRUE) |> + dplyr::mutate( + statistic = lapply(statistic, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x)) + ) |> + as.data.frame() + ) +})