Skip to content

Commit 81f185a

Browse files
edelaruaddsjoberg
edelarua
and
ddsjoberg
authored
Split ard_emmeans_mean_difference() function into ard_emmeans_contrast() and ard_emmeans_emmeans() (#318)
**What changes are proposed in this pull request?** * Split the `ard_emmeans_mean_difference()` function into `ard_emmeans_contrast()` and `ard_emmeans_emmeans()`. (#317) * Began deprecation cycle for `ard_emmeans_mean_difference()` which is replaced by `ard_emmeans_contrast()`. PR fixes all currently failing tests in gtsummary - gtsummary will have to be updated to resolve soft deprecation messages for `ard_emmeans_mean_difference()`. Closes #317 -------------------------------------------------------------------------------- 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")` 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""))` - [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) - [x] If a bug was fixed, a unit test was added. - [x] Code coverage is suitable for any new functions/features: `devtools::test_coverage()` When the branch is ready to be merged: - [x] 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). - [x] **All** GitHub Action workflows pass with a ✅ - [ ] Approve Pull Request - [ ] Merge the PR. Please use "Squash and merge" or "Rebase and merge". --------- Co-authored-by: Daniel D. Sjoberg <danield.sjoberg@gmail.com>
1 parent 6c454e4 commit 81f185a

15 files changed

+494
-187
lines changed

‎NAMESPACE‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -40,6 +40,8 @@ export(ard_effectsize_cohens_d)
4040
export(ard_effectsize_hedges_g)
4141
export(ard_effectsize_paired_cohens_d)
4242
export(ard_effectsize_paired_hedges_g)
43+
export(ard_emmeans_contrast)
44+
export(ard_emmeans_emmeans)
4345
export(ard_emmeans_mean_difference)
4446
export(ard_incidence_rate)
4547
export(ard_missing)

‎NEWS.md‎

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,9 @@
22

33
* The `ard_complex()` function has been renamed to `ard_mvsummary()`.
44

5-
* Added mean estimate statistics to the `ard_emmeans_mean_difference()` function.
5+
* Added the `ard_emmeans_emmeans()` function. (#317)
6+
7+
* Renamed `ard_emmeans_mean_difference()` to `ard_emmeans_contrast()` to align with function naming conventions.
68

79
# cardx 0.3.0
810

R/ard_emmeans_mean_difference.R renamed to R/ard_emmeans_contrast.R

Lines changed: 44 additions & 70 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
1-
#' ARD for LS Mean Difference
1+
#' ARDs for LS Mean Difference and LS Means
22
#'
33
#' @description
4-
#' This function calculates least-squares mean differences using the 'emmeans'
4+
#' The `ard_emmeans_contrast()` function calculates least-squares mean differences using the 'emmeans'
55
#' package using the following
66
#'
77
#' ```r
@@ -10,9 +10,6 @@
1010
#' summary(infer = TRUE, level = <confidence level>)
1111
#' ```
1212
#'
13-
#' The arguments `data`, `formula`, `method`, `method.args`, `package` are used
14-
#' to construct the regression model via `cardx::construct_model()`.
15-
#'
1613
#' @param data (`data.frame`/`survey.design`)\cr
1714
#' a data frame or survey design object
1815
#' @inheritParams construct_model
@@ -28,30 +25,32 @@
2825
#'
2926
#' @return ARD data frame
3027
#' @export
28+
#' @rdname ard_emmeans
3129
#'
3230
#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "emmeans"))
33-
#' ard_emmeans_mean_difference(
31+
#' # LS Mean Difference
32+
#' ard_emmeans_contrast(
3433
#' data = mtcars,
3534
#' formula = mpg ~ am + cyl,
3635
#' method = "lm"
3736
#' )
3837
#'
39-
#' ard_emmeans_mean_difference(
38+
#' ard_emmeans_contrast(
4039
#' data = mtcars,
4140
#' formula = vs ~ am + mpg,
4241
#' method = "glm",
4342
#' method.args = list(family = binomial),
4443
#' response_type = "dichotomous"
4544
#' )
46-
ard_emmeans_mean_difference <- function(data, formula, method,
47-
method.args = list(),
48-
package = "base",
49-
response_type = c("continuous", "dichotomous"),
50-
conf.level = 0.95,
51-
primary_covariate =
52-
stats::terms(formula) |>
53-
attr("term.labels") |>
54-
getElement(1L)) {
45+
ard_emmeans_contrast <- function(data, formula, method,
46+
method.args = list(),
47+
package = "base",
48+
response_type = c("continuous", "dichotomous"),
49+
conf.level = 0.95,
50+
primary_covariate =
51+
stats::terms(formula) |>
52+
attr("term.labels") |>
53+
getElement(1L)) {
5554
set_cli_abort_call()
5655

5756
# check package installation -------------------------------------------------
@@ -75,48 +74,42 @@ ard_emmeans_mean_difference <- function(data, formula, method,
7574
variables = all_of(primary_covariate),
7675
statistic = all_of(primary_covariate) ~ list(
7776
emmeans =
78-
.calc_emmeans_mean_difference(
77+
.calc_emmeans_contrast(
7978
data, formula, method, {{ method.args }}, package, response_type, conf.level, primary_covariate
8079
)
8180
)
8281
)
83-
# unlist stat column containing values for each variable_level
84-
if (length(result$stat[[which(result$stat_label == "variable_level")]]) > 1) {
85-
result <- result |> tidyr::unnest_longer(col = "stat")
86-
}
8782

8883
result |>
8984
dplyr::select(-"stat_label") |>
9085
dplyr::left_join(
91-
.df_emmeans_stat_labels(),
86+
.df_emmeans_stat_labels("contrast"),
9287
by = "stat_name"
9388
) |>
9489
dplyr::mutate(
9590
variable = "contrast",
9691
variable_level = if ("variable_level" %in% .data$stat_name) {
97-
rep_len(.data$stat[.data$stat_name == "variable_level"], length.out = nrow(result))
92+
.data$stat[.data$stat_name == "variable_level"]
9893
} else {
9994
NA
10095
},
10196
group1 = .env$primary_covariate,
10297
stat_label = dplyr::coalesce(.data$stat_label, .data$stat_name),
103-
context = "emmeans_mean_difference",
98+
context = "emmeans_contrast",
10499
) |>
105-
dplyr::filter(!is.na(.data$stat)) |>
106100
dplyr::filter(.data$stat_name != "variable_level") |>
107-
dplyr::arrange(.data$variable_level) |>
108101
cards::as_card() |>
109102
cards::tidy_ard_column_order() |>
110103
cards::tidy_ard_row_order()
111104
}
112105

113-
# function to perform calculations -------------------------------------------
114-
.calc_emmeans_mean_difference <- function(data, formula, method,
115-
method.args,
116-
package,
117-
response_type,
118-
conf.level,
119-
primary_covariate) {
106+
# function to perform calculations ---------------------------------------------
107+
.calc_emmeans_contrast <- function(data, formula, method,
108+
method.args,
109+
package,
110+
response_type,
111+
conf.level,
112+
primary_covariate) {
120113
cards::as_cards_fn(
121114
\(x, ...) {
122115
# construct primary model ------------------------------------------------
@@ -136,64 +129,45 @@ ard_emmeans_mean_difference <- function(data, formula, method,
136129
code = do.call("emmeans", args = emmeans_args)
137130
)
138131

139-
df_results <-
132+
# calculate mean difference estimate -----------------------------------
133+
results <-
140134
emmeans |>
141135
emmeans::contrast(method = "pairwise") |>
142136
summary(infer = TRUE, level = conf.level) |>
143137
dplyr::rename(variable_level = "contrast")
144138

145-
# calculate mean estimate statistics -----------------------------------------
146-
mean_est <-
147-
summary(emmeans, calc = c(n = ".wgt.")) |>
148-
dplyr::as_tibble() |>
149-
dplyr::rename(
150-
mean.estimate = any_of(c("emmean", "prob")),
151-
n = any_of("n")
152-
) |>
153-
dplyr::select(all_of(c(1, 2, 5))) |>
154-
dplyr::rename(variable_level = all_of(primary_covariate)) |>
155-
dplyr::mutate(variable_level = as.character(.data$variable_level))
156-
157-
# bind the mean and mean difference estimates
158-
results <- dplyr::full_join(df_results, mean_est, by = "variable_level")
159-
160-
# convert results to ARD format ------------------------------------------
139+
# convert results to ARD format ----------------------------------------
161140
results |>
162141
dplyr::as_tibble() |>
163142
dplyr::rename(
164143
conf.low = any_of("asymp.LCL"),
165144
conf.high = any_of("asymp.UCL"),
166145
conf.low = any_of("lower.CL"),
167146
conf.high = any_of("upper.CL"),
168-
mean.difference.estimate = any_of("estimate")
169-
) %>%
170-
dplyr::select(
171-
"variable_level",
172-
"mean.difference.estimate",
173-
"mean.estimate",
174-
std.error = "SE", "df", "n",
147+
std.error = any_of("SE")
148+
) |>
149+
dplyr::select(any_of(c(
150+
"variable_level", "estimate",
151+
"std.error", "df",
175152
"conf.low", "conf.high", "p.value"
176-
) %>%
153+
))) |>
177154
dplyr::mutate(
178155
conf.level = .env$conf.level,
179-
method =
180-
ifelse(
181-
length(attr(stats::terms(formula), "term.labels") |> discard(~ startsWith(., "1 |"))) == 1L,
182-
"Least-squares mean difference",
183-
"Least-squares adjusted mean difference"
184-
)
185-
) |>
186-
dplyr::mutate(across(everything(), ~ .x |> as.list()))
156+
method = ifelse(
157+
length(attr(stats::terms(formula), "term.labels") |> discard(~ startsWith(., "1 |"))) == 1L,
158+
"Least-squares mean difference",
159+
"Least-squares adjusted mean difference"
160+
)
161+
)
187162
},
188-
stat_names = c("variable_level", "mean.difference.estimate", "mean.estimate", "std.error", "df", "n", "conf.low", "conf.high", "p.value", "conf.level", "method")
163+
stat_names = c("variable_level", "estimate", "std.error", "df", "conf.low", "conf.high", "p.value", "conf.level", "method")
189164
)
190165
}
191166

192-
.df_emmeans_stat_labels <- function() {
167+
.df_emmeans_stat_labels <- function(estimate) {
193168
dplyr::tribble(
194169
~stat_name, ~stat_label,
195-
"mean.difference.estimate", "Mean Difference",
196-
"mean.estimate", "Mean",
170+
"estimate", if (estimate == "contrast") "Mean Difference" else "Mean",
197171
"std.error", "Standard Error",
198172
"df", "Degrees of Freedom",
199173
"conf.low", "CI Lower Bound",

‎R/ard_emmeans_emmeans.R‎

Lines changed: 163 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,163 @@
1+
#' @description
2+
#' The `ard_emmeans_emmeans()` function calculates least-squares means using the 'emmeans'
3+
#' package using the following
4+
#'
5+
#' ```r
6+
#' emmeans::emmeans(object = <regression model>, specs = ~ <primary covariate>) |>
7+
#' summary(emmeans, calc = c(n = ".wgt."))
8+
#' ```
9+
#'
10+
#' The arguments `data`, `formula`, `method`, `method.args`, `package` are used
11+
#' to construct the regression model via `cardx::construct_model()`.
12+
#'
13+
#' @export
14+
#' @rdname ard_emmeans
15+
#'
16+
#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "emmeans"))
17+
#' # LS Means
18+
#' ard_emmeans_emmeans(
19+
#' data = mtcars,
20+
#' formula = mpg ~ am + cyl,
21+
#' method = "lm"
22+
#' )
23+
#'
24+
#' ard_emmeans_emmeans(
25+
#' data = mtcars,
26+
#' formula = vs ~ am + mpg,
27+
#' method = "glm",
28+
#' method.args = list(family = binomial),
29+
#' response_type = "dichotomous"
30+
#' )
31+
ard_emmeans_emmeans <- function(data,
32+
formula,
33+
method,
34+
method.args = list(),
35+
package = "base",
36+
response_type = c("continuous", "dichotomous"),
37+
conf.level = 0.95,
38+
primary_covariate =
39+
stats::terms(formula) |>
40+
attr("term.labels") |>
41+
getElement(1L)) {
42+
set_cli_abort_call()
43+
44+
# check package installation -------------------------------------------------
45+
check_pkg_installed(c("emmeans", package))
46+
check_not_missing(data)
47+
check_not_missing(formula)
48+
check_not_missing(method)
49+
check_class(data, c("data.frame", "survey.design"))
50+
check_class(formula, cls = "formula")
51+
check_string(package)
52+
check_string(primary_covariate)
53+
check_scalar(conf.level)
54+
check_range(conf.level, range = c(0, 1))
55+
response_type <- arg_match(response_type, error_call = get_cli_abort_call())
56+
57+
data_in <- if (dplyr::last(class(data)) == "survey.design") data$variables else data
58+
59+
# build ARD ------------------------------------------------------------------
60+
result <- cards::ard_mvsummary(
61+
data = data_in,
62+
variables = all_of(primary_covariate),
63+
statistic = all_of(primary_covariate) ~ list(
64+
emmeans =
65+
.calc_emmeans(
66+
data = data, formula = formula, method = method,
67+
method.args = {{ method.args }}, package = package,
68+
response_type = response_type, conf.level = conf.level,
69+
primary_covariate = primary_covariate
70+
)
71+
)
72+
)
73+
# unlist stat column
74+
if (length(result$stat[[which(result$stat_label == "variable_level")]]) > 1) {
75+
result <- result |> tidyr::unnest_longer(col = "stat")
76+
}
77+
78+
result |>
79+
dplyr::select(-"stat_label") |>
80+
dplyr::left_join(
81+
.df_emmeans_stat_labels("emmeans"),
82+
by = "stat_name"
83+
) |>
84+
dplyr::mutate(
85+
variable = "contrast",
86+
variable_level = if ("variable_level" %in% .data$stat_name) {
87+
rep_len(.data$stat[.data$stat_name == "variable_level"], length.out = nrow(result))
88+
} else {
89+
NA
90+
},
91+
group1 = .env$primary_covariate,
92+
stat_label = dplyr::coalesce(.data$stat_label, .data$stat_name),
93+
context = "emmeans_emmeans"
94+
) |>
95+
dplyr::filter(!is.na(.data$stat)) |>
96+
dplyr::filter(.data$stat_name != "variable_level") |>
97+
dplyr::arrange(.data$variable_level) |>
98+
cards::as_card() |>
99+
cards::tidy_ard_column_order() |>
100+
cards::tidy_ard_row_order()
101+
}
102+
103+
# function to perform calculations ---------------------------------------------
104+
.calc_emmeans <- function(data, formula, method,
105+
method.args,
106+
package,
107+
response_type,
108+
conf.level,
109+
primary_covariate) {
110+
cards::as_cards_fn(
111+
\(x, ...) {
112+
# construct primary model ------------------------------------------------
113+
mod <-
114+
construct_model(
115+
data = data, formula = formula, method = method,
116+
method.args = {{ method.args }},
117+
package = package, env = caller_env()
118+
)
119+
120+
# emmeans ----------------------------------------------------------------
121+
emmeans_args <- list(object = mod, specs = reformulate2(primary_covariate))
122+
if (response_type %in% "dichotomous") emmeans_args <- c(emmeans_args, list(regrid = "response"))
123+
emmeans <-
124+
withr::with_namespace(
125+
package = "emmeans",
126+
code = do.call("emmeans", args = emmeans_args)
127+
)
128+
129+
# calculate mean estimates ---------------------------------------------
130+
results <-
131+
summary(emmeans, calc = c(n = ".wgt.")) |>
132+
dplyr::as_tibble() |>
133+
dplyr::rename(
134+
estimate = any_of(c("emmean", "prob")),
135+
n = any_of("n")
136+
) |>
137+
dplyr::rename(variable_level = all_of(primary_covariate)) |>
138+
dplyr::mutate(variable_level = as.character(.data$variable_level))
139+
140+
# convert results to ARD format ------------------------------------------
141+
results |>
142+
dplyr::as_tibble() |>
143+
dplyr::rename(
144+
conf.low = any_of("asymp.LCL"),
145+
conf.high = any_of("asymp.UCL"),
146+
conf.low = any_of("lower.CL"),
147+
conf.high = any_of("upper.CL"),
148+
std.error = any_of("SE")
149+
) |>
150+
dplyr::select(any_of(c(
151+
"variable_level", "estimate",
152+
"std.error", "df", "n",
153+
"conf.low", "conf.high", "p.value"
154+
))) |>
155+
dplyr::mutate(
156+
conf.level = .env$conf.level,
157+
method = "Least-squares means"
158+
) |>
159+
dplyr::mutate(across(everything(), ~ .x |> as.list()))
160+
},
161+
stat_names = c("variable_level", "estimate", "std.error", "df", "conf.low", "conf.high", "p.value", "conf.level", "method", "n")
162+
)
163+
}

0 commit comments

Comments
 (0)