Skip to content

Commit

Permalink
Make extra_keys = into soft "deprecation" of a different behavior
Browse files Browse the repository at this point in the history
to ease epipredict transition.
  • Loading branch information
brookslogan committed Oct 22, 2024
1 parent 839e921 commit 34acd7e
Show file tree
Hide file tree
Showing 3 changed files with 30 additions and 21 deletions.
2 changes: 1 addition & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
Type: Package
Package: epiprocess
Title: Tools for basic signal processing in epidemiology
Version: 0.9.4
Version: 0.9.6
Authors@R: c(
person("Jacob", "Bien", role = "ctb"),
person("Logan", "Brooks", , "[email protected]", role = c("aut", "cre")),
Expand Down
19 changes: 15 additions & 4 deletions R/key_colnames.R
Original file line number Diff line number Diff line change
Expand Up @@ -27,7 +27,16 @@
#' @keywords internal
#' @export
key_colnames <- function(x, ..., exclude = character()) {
UseMethod("key_colnames")
provided_args <- rlang::call_args_names(rlang::call_match())
if ("extra_keys" %in% provided_args) {
lifecycle::deprecate_soft("0.9.6", "key_colnames(extra_keys=)", "key_colnames(other_keys=)")
redispatch <- function(..., extra_keys) {
key_colnames(..., other_keys = extra_keys)
}
redispatch(x, ..., exclude = exclude)
} else {
UseMethod("key_colnames")
}
}

#' @rdname key_colnames
Expand All @@ -44,7 +53,7 @@ key_colnames.data.frame <- function(x, ...,
assert_character(time_keys)
assert_character(other_keys)
assert_character(exclude)
keys = c(geo_keys, other_keys, time_keys)
keys <- c(geo_keys, other_keys, time_keys)
if (!all(keys %in% names(x))) {
cli_abort(c(
"Some of the specified key columns aren't present in `x`",
Expand All @@ -67,11 +76,13 @@ key_colnames.epi_df <- function(x, ...,
check_dots_empty0(...)
if (!identical(geo_keys, "geo_value")) {
cli_abort('If `x` is an `epi_df`, then `geo_keys` must be `"geo_value"`',
class = "epiprocess__key_colnames__mismatched_geo_keys")
class = "epiprocess__key_colnames__mismatched_geo_keys"
)
}
if (!identical(time_keys, "time_value")) {
cli_abort('If `x` is an `epi_df`, then `time_keys` must be `"time_value"`',
class = "epiprocess__key_colnames__mismatched_time_keys")
class = "epiprocess__key_colnames__mismatched_time_keys"
)
}
expected_other_keys <- attr(x, "metadata")$other_keys
if (is.null(other_keys)) {
Expand Down
30 changes: 14 additions & 16 deletions tests/testthat/test-key_colnames.R
Original file line number Diff line number Diff line change
@@ -1,4 +1,5 @@
test_that("`key_colnames` on non-`epi_df`-like tibbles works as expected", {
withr::local_options(list(lifecycle_verbosity = "warning")) # for extra_keys tests

k1k2_tbl <- tibble::tibble(k1 = 1, k2 = 1)

Expand Down Expand Up @@ -35,11 +36,9 @@ test_that("`key_colnames` on non-`epi_df`-like tibbles works as expected", {
key_colnames(k1k2_tbl, geo_keys = c("k1", "k2"), other_keys = character(0L)),
c("k1", "k2")
)

})

test_that("`key_colnames` on `epi_df`s and similar tibbles works as expected", {

gat_tbl <- tibble::tibble(geo_value = 1, age_group = 1, time_value = 1)
gat_edf <- as_epi_df(gat_tbl, other_keys = "age_group", as_of = 2)

Expand Down Expand Up @@ -76,16 +75,6 @@ test_that("`key_colnames` on `epi_df`s and similar tibbles works as expected", {
class = "epiprocess__key_colnames__mismatched_time_keys"
)

# For either class, `extra_keys` is not accepted:
expect_error(
key_colnames(gat_tbl, extra_keys = "age_group"),
class = "rlib_error_dots_nonempty"
)
expect_error(
key_colnames(gat_edf, extra_keys = "age_group"),
class = "rlib_error_dots_nonempty"
)

# We can exclude keys:
expect_equal(
key_colnames(gat_tbl, other_keys = "age_group", exclude = c("time_value")),
Expand All @@ -104,10 +93,22 @@ test_that("`key_colnames` on `epi_df`s and similar tibbles works as expected", {
c("age_group")
)

# Using `extra_keys =` is soft-deprecated and routes to `other_keys =`:
expect_warning(
gat_tbl_extra_keys_res <- key_colnames(gat_tbl, extra_keys = "age_group"),
class = "lifecycle_warning_deprecated"
)
expect_equal(gat_tbl_extra_keys_res, c("geo_value", "age_group", "time_value"))

expect_warning(
gat_edf_extra_keys_exclude_res <-
key_colnames(gat_edf, extra_keys = "age_group", exclude = c("geo_value", "time_value")),
class = "lifecycle_warning_deprecated"
)
expect_equal(gat_edf_extra_keys_exclude_res, c("age_group"))
})

test_that("`key_colnames` on tsibbles works as expected", {

k1k2i_tsbl <- tsibble::tsibble(k1 = 1, k2 = 1, i = 1, key = c(k1, k2), index = i)

# Normal operation:
Expand All @@ -133,11 +134,9 @@ test_that("`key_colnames` on tsibbles works as expected", {
key_colnames(k1k2i_tsbl %>% tsibble::index_by(fake_coarser_i = i)),
class = "epiprocess__key_colnames__incomplete_reindexing_operation"
)

})

test_that("`key_colnames` on `epi_archive`s works as expected", {

gatv_ea <- tibble(geo_value = 1, age_group = 1, time_value = 1, version = 2) %>%
as_epi_archive(other_keys = "age_group")

Expand Down Expand Up @@ -168,5 +167,4 @@ test_that("`key_colnames` on `epi_archive`s works as expected", {
key_colnames(gatv_ea, exclude = c("version", "time_value")),
c("geo_value", "age_group")
)

})

0 comments on commit 34acd7e

Please sign in to comment.