Skip to content

Commit

Permalink
Add warning and error columns to ard_regression() output (#195)
Browse files Browse the repository at this point in the history 
**What changes are proposed in this pull request?**
* Added `warning` and `error` columns to `ard_regression()` output.
(#148)

Closes #148 


--------------------------------------------------------------------------------

Pre-review Checklist (if item does not apply, mark is as complete)
- [x] **All** GitHub Action workflows pass with a ✅
- [x] PR branch has pulled the most recent updates from master branch:
`usethis::pr_merge_main()`
- [x] If a bug was fixed, a unit test was added.
- [x] If a new `ard_*()` function was added, it passes the ARD
structural checks from `cards::check_ard_structure()`.
- [x] If a new `ard_*()` function was added, `set_cli_abort_call()` has
been set.
- [x] If a new `ard_*()` function was added and it depends on another
package (such as, `broom`), `is_pkg_installed("broom", reference_pkg =
"cardx")` has been set in the function call and the following added to
the roxygen comments: `@examplesIf
do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom"",
reference_pkg = "cardx"))`
- [x] Code coverage is suitable for any new functions/features
(generally, 100% coverage for new code): `devtools::test_coverage()`

Reviewer Checklist (if item does not apply, mark is as complete)

- [ ] If a bug was fixed, a unit test was added.
- [ ] Code coverage is suitable for any new functions/features:
`devtools::test_coverage()`

When the branch is ready to be merged:
- [ ] Update `NEWS.md` with the changes from this pull request under the
heading "`# cardx (development version)`". If there is an issue
associated with the pull request, reference it in parentheses at the end
update (see `NEWS.md` for examples).
- [ ] **All** GitHub Action workflows pass with a ✅
- [ ] Approve Pull Request
- [ ] Merge the PR. Please use "Squash and merge" or "Rebase and merge".
  • Loading branch information
@edelarua
edelarua authored Aug 21, 2024
1 parent a56c90b commit bcbd89a
Show file tree
Hide file tree
Showing 8 changed files with 186 additions and 122 deletions.
2 changes: 1 addition & 1 deletion DESCRIPTION
View file
Original file line number Diff line number Diff line change
Expand Up @@ -19,7 +19,7 @@ BugReports: https://github.com/insightsengineering/cardx/issues
Depends:
R (>= 4.1)
Imports:
cards (>= 0.2.1.9003),
cards (>= 0.2.1.9006),
cli (>= 3.6.1),
dplyr (>= 1.1.2),
glue (>= 1.6.2),
Expand Down
2 changes: 2 additions & 0 deletions NEWS.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,8 @@

* Added S3 method `ard_total_n.survey.design()` which returns an ARD with both the survey-weighted and unweighted total sample size.

* Added `warning` and `error` columns to `ard_regression()` output. (#148)

# cardx 0.2.0

### Breaking Changes
Expand Down
121 changes: 77 additions & 44 deletions R/ard_regression.R
View file
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::left_join(
.df_regression_stat_labels(),
by = "stat_name"
) |>
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
)
) |>
cards::tidy_ard_column_order() %>%
{structure(., class = c("card", class(.)))} # styler: off
dplyr::mutate(stat_label = dplyr::coalesce(.data$stat_label, .data$stat_name)) |>
cards::as_card() |>
cards::tidy_ard_column_order()
}

.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
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
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
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
Loading

0 comments on commit bcbd89a

Please sign in to comment.