Skip to content

Commit

Permalink
feat(epi_slide_opt): adjust [.]new_col_name = error guidance
Browse files Browse the repository at this point in the history
  • Loading branch information
brookslogan committed Nov 12, 2024
1 parent b4d71dc commit e6f7264
Show file tree
Hide file tree
Showing 4 changed files with 134 additions and 7 deletions.
11 changes: 6 additions & 5 deletions R/slide.R
Original file line number Diff line number Diff line change
Expand Up @@ -646,7 +646,7 @@ epi_slide_opt <- function(
if ("new_col_name" %in% provided_args || ".new_col_name" %in% provided_args) {
cli::cli_abort(
"epi_slide_opt: the argument `new_col_name` is not supported for `epi_slide_opt`. If you want to customize
the output column names, use `dplyr::rename` after the slide.",
the output column names, use `.prefix =`, `.suffix =`, or `.new_col_**names** =`.",
class = "epiprocess__epi_slide_opt__new_name_not_supported"
)
}
Expand Down Expand Up @@ -746,14 +746,15 @@ epi_slide_opt <- function(
window_args <- get_before_after_from_window(.window_size, .align, time_type)

# Handle output naming
assert_string(.prefix, null.ok = TRUE)
assert_string(.suffix, null.ok = TRUE)
assert_character(.new_col_names, len = length(col_names_chr), null.ok = TRUE)
if ((!is.null(.prefix) || !is.null(.suffix)) && !is.null(.new_col_names)) {
cli_abort(
"Can't use both .prefix/.suffix and .new_col_names at the same time."
"Can't use both .prefix/.suffix and .new_col_names at the same time.",
class = "epiprocess__epi_slide_opt_incompatible_naming_args"
)
}
assert_string(.prefix, null.ok = TRUE)
assert_string(.suffix, null.ok = TRUE)
assert_character(.new_col_names, len = length(col_names_chr), null.ok = TRUE)
if (is.null(.prefix) && is.null(.suffix) && is.null(.new_col_names)) {
.suffix <- "_{.n}{.time_unit_abbr}{.align_abbr}{.f_abbr}"
# ^ does not account for any arguments specified to underlying functions via
Expand Down
4 changes: 2 additions & 2 deletions R/utils.R
Original file line number Diff line number Diff line change
Expand Up @@ -1137,7 +1137,7 @@ time_delta_to_n_steps <- function(time_delta, time_type) {
week = "weeks",
cli_abort("difftime objects not supported for time_type {format_chr_with_quotes(time_type)}")
)
units(time_delta) <- output_units # converts number accordingly, doesn't just set attr
units(time_delta) <- output_units # converts number to represent same duration; not just attr<-
n_steps <- vec_data(time_delta)
if (!is_bare_integerish(n_steps)) {
cli_abort("`time_delta` did not appear to contain only integerish numbers
Expand All @@ -1164,7 +1164,7 @@ time_delta_to_n_steps <- function(time_delta, time_type) {
time_type_unit_abbrs <- c(
day = "d",
week = "w",
yearmon = "m"
yearmonth = "m"
)

time_type_unit_abbr <- function(time_type) {
Expand Down
31 changes: 31 additions & 0 deletions man/time_delta_to_n_steps.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

95 changes: 95 additions & 0 deletions tests/testthat/test-epi_slide.R
Original file line number Diff line number Diff line change
Expand Up @@ -755,3 +755,98 @@ test_that("no dplyr warnings from selecting multiple columns", {
)
expect_equal(multi_slid_select, multi_slid)
})

test_that("epi_slide_opt output naming features", {
multi_columns <- dplyr::bind_rows(
dplyr::tibble(geo_value = "ak", time_value = test_date + 1:200, value = 1:200, value2 = -1:-200),
dplyr::tibble(geo_value = "al", time_value = test_date + 1:5, value = -(1:5), value2 = 1:5)
) %>%
as_epi_df() %>%
group_by(geo_value)
multi_columns_weekly <- dplyr::bind_rows(
dplyr::tibble(geo_value = "ak", time_value = test_date + 7 * (1:200), value = 1:200, value2 = -1:-200),
dplyr::tibble(geo_value = "al", time_value = test_date + 7 * (1:5), value = -(1:5), value2 = 1:5)
) %>%
as_epi_df() %>%
group_by(geo_value)
yearmonthly <-
tibble::tibble(
geo_value = 1,
time_value = tsibble::make_yearmonth(2000, 1) + 1:30 - 1,
value = 1:30 %% 2 == 0
) %>%
as_epi_df() %>%
group_by(geo_value)

# Auto-naming:
# * Changing .f and .window_size:
expect_equal(
multi_columns %>% epi_slide_opt(value2, frollmean, .window_size = 14) %>% names(),
c(names(multi_columns), "value2_14dav")
)
expect_equal(
multi_columns %>% epi_slide_opt(value2, slide_mean, .window_size = as.difftime(14, units = "days")) %>% names(),
c(names(multi_columns), "value2_14dav")
)
expect_equal(
multi_columns %>% epi_slide_opt(value2, slide_sum, .window_size = Inf) %>% names(),
c(names(multi_columns), "value2_running_sum")
)
# * Changing .f and .align:
expect_equal(
multi_columns %>% epi_slide_opt(value2, slide_min, .window_size = 14, .align = "center") %>% names(),
c(names(multi_columns), "value2_14dcmin")
)
expect_equal(
multi_columns %>% epi_slide_opt(value2, slide_max, .window_size = 14, .align = "left") %>% names(),
c(names(multi_columns), "value2_14dlmax")
)
# * Changing .f, time_type(, .window_size):
expect_equal(
multi_columns_weekly %>% epi_slide_opt(value2, slide_prod, .window_size = as.difftime(2, units = "weeks")) %>% names(),

Check warning on line 806 in tests/testthat/test-epi_slide.R

View workflow job for this annotation

GitHub Actions / lint

file=tests/testthat/test-epi_slide.R,line=806,col=121,[line_length_linter] Lines should not be more than 120 characters. This line is 123 characters.
c(names(multi_columns_weekly), "value2_2wprod")
)
expect_equal(
yearmonthly %>% epi_slide_opt(value, slide_any, .window_size = 3) %>% names(),
c(names(yearmonthly), "value_3many") # not the best name, but super unlikely anyway
)

# Manual naming:
expect_equal(
multi_columns %>% epi_slide_opt(starts_with("value"), slide_sum, .window_size = 7, .suffix = "_s{.n}") %>% names(),
c(names(multi_columns), "value_s7", "value2_s7")
)
expect_equal(
multi_columns %>% epi_slide_opt(starts_with("value"), slide_sum, .window_size = 7, .prefix = "{.f_abbr}_", .suffix = "_{.n}") %>% names(),

Check warning on line 820 in tests/testthat/test-epi_slide.R

View workflow job for this annotation

GitHub Actions / lint

file=tests/testthat/test-epi_slide.R,line=820,col=121,[line_length_linter] Lines should not be more than 120 characters. This line is 142 characters.
c(names(multi_columns), "sum_value_7", "sum_value2_7")
)
expect_equal(
multi_columns %>% epi_slide_opt(starts_with("value"), slide_sum, .window_size = 7, .prefix = "slide_value_") %>% names(),

Check warning on line 824 in tests/testthat/test-epi_slide.R

View workflow job for this annotation

GitHub Actions / lint

file=tests/testthat/test-epi_slide.R,line=824,col=121,[line_length_linter] Lines should not be more than 120 characters. This line is 125 characters.
c(names(multi_columns), "slide_value_value", "slide_value_value2")
)
expect_equal(
multi_columns %>% epi_slide_opt(starts_with("value"), slide_sum, .window_size = 7, .new_col_names = c("slide_value", "sv2")) %>% names(),

Check warning on line 828 in tests/testthat/test-epi_slide.R

View workflow job for this annotation

GitHub Actions / lint

file=tests/testthat/test-epi_slide.R,line=828,col=121,[line_length_linter] Lines should not be more than 120 characters. This line is 141 characters.
c(names(multi_columns), "slide_value", "sv2")
)

# Validation errors:
expect_error(
multi_columns %>% epi_slide_opt(starts_with("value"), slide_sum,
.window_size = 7,
.suffix = c("a", "b")
)
)
expect_error(
multi_columns %>% epi_slide_opt(starts_with("value"), slide_sum,
.window_size = 7,
.new_col_names = "slide_value"
)
)
expect_error(
multi_columns %>% epi_slide_opt(value, slide_sum,
.window_size = 7,
.prefix = "a", .suffix = "b", .new_col_names = "slide_value"
),
class = "epiprocess__epi_slide_opt_incompatible_naming_args"
)
})

0 comments on commit e6f7264

Please sign in to comment.