Skip to content

Commit

Permalink
Fix bug in ard_survival_survfit() when "=" is in strata variable la…
Browse files Browse the repository at this point in the history
…bels (#253)

**What changes are proposed in this pull request?**
* Fixed a bug in `ard_survival_survfit()` causing an error when "="
character is present in stratification variable level labels. (#252)

Closes #252 


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

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)

- [ ] 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".

---------

Co-authored-by: Daniel Sjoberg <[email protected]>
  • Loading branch information
edelarua and ddsjoberg authored Jan 9, 2025
1 parent ed0934e commit 41bdebf
Show file tree
Hide file tree
Showing 4 changed files with 37 additions and 9 deletions.
2 changes: 2 additions & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,8 @@

* Update in `ard_missing.survey.design()` where we can now tabulate the missing rate of design variables, such as the weights.

* Fixed a bug in `ard_survival_survfit()` causing an error when "=" character is present in stratification variable level labels. (#252)

# cardx 0.2.2

* Added a `data.frame` method to `ard_survival_survfit()`.
Expand Down
13 changes: 4 additions & 9 deletions R/ard_survival_survfit.R
Original file line number Diff line number Diff line change
Expand Up @@ -284,7 +284,7 @@ ard_survival_survfit.data.frame <- function(x, y, variables,
dplyr::rename(conf.low = "conf.high", conf.high = "conf.low")
}

df_stat <- extract_multi_strata(x, df_stat)
df_stat <- extract_strata(x, df_stat)

df_stat
}
Expand Down Expand Up @@ -320,13 +320,13 @@ ard_survival_survfit.data.frame <- function(x, y, variables,

if (length(x$n) == 1) df_stat <- df_stat %>% dplyr::select(-"strata")

df_stat <- extract_multi_strata(x, df_stat)
df_stat <- extract_strata(x, df_stat)

df_stat
}

# process multiple stratifying variables
extract_multi_strata <- function(x, df_stat) {
# process stratifying variables
extract_strata <- function(x, df_stat) {
x_terms <- attr(stats::terms(stats::as.formula(x$call$formula)), "term.labels")
x_terms <- gsub(".*\\(", "", gsub("\\)", "", x_terms))
if (length(x_terms) > 0L) {
Expand Down Expand Up @@ -380,11 +380,6 @@ extract_multi_strata <- function(x, df_stat) {
) %>%
dplyr::select(-all_of(est))

if ("strata" %in% names(ret)) {
ret <- ret %>%
tidyr::separate_wider_delim("strata", "=", names = c("group1", "group1_level"))
}

ret %>%
dplyr::left_join(
.df_survfit_stat_labels(),
Expand Down
22 changes: 22 additions & 0 deletions tests/testthat/_snaps/ard_survival_survfit.md
Original file line number Diff line number Diff line change
Expand Up @@ -334,6 +334,28 @@
Error in `ard_survival_survfit()`:
! Argument `x` cannot be class <survfitcox>.

# ard_survival_survfit() works with '=' in strata variable level labels

Code
ard_survival_survfit(survival::survfit(survival::Surv(time, status) ~ age_bin,
data = lung2), times = 100)
Message
{cards} data frame: 10 x 11
Output
group1 group1_level variable variable_level stat_name stat_label stat
1 age_bin <60 time 100 n.risk Number o… 77
2 age_bin <60 time 100 estimate Survival… 0.928
3 age_bin <60 time 100 std.error Standard… 0.028
4 age_bin <60 time 100 conf.high CI Upper… 0.985
5 age_bin <60 time 100 conf.low CI Lower… 0.874
6 age_bin >=60 time 100 n.risk Number o… 119
7 age_bin >=60 time 100 estimate Survival… 0.827
8 age_bin >=60 time 100 std.error Standard… 0.031
9 age_bin >=60 time 100 conf.high CI Upper… 0.891
10 age_bin >=60 time 100 conf.low CI Lower… 0.768
Message
i 4 more variables: context, fmt_fn, warning, error

# ard_survival_survfit() extends to times outside range

Code
Expand Down
9 changes: 9 additions & 0 deletions tests/testthat/test-ard_survival_survfit.R
Original file line number Diff line number Diff line change
Expand Up @@ -167,6 +167,15 @@ test_that("ard_survival_survfit() errors with stratified Cox model", {
)
})

test_that("ard_survival_survfit() works with '=' in strata variable level labels", {
lung2 <- survival::lung %>%
dplyr::mutate(age_bin = factor(ifelse(age < 60, "<60", ">=60")))

expect_snapshot(
survival::survfit(survival::Surv(time, status) ~ age_bin, data = lung2) |>
ard_survival_survfit(times = 100)
)
})

test_that("ard_survival_survfit() follows ard structure", {
expect_silent(
Expand Down

0 comments on commit 41bdebf

Please sign in to comment.