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.

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

Update summarize_coxreg to work with pagination in all cases #956

Merged
merged 4 commits into from
Jun 9, 2023
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
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
1 change: 1 addition & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,7 @@
* Added explicit zero counts to `g_km` plot "at risk" annotation tables.
* Added a flag for total level split in `analyze_patients_exposure_in_cols`.
* Implemented `.indent_mods` argument in functions `h_tab_one_biomarker`, `h_tab_rsp_one_biomarker`, `h_tab_surv_one_biomarker`, `summarize_logistic`, `logistic_summary_by_flag`, `tabulate_rsp_biomarkers`, a_coxreg, `summarize_coxreg`, `tabulate_survival_biomarkers`, `surv_time`, `surv_timepoint`, and `cfun_by_flag`.
* Updated `summarize_coxreg` to print covariates in data rows for univariate Cox regression with no interactions and content rows otherwise.

### Bug Fixes
* Fixed bug in `split_text_grob` preventing titles and footnotes from being properly formatted and printed by `decorate_grob`.
Expand Down
38 changes: 29 additions & 9 deletions R/summarize_coxreg.R
Original file line number Diff line number Diff line change
Expand Up @@ -190,7 +190,11 @@ a_coxreg <- function(df,
cov_no_arm <- !multivar && !"arm" %in% names(variables) && control$interaction # special case: univar no arm
cov <- tail(.spl_context$value, 1) # current variable/covariate
var_lbl <- formatters::var_labels(df)[cov] # check for df labels
if (!is.na(var_lbl) && labelstr == cov && cov %in% variables$covariates) labelstr <- var_lbl # use df labels if none
if (length(labelstr) > 1) {
labelstr <- if (cov %in% names(labelstr)) labelstr[[cov]] else var_lbl # use df labels if none
} else if (!is.na(var_lbl) && labelstr == cov && cov %in% variables$covariates) {
labelstr <- var_lbl
}
if (eff || multivar || cov_no_arm) {
control$interaction <- FALSE
} else {
Expand Down Expand Up @@ -374,7 +378,7 @@ summarize_coxreg <- function(lyt,
lyt <- lyt %>%
analyze_colvars(
afun = a_coxreg,
extra_args = list(eff = TRUE, control = control, variables = variables, multivar = multivar)
extra_args = list(eff = TRUE, control = control, variables = variables, multivar = multivar, labelstr = "")
)
edelarua marked this conversation as resolved.
Show resolved Hide resolved
}
}
Expand All @@ -386,15 +390,31 @@ summarize_coxreg <- function(lyt,
varlabels = varlabels,
split_label = "Covariate:",
nested = FALSE,
child_labels = if (multivar || control$interaction || !"arm" %in% names(variables)) "default" else "hidden",
edelarua marked this conversation as resolved.
Show resolved Hide resolved
section_div = tail(.section_div, 1)
) %>%
summarize_row_groups(
cfun = a_coxreg,
extra_args = list(
variables = variables, at = at, control = control, multivar = multivar,
var_main = if (multivar) multivar else control$interaction
)
)
if (multivar || control$interaction || !"arm" %in% names(variables)) {
lyt <- lyt %>%
summarize_row_groups(
cfun = a_coxreg,
extra_args = list(
variables = variables, at = at, control = control, multivar = multivar,
var_main = if (multivar) multivar else control$interaction
)
)
} else {
if (!is.null(varlabels)) names(varlabels) <- variables$covariates
lyt <- lyt %>%
analyze_colvars(
afun = a_coxreg,
extra_args = list(
variables = variables, at = at, control = control, multivar = multivar,
var_main = if (multivar) multivar else control$interaction,
labelstr = if (is.null(varlabels)) "" else varlabels
)
)
}

if (!"arm" %in% names(variables)) control$interaction <- TRUE # special case: univar no arm
if (multivar || control$interaction) { # covariate level effects
lyt <- lyt %>%
Expand Down
16 changes: 12 additions & 4 deletions tests/testthat/test-summarize_coxreg.R
Original file line number Diff line number Diff line change
Expand Up @@ -67,12 +67,12 @@ testthat::test_that("a_coxreg works as expected", {
# summarize_coxreg ----

testthat::test_that("summarize_coxreg adds the univariate Cox regression layer to rtables", {
lyt <- basic_table() %>%
result <- basic_table() %>%
summarize_coxreg(
variables = variables,
control = control_coxreg(ties = "breslow", conf_level = 0.90)
)
result <- lyt %>% build_table(df = dta_bladder)
) %>%
build_table(df = dta_bladder)

res <- testthat::expect_silent(result)
testthat::expect_snapshot(res)
Expand All @@ -90,10 +90,18 @@ testthat::test_that("summarize_coxreg adds the univariate Cox regression layer t

# no labels
formatters::var_labels(dta_bladder) <- rep(NA_character_, ncol(dta_bladder))
result <- lyt %>% build_table(df = dta_bladder)
result <- basic_table() %>%
summarize_coxreg(
variables = variables,
control = control_coxreg(ties = "breslow", conf_level = 0.90)
) %>%
build_table(df = dta_bladder)

res <- testthat::expect_silent(result)
testthat::expect_snapshot(res)

# pagination
testthat::expect_silent(pag_result <- paginate_table(result, lpp = 10))
})

testthat::test_that("summarize_coxreg .section_div argument works", {
Expand Down