Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Add warning and error columns to ard_regression() output #195

Merged
merged 13 commits into from
Aug 21, 2024
Merged

Add warning and error columns to ard_regression() output #195

Show file tree
Hide file tree
Changes from 7 commits
Commits
Show all changes
13 commits
Select commit Hold shift + click to select a range
d1d8d86
Refactor `ard_regression` to include warning and error columns
edelarua Aug 12, 2024
c069a04
Update tests
edelarua Aug 12, 2024
df6c0c6
Update snaps
edelarua Aug 12, 2024
2b0267f
Update text
edelarua Aug 13, 2024
40b2a43
Update test
edelarua Aug 13, 2024
0a7acda
Merge branch 'main' into 148_warn_error_regression@main
edelarua Aug 20, 2024
147cffc
Merge branch 'main' into 148_warn_error_regression@main
edelarua Aug 20, 2024
e4796a4
Merge branch 'main' into 148_warn_error_regression@main
edelarua Aug 21, 2024
c02b60a
Use withr for local options
edelarua Aug 21, 2024
68ab394
Use cards::as_card()
edelarua Aug 21, 2024
084e0de
Last options fix
edelarua Aug 21, 2024
b8860a8
Update NEWS
edelarua Aug 21, 2024
0ec71d7
Update required cards version to use cards::as_card()
edelarua Aug 21, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
117 changes: 75 additions & 42 deletions R/ard_regression.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -34,51 +34,84 @@ ard_regression.default <- function(x, tidy_fun = broom.helpers::tidy_with_broom_
check_not_missing(x)

# summarize model ------------------------------------------------------------
broom.helpers::tidy_plus_plus(
model = x,
tidy_fun = tidy_fun,
...
) |>
lst_results <- cards::eval_capture_conditions(
broom.helpers::tidy_plus_plus(
model = x,
tidy_fun = tidy_fun,
...
)
)

# final tidying up of cards data frame ---------------------------------------
.regression_final_ard_prep(lst_results)
}

.regression_final_ard_prep <- function(lst_results) {
# saving the results in data frame -------------------------------------------
df_card <-
if (!is.null(lst_results[["result"]])) {
lst_results[["result"]] |>
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 = "stat"
) |>
dplyr::filter(map_lgl(.data$stat, Negate(is.na))) |>
dplyr::select(-(cards::all_ard_variables("levels") & dplyr::where(\(x) all(is.na(x)))))
} else { # if there was an error return a shell of an ARD data frame
dplyr::tibble(
variable = "model_1",
stat_name = "estimate",
stat = list(NULL)
)
}

# final tidying up of ARD data frame ---------------------------------------
df_card |>
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)
warning = lst_results["warning"],
error = lst_results["error"],
fmt_fn = lapply(
.data$stat,
function(x) {
switch(is.integer(x),
0L
) %||% switch(is.numeric(x),
1L
)
}
),
context = "regression"
) |>
tidyr::pivot_longer(
cols = -c("variable", "variable_level"),
names_to = "stat_name",
values_to = "stat"
) |>
dplyr::filter(map_lgl(.data$stat, Negate(is.na))) |>
dplyr::select(-(cards::all_ard_variables("levels") & dplyr::where(\(x) all(is.na(x))))) |>
dplyr::mutate(
fmt_fn =
lapply(
.data$stat,
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
)
dplyr::left_join(
.df_regression_stat_labels(),
by = "stat_name"
) |>
dplyr::mutate(stat_label = dplyr::coalesce(.data$stat_label, .data$stat_name)) |>
cards::tidy_ard_column_order() %>%
{structure(., class = c("card", class(.)))} # styler: off
}

.df_regression_stat_labels <- function() {
dplyr::tribble(
~stat_name, ~stat_label,
"var_label", "Label",
"var_class", "Class",
"var_type", "Type",
"var_nlevels", "N Levels",
"contrasts_type", "Contrast Type",
"label", "Level Label",
"n_obs", "N Obs.",
"n_event", "N Events",
"exposure", "Exposure Time",
"estimate", "Coefficient",
"std.error", "Standard Error",
"p.value", "p-value",
"conf.low", "CI Lower Bound",
"conf.high", "CI Upper Bound",
)
}
126 changes: 69 additions & 57 deletions tests/testthat/_snaps/ard_regression.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -5,66 +5,78 @@
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 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
variable variable_level stat_name stat warning error
1 ARM Placebo term ARMPlacebo NULL NULL
2 ARM Placebo var_label Description of Planned Arm NULL NULL
3 ARM Placebo var_class character NULL NULL
4 ARM Placebo var_type categorical NULL NULL
5 ARM Placebo var_nlevels 3 NULL NULL
6 ARM Placebo contrasts contr.treatment NULL NULL
7 ARM Placebo contrasts_type treatment NULL NULL
8 ARM Placebo reference_row TRUE NULL NULL
9 ARM Placebo label Placebo NULL NULL
10 ARM Placebo n_obs 86 NULL NULL
11 ARM Placebo estimate 0 NULL NULL
12 ARM Xanomeline High Dose term ARMXanomeline High Dose NULL NULL
13 ARM Xanomeline High Dose var_label Description of Planned Arm NULL NULL
14 ARM Xanomeline High Dose var_class character NULL NULL
15 ARM Xanomeline High Dose var_type categorical NULL NULL
16 ARM Xanomeline High Dose var_nlevels 3 NULL NULL
17 ARM Xanomeline High Dose contrasts contr.treatment NULL NULL
18 ARM Xanomeline High Dose contrasts_type treatment NULL NULL
19 ARM Xanomeline High Dose reference_row FALSE NULL NULL
20 ARM Xanomeline High Dose label Xanomeline High Dose NULL NULL
21 ARM Xanomeline High Dose n_obs 84 NULL NULL
22 ARM Xanomeline High Dose estimate -0.828 NULL NULL
23 ARM Xanomeline High Dose std.error 1.267 NULL NULL
24 ARM Xanomeline High Dose statistic -0.654 NULL NULL
25 ARM Xanomeline High Dose p.value 0.514 NULL NULL
26 ARM Xanomeline High Dose conf.low -3.324 NULL NULL
27 ARM Xanomeline High Dose conf.high 1.668 NULL NULL
28 ARM Xanomeline Low Dose term ARMXanomeline Low Dose NULL NULL
29 ARM Xanomeline Low Dose var_label Description of Planned Arm NULL NULL
30 ARM Xanomeline Low Dose var_class character NULL NULL
31 ARM Xanomeline Low Dose var_type categorical NULL NULL
32 ARM Xanomeline Low Dose var_nlevels 3 NULL NULL
33 ARM Xanomeline Low Dose contrasts contr.treatment NULL NULL
34 ARM Xanomeline Low Dose contrasts_type treatment NULL NULL
35 ARM Xanomeline Low Dose reference_row FALSE NULL NULL
36 ARM Xanomeline Low Dose label Xanomeline Low Dose NULL NULL
37 ARM Xanomeline Low Dose n_obs 84 NULL NULL
38 ARM Xanomeline Low Dose estimate 0.457 NULL NULL
39 ARM Xanomeline Low Dose std.error 1.267 NULL NULL
40 ARM Xanomeline Low Dose statistic 0.361 NULL NULL
41 ARM Xanomeline Low Dose p.value 0.719 NULL NULL
42 ARM Xanomeline Low Dose conf.low -2.039 NULL NULL
43 ARM Xanomeline Low Dose conf.high 2.953 NULL NULL

# ard_regression() works specifying custom tidier

Code
dplyr::mutate(dplyr::filter(dplyr::select(as.data.frame(ard_regression(lme4::lmer(
mpg ~ hp + (1 | cyl), data = mtcars), tidy_fun = broom.mixed::tidy)),
-context, -stat_label, -fmt_fn), map_lgl(stat, is.numeric)), stat = lapply(stat,
function(x) ifelse(is.numeric(x), cards::round5(x, 3), x)))
dplyr::mutate(dplyr::filter(dplyr::select(as.data.frame(ard_regression(lme4::lmer(mpg ~
hp + (1 | cyl), data = mtcars), tidy_fun = broom.mixed::tidy)), -context, -stat_label,
-fmt_fn), map_lgl(stat, is.numeric)), stat = lapply(stat, function(x) ifelse(is.numeric(x),
cards::round5(x, 3), x)))
Output
variable variable_level stat_name stat
1 hp <NA> n_obs 32
2 hp <NA> estimate -0.03
3 hp <NA> std.error 0.015
4 hp <NA> statistic -2.088
5 hp <NA> conf.low -0.059
6 hp <NA> conf.high -0.002
7 cyl.sd__(Intercept) cyl.sd__(Intercept) estimate 4.023
8 Residual.sd__Observation Residual.sd__Observation estimate 3.149
variable variable_level stat_name stat warning error
1 hp <NA> n_obs 32 NULL NULL
2 hp <NA> estimate -0.03 NULL NULL
3 hp <NA> std.error 0.015 NULL NULL
4 hp <NA> statistic -2.088 NULL NULL
5 hp <NA> conf.low -0.059 NULL NULL
6 hp <NA> conf.high -0.002 NULL NULL
7 cyl.sd__(Intercept) cyl.sd__(Intercept) estimate 4.023 NULL NULL
8 Residual.sd__Observation Residual.sd__Observation estimate 3.149 NULL NULL

# ard_regression() warnings and errors return correctly

Code
as.data.frame(ard_regression(mod))
Output
variable context stat_name stat_label stat fmt_fn
1 model_1 regression estimate Coefficient NULL NULL
warning
1 Could not access test statistic of model parameters., Could not access test statistic of model parameters.
error
1 Error: ! Unable to tidy `x`.

26 changes: 13 additions & 13 deletions tests/testthat/_snaps/ard_regression_basic.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -3,17 +3,17 @@
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
variable variable_level context stat_name stat_label stat warning error
1 ARM Xanomeline High Dose regression estimate Coefficient -0.8283499 NULL NULL
2 ARM Xanomeline High Dose regression std.error Standard Error 1.267394 NULL NULL
3 ARM Xanomeline High Dose regression statistic statistic -0.653585 NULL NULL
4 ARM Xanomeline High Dose regression p.value p-value 0.5139775 NULL NULL
5 ARM Xanomeline High Dose regression conf.low CI Lower Bound -3.324433 NULL NULL
6 ARM Xanomeline High Dose regression conf.high CI Upper Bound 1.667733 NULL NULL
7 ARM Xanomeline Low Dose regression estimate Coefficient 0.4573643 NULL NULL
8 ARM Xanomeline Low Dose regression std.error Standard Error 1.267394 NULL NULL
9 ARM Xanomeline Low Dose regression statistic statistic 0.3608698 NULL NULL
10 ARM Xanomeline Low Dose regression p.value p-value 0.7185003 NULL NULL
11 ARM Xanomeline Low Dose regression conf.low CI Lower Bound -2.038718 NULL NULL
12 ARM Xanomeline Low Dose regression conf.high CI Upper Bound 2.953447 NULL NULL

14 changes: 7 additions & 7 deletions tests/testthat/_snaps/construction_helpers.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -5,13 +5,13 @@
mtcars, `M P G` = mpg), formula = reformulate2(c("M P G", "cyl"), response = "hp"),
method = "lm"))), stat_name %in% c("term", "estimate", "p.value"))
Output
variable context stat_name stat_label stat fmt_fn
1 M P G regression term term `M P G` NULL
2 M P G regression estimate Coefficient -2.774769 1
3 M P G regression p.value p-value 0.2125285 1
4 cyl regression term term cyl NULL
5 cyl regression estimate Coefficient 23.97863 1
6 cyl regression p.value p-value 0.002814958 1
variable context stat_name stat_label stat fmt_fn warning error
1 M P G regression term term `M P G` NULL NULL NULL
2 M P G regression estimate Coefficient -2.774769 1 NULL NULL
3 M P G regression p.value p-value 0.2125285 1 NULL NULL
4 cyl regression term term cyl NULL NULL NULL
5 cyl regression estimate Coefficient 23.97863 1 NULL NULL
6 cyl regression p.value p-value 0.002814958 1 NULL NULL

# construct_model() messaging

Expand Down
15 changes: 15 additions & 0 deletions tests/testthat/test-ard_regression.R
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,6 +1,8 @@
skip_if_not(is_pkg_installed(pkg = "broom.helpers", reference_pkg = "cardx"))

test_that("ard_regression() works", {
options(width = 90)
edelarua marked this conversation as resolved.
Show resolved Hide resolved

expect_snapshot(
lm(AGE ~ ARM, data = cards::ADSL) |>
ard_regression(add_estimate_to_reference_rows = TRUE) |>
Expand All @@ -23,6 +25,8 @@ test_that("ard_regression() works", {

test_that("ard_regression() works specifying custom tidier", {
skip_if_not(is_pkg_installed(pkg = c("lme4", "broom.mixed"), reference_pkg = "cardx"))
options(width = 90)

expect_snapshot(
lme4::lmer(mpg ~ hp + (1 | cyl), data = mtcars) |>
ard_regression(tidy_fun = broom.mixed::tidy) |>
Expand All @@ -38,3 +42,14 @@ test_that("ard_regression() works specifying custom tidier", {
test_that("ard_regression() does not produce `variable_level` column where not applicable", {
expect_true(!"variable_level" %in% names(lm(mpg ~ hp, mtcars) |> ard_regression()))
})

test_that("ard_regression() warnings and errors return correctly", {
mod <- lm(AGE ~ ARM, data = cards::ADSL)
mod$coefficients <- NULL

expect_snapshot(
mod |>
ard_regression() |>
as.data.frame()
)
})
Loading
Loading