Skip to content

Commit

Permalink
Moved the new function to its own script
Browse files Browse the repository at this point in the history
  • Loading branch information
@ddsjoberg
ddsjoberg committed Mar 1, 2024
1 parent 474a3ee commit 54e4eaa
Show file tree
Hide file tree
Showing 8 changed files with 162 additions and 155 deletions.
43 changes: 1 addition & 42 deletions R/ard_regression.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6,7 +6,7 @@
#' @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()`
#' @param ... Arguments passed to [`broom.helpers::tidy_plus_plus()`]
#'
#' @return data frame
#' @name ard_regression
Expand Down Expand Up @@ -79,44 +79,3 @@ ard_regression.default <- function(x, tidy_fun = broom.helpers::tidy_with_broom_
cards::tidy_ard_column_order() %>%
{structure(., class = c("card", class(.)))} # styler: off
}

#' Basic Regression ARD
#'
#' @description
#' A function that takes a regression model and provides basic statistics in an
#' ARD structure.
#' The default output is simpler than `ard_regression()`.
#' The function primarily matches regression terms to underlying variable names.
#'
#' @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_basic
#' @export
#'
#' @examples
#' lm(AGE ~ ARM, data = cards::ADSL) |>
#' ard_regression_basic()
#'
ard_regression_basic <- 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)

args <-
list(
add_reference_rows = FALSE,
add_estimate_to_reference_rows = FALSE,
add_n = FALSE,
intercept = FALSE
) |>
utils::modifyList(val = rlang::dots_list(...))

rlang::inject(ard_regression(x = x, tidy_fun = tidy_fun, !!!args)) |>
dplyr::filter(!.data$stat_name %in% c("term", "var_type", "var_label", "var_class", "label"))
}
55 changes: 55 additions & 0 deletions R/ard_regression_basic.R
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,55 @@
#' Basic Regression ARD
#'
#' @description
#' A function that takes a regression model and provides basic statistics in an
#' ARD structure.
#' The default output is simpler than [`ard_regression()`].
#' The function primarily matches regression terms to underlying variable names
#' and levels.
#' The default arguments used are
#'
#' ```r
#' broom.helpers::tidy_plus_plus(
#' add_reference_rows = FALSE,
#' add_estimate_to_reference_rows = FALSE,
#' add_n = FALSE,
#' intercept = FALSE
#' )
#' ```
#'
#' @inheritParams ard_regression
#' @param stats_to_remove (`character`)\cr
#' character vector of statistic names to remove. Default is
#' `c("term", "var_type", "var_label", "var_class", "label", "contrasts_type", "contrasts", "var_nlevels")`.
#'
#' @return data frame
#' @name ard_regression_basic
#' @export
#'
#' @examples
#' lm(AGE ~ ARM, data = cards::ADSL) |>
#' ard_regression_basic()
ard_regression_basic <- function(x, tidy_fun = broom.helpers::tidy_with_broom_or_parameters,
stats_to_remove = c("term", "var_type", "var_label", "var_class",
"label", "contrasts_type", "contrasts", "var_nlevels"),
...) {
# check installed packages ---------------------------------------------------
cards::check_pkg_installed("broom.helpers", reference_pkg = "cards")

# check inputs ---------------------------------------------------------------
check_not_missing(x)
check_class(stats_to_remove, cls = "character", allow_empty = TRUE)
if (is_empty(stats_to_remove)) stats_to_remove <- character(0L) # styler: off

args <-
list(
add_reference_rows = FALSE,
add_estimate_to_reference_rows = FALSE,
add_n = FALSE,
intercept = FALSE
) |>
utils::modifyList(val = rlang::dots_list(...))

rlang::inject(ard_regression(x = x, tidy_fun = tidy_fun, !!!args)) |>
dplyr::filter(!.data$stat_name %in% stats_to_remove)
}
2 changes: 1 addition & 1 deletion man/ard_regression.Rd
View file

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

25 changes: 20 additions & 5 deletions man/ard_regression_basic.Rd
View file

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

142 changes: 47 additions & 95 deletions tests/testthat/_snaps/ard_regression.md
View file
Original file line number Diff line number Diff line change
@@ -1,100 +1,52 @@
# ard_regression() works

Code
print(dplyr::mutate(ard_regression(lm(AGE ~ ARM, data = cards::ADSL),
add_estimate_to_reference_rows = TRUE), stat = lapply(stat, function(x) ifelse(
is.numeric(x), cards::round5(x, 3), x))), n = Inf)
Message
{cards} data frame: 43 x 7
dplyr::mutate(dplyr::select(as.data.frame(ard_regression(lm(AGE ~ ARM, data = cards::ADSL),
add_estimate_to_reference_rows = TRUE)), -context, -stat_label, -fmt_fn), stat = lapply(
stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x)))
Output
variable variable_level context stat_name stat_label stat
1 ARM Placebo regressi… term term ARMPlace…
2 ARM Placebo regressi… var_label Label Descript…
3 ARM Placebo regressi… var_class Class character
4 ARM Placebo regressi… var_type Type categori…
5 ARM Placebo regressi… var_nlevels N Levels 3
6 ARM Placebo regressi… contrasts contrasts contr.tr…
7 ARM Placebo regressi… contrasts_type Contrast… treatment
8 ARM Placebo regressi… reference_row referenc… TRUE
9 ARM Placebo regressi… label Level La… Placebo
10 ARM Placebo regressi… n_obs N Obs. 86
11 ARM Placebo regressi… estimate Coeffici… 0
12 ARM Xanomeli… regressi… term term ARMXanom…
13 ARM Xanomeli… regressi… var_label Label Descript…
14 ARM Xanomeli… regressi… var_class Class character
15 ARM Xanomeli… regressi… var_type Type categori…
16 ARM Xanomeli… regressi… var_nlevels N Levels 3
17 ARM Xanomeli… regressi… contrasts contrasts contr.tr…
18 ARM Xanomeli… regressi… contrasts_type Contrast… treatment
19 ARM Xanomeli… regressi… reference_row referenc… FALSE
20 ARM Xanomeli… regressi… label Level La… Xanomeli…
21 ARM Xanomeli… regressi… n_obs N Obs. 84
22 ARM Xanomeli… regressi… estimate Coeffici… -0.828
23 ARM Xanomeli… regressi… std.error Standard… 1.267
24 ARM Xanomeli… regressi… statistic statistic -0.654
25 ARM Xanomeli… regressi… p.value p-value 0.514
26 ARM Xanomeli… regressi… conf.low CI Lower… -3.324
27 ARM Xanomeli… regressi… conf.high CI Upper… 1.668
28 ARM Xanomeli… regressi… term term ARMXanom…
29 ARM Xanomeli… regressi… var_label Label Descript…
30 ARM Xanomeli… regressi… var_class Class character
31 ARM Xanomeli… regressi… var_type Type categori…
32 ARM Xanomeli… regressi… var_nlevels N Levels 3
33 ARM Xanomeli… regressi… contrasts contrasts contr.tr…
34 ARM Xanomeli… regressi… contrasts_type Contrast… treatment
35 ARM Xanomeli… regressi… reference_row referenc… FALSE
36 ARM Xanomeli… regressi… label Level La… Xanomeli…
37 ARM Xanomeli… regressi… n_obs N Obs. 84
38 ARM Xanomeli… regressi… estimate Coeffici… 0.457
39 ARM Xanomeli… regressi… std.error Standard… 1.267
40 ARM Xanomeli… regressi… statistic statistic 0.361
41 ARM Xanomeli… regressi… p.value p-value 0.719
42 ARM Xanomeli… regressi… conf.low CI Lower… -2.039
43 ARM Xanomeli… regressi… conf.high CI Upper… 2.953
Message
i 1 more variable: fmt_fn

# ard_regression_basic() works

Code
as.data.frame(ard_regression_basic(lm(AGE ~ ARM, data = cards::ADSL)))
Output
variable variable_level context stat_name stat_label
1 ARM Xanomeline High Dose regression var_nlevels N Levels
2 ARM Xanomeline High Dose regression contrasts contrasts
3 ARM Xanomeline High Dose regression contrasts_type Contrast Type
4 ARM Xanomeline High Dose regression estimate Coefficient
5 ARM Xanomeline High Dose regression std.error Standard Error
6 ARM Xanomeline High Dose regression statistic statistic
7 ARM Xanomeline High Dose regression p.value p-value
8 ARM Xanomeline High Dose regression conf.low CI Lower Bound
9 ARM Xanomeline High Dose regression conf.high CI Upper Bound
10 ARM Xanomeline Low Dose regression var_nlevels N Levels
11 ARM Xanomeline Low Dose regression contrasts contrasts
12 ARM Xanomeline Low Dose regression contrasts_type Contrast Type
13 ARM Xanomeline Low Dose regression estimate Coefficient
14 ARM Xanomeline Low Dose regression std.error Standard Error
15 ARM Xanomeline Low Dose regression statistic statistic
16 ARM Xanomeline Low Dose regression p.value p-value
17 ARM Xanomeline Low Dose regression conf.low CI Lower Bound
18 ARM Xanomeline Low Dose regression conf.high CI Upper Bound
stat fmt_fn
1 3 0
2 contr.treatment NULL
3 treatment NULL
4 -0.8283499 1
5 1.267394 1
6 -0.653585 1
7 0.5139775 1
8 -3.324433 1
9 1.667733 1
10 3 0
11 contr.treatment NULL
12 treatment NULL
13 0.4573643 1
14 1.267394 1
15 0.3608698 1
16 0.7185003 1
17 -2.038718 1
18 2.953447 1
variable variable_level stat_name stat
1 ARM Placebo term ARMPlacebo
2 ARM Placebo var_label Description of Planned Arm
3 ARM Placebo var_class character
4 ARM Placebo var_type categorical
5 ARM Placebo var_nlevels 3
6 ARM Placebo contrasts contr.treatment
7 ARM Placebo contrasts_type treatment
8 ARM Placebo reference_row TRUE
9 ARM Placebo label Placebo
10 ARM Placebo n_obs 86
11 ARM Placebo estimate 0
12 ARM Xanomeline High Dose term ARMXanomeline High Dose
13 ARM Xanomeline High Dose var_label Description of Planned Arm
14 ARM Xanomeline High Dose var_class character
15 ARM Xanomeline High Dose var_type categorical
16 ARM Xanomeline High Dose var_nlevels 3
17 ARM Xanomeline High Dose contrasts contr.treatment
18 ARM Xanomeline High Dose contrasts_type treatment
19 ARM Xanomeline High Dose reference_row FALSE
20 ARM Xanomeline High Dose label Xanomeline High Dose
21 ARM Xanomeline High Dose n_obs 84
22 ARM Xanomeline High Dose estimate -0.828
23 ARM Xanomeline High Dose std.error 1.267
24 ARM Xanomeline High Dose statistic -0.654
25 ARM Xanomeline High Dose p.value 0.514
26 ARM Xanomeline High Dose conf.low -3.324
27 ARM Xanomeline High Dose conf.high 1.668
28 ARM Xanomeline Low Dose term ARMXanomeline Low Dose
29 ARM Xanomeline Low Dose var_label Description of Planned Arm
30 ARM Xanomeline Low Dose var_class character
31 ARM Xanomeline Low Dose var_type categorical
32 ARM Xanomeline Low Dose var_nlevels 3
33 ARM Xanomeline Low Dose contrasts contr.treatment
34 ARM Xanomeline Low Dose contrasts_type treatment
35 ARM Xanomeline Low Dose reference_row FALSE
36 ARM Xanomeline Low Dose label Xanomeline Low Dose
37 ARM Xanomeline Low Dose n_obs 84
38 ARM Xanomeline Low Dose estimate 0.457
39 ARM Xanomeline Low Dose std.error 1.267
40 ARM Xanomeline Low Dose statistic 0.361
41 ARM Xanomeline Low Dose p.value 0.719
42 ARM Xanomeline Low Dose conf.low -2.039
43 ARM Xanomeline Low Dose conf.high 2.953

19 changes: 19 additions & 0 deletions tests/testthat/_snaps/ard_regression_basic.md
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,19 @@
# ard_regression_basic() works

Code
dplyr::select(as.data.frame(ard), -fmt_fn)
Output
variable variable_level context stat_name stat_label stat
1 ARM Xanomeline High Dose regression estimate Coefficient -0.8283499
2 ARM Xanomeline High Dose regression std.error Standard Error 1.267394
3 ARM Xanomeline High Dose regression statistic statistic -0.653585
4 ARM Xanomeline High Dose regression p.value p-value 0.5139775
5 ARM Xanomeline High Dose regression conf.low CI Lower Bound -3.324433
6 ARM Xanomeline High Dose regression conf.high CI Upper Bound 1.667733
7 ARM Xanomeline Low Dose regression estimate Coefficient 0.4573643
8 ARM Xanomeline Low Dose regression std.error Standard Error 1.267394
9 ARM Xanomeline Low Dose regression statistic statistic 0.3608698
10 ARM Xanomeline Low Dose regression p.value p-value 0.7185003
11 ARM Xanomeline Low Dose regression conf.low CI Lower Bound -2.038718
12 ARM Xanomeline Low Dose regression conf.high CI Upper Bound 2.953447

22 changes: 10 additions & 12 deletions tests/testthat/test-ard_regression.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,21 +2,19 @@ test_that("ard_regression() works", {
expect_snapshot(
lm(AGE ~ ARM, data = cards::ADSL) |>
ard_regression(add_estimate_to_reference_rows = TRUE) |>
as.data.frame() |>
dplyr::select(-context, -stat_label, -fmt_fn) |>
dplyr::mutate(
stat = lapply(stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x))
) |>
print(n = Inf)
)
)
})

test_that("ard_regression_basic() works", {
expect_error(
lm(AGE ~ ARM, data = cards::ADSL) |>
ard_regression_basic(),
NA
# checking non-syntactic names
expect_equal(
lm(AGE ~ `Treatment Arm`, data = cards::ADSL |> dplyr::rename(`Treatment Arm` = ARM)) |>
ard_regression(add_estimate_to_reference_rows = TRUE) |>
dplyr::pull(variable) |>
unique(),
"Treatment Arm"
)

expect_snapshot(lm(AGE ~ ARM, data = cards::ADSL) |>
ard_regression_basic() |>
as.data.frame())
})
9 changes: 9 additions & 0 deletions tests/testthat/test-ard_regression_basic.R
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,9 @@
test_that("ard_regression_basic() works", {
expect_error(
ard <- lm(AGE ~ ARM, data = cards::ADSL) |>
ard_regression_basic(),
NA
)

expect_snapshot(as.data.frame(ard) |> dplyr::select(-fmt_fn))
})

0 comments on commit 54e4eaa

Please sign in to comment.