Skip to content
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
2 changes: 1 addition & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -29,7 +29,7 @@ Imports:
checkmate,
cli,
data.table,
dplyr (>= 1.0.0),
dplyr (>= 1.0.8),
genlasso,
ggplot2,
lifecycle (>= 1.0.1),
Expand Down
1 change: 0 additions & 1 deletion NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -38,7 +38,6 @@ S3method(next_after,integer)
S3method(print,epi_archive)
S3method(print,epi_df)
S3method(print,grouped_epi_archive)
S3method(select,epi_df)
S3method(summary,epi_df)
S3method(ungroup,epi_df)
S3method(ungroup,grouped_epi_archive)
Expand Down
8 changes: 0 additions & 8 deletions R/group_by_epi_df_methods.R
Original file line number Diff line number Diff line change
Expand Up @@ -3,11 +3,3 @@
# `epi_df`s. It would be nice if there were a way to replace these with a
# generic core that automatically fixed all misbehaving methods; see
# brainstorming within Issue #223.

#' @importFrom dplyr select
#' @export
select.epi_df <- function(.data, ...) {
selected <- NextMethod(.data)
might_decay <- reclass(selected, attr(selected, "metadata"))
return(dplyr_reconstruct(might_decay, might_decay))
}
8 changes: 4 additions & 4 deletions tests/testthat/test-epi_slide.R
Original file line number Diff line number Diff line change
Expand Up @@ -434,7 +434,7 @@ test_that("`ref_time_values` + `all_rows = TRUE` works", {
),
basic_full_result %>%
dplyr::mutate(slide_value = dplyr::if_else(time_value %in% (test_date + c(2L, 8L)),
slide_value, NA_integer_
slide_value, NA_real_ # (`^` outputs numeric)
))
)

Expand Down Expand Up @@ -472,7 +472,7 @@ test_that("`ref_time_values` + `all_rows = TRUE` works", {
),
basic_mean_result %>%
dplyr::mutate(slide_value_value = dplyr::if_else(time_value %in% (test_date + c(2L, 8L)),
slide_value, NA_integer_
slide_value, NA_real_
)) %>%
select(-slide_value)
)
Expand All @@ -498,7 +498,7 @@ test_that("`ref_time_values` + `all_rows = TRUE` works", {
),
basic_full_result %>%
dplyr::mutate(slide_value = dplyr::if_else(time_value %in% (test_date + c(2L, 8L)),
slide_value, NA_integer_
slide_value, NA_real_
)) %>%
dplyr::rename(slide_value_value = slide_value)
)
Expand Down Expand Up @@ -584,7 +584,7 @@ test_that("`ref_time_values` + `all_rows = TRUE` works", {
unnest(slide_value, names_sep = "_"),
basic_full_result %>%
dplyr::mutate(slide_value = dplyr::if_else(time_value %in% (test_date + c(2L, 8L)),
slide_value, NA_integer_
slide_value, NA_real_
)) %>%
dplyr::rename(slide_value_value = slide_value)
)
Expand Down
21 changes: 20 additions & 1 deletion tests/testthat/test-methods-epi_df.R
Original file line number Diff line number Diff line change
Expand Up @@ -173,11 +173,30 @@ test_that("Renaming columns while grouped gives appropriate colnames and metadat
expect_identical(attr(renamed_gedf1, "metadata")$other_keys, c("age_group"))
# renaming using select
renamed_gedf2 <- gedf %>%
as_epi_df(additional_metadata = list(other_keys = "age")) %>%
select(geo_value, time_value, age_group = age, value)
expect_identical(renamed_gedf1, renamed_gedf2)
})

test_that("Additional `select` on `epi_df` tests", {
edf <- tibble::tibble(geo_value = "ak", time_value = as.Date("2020-01-01"), age = 1, value = 1) %>%
as_epi_df(additional_metadata = list(other_keys = "age"))

# Dropping a non-geo_value epikey column doesn't decay, though maybe it
# should, since you'd expect that to possibly result in multiple rows per
# epikey (though not in this toy case), and while we don't require that, we
# sort of expect it:
edf_not_decayed <- edf %>%
select(geo_value, time_value, value)
expect_class(edf_not_decayed, "epi_df")
expect_identical(attr(edf_not_decayed, "metadata")$other_keys, character(0L))

# Dropping geo_value does decay:
edf_decayed <- edf %>%
select(age, time_value, value)
expect_false(inherits(edf_decayed, "epi_df"))
expect_identical(attr(edf_decayed, "metadata"), NULL)
})

test_that("complete.epi_df works", {
start_date <- as.Date("2020-01-01")
daily_edf <- tibble::tribble(
Expand Down