Fix names<-.epi_df, introduce failing test for renaming in select

Author: brookslogan

R/epi_df.R

@@ -122,6 +122,9 @@ new_epi_df = function(x = tibble::tibble(), geo_type, time_type, as_of,
   if (!is.list(additional_metadata)) {
     Abort("`additional_metadata` must be a list type.")
   }
+  if (is.null(additional_metadata[["other_keys"]])) {
+    additional_metadata[["other_keys"]] <- character(0L)
+  }
 
   # If geo type is missing, then try to guess it
   if (missing(geo_type)) {
@@ -334,4 +337,4 @@ as_epi_df.tbl_ts = function(x, geo_type, time_type, as_of,
 #' @export
 is_epi_df = function(x) {
   inherits(x, "epi_df")
-}
+}

R/group_by_epi_df_methods.R

@@ -2,7 +2,7 @@
 #' @export
 select.epi_df <- function(.data, ...) {
   selected <- NextMethod(.data)
-  return(dplyr_reconstruct(selected, .data))
+  return (dplyr_reconstruct(selected, .data))
 }
 
 # others to consider:

R/methods-epi_df.R

@@ -180,9 +180,16 @@ dplyr_row_slice.epi_df = function(data, i, ...) {
 #' @export
 `names<-.epi_df` = function(x, value) {
   old_names = names(x)
-  old_other_keys = attributes(x)$metadata$other_keys
+  old_other_keys = attr(x, "metadata")[["other_keys"]]
   result = NextMethod()
-  attributes(x)$metadata$other_keys <- value[match(old_other_keys, old_names)]
+  new_other_keys_almost <- value[match(old_other_keys, old_names)]
+  attr(result, "metadata")[["other_keys"]] <-
+    # patch until we require `other_keys` to be `chr`; match NULL-ness of input `other_keys`:
+    # if (length(new_other_keys_almost) == 0L) NULL
+    # if (is.null(old_other_keys)) NULL
+    # else new_other_keys_almost
+    new_other_keys_almost
+  # decay to non-`epi_df` if needed:
   dplyr::dplyr_reconstruct(result, result)
 }
 

tests/testthat/test-methods-epi_df.R

@@ -124,3 +124,17 @@ test_that("Metadata and grouping are dropped by `as_tibble`", {
     !any(c("metadata", "groups") %in% names(attributes(grouped_converted)))
   )
 })
+
+test_that("Renaming columns gives appropriate colnames and metadata", {
+  edf <- tibble::tibble(geo_value = 1, time_value = 1, age = 1, value = 1) %>%
+    as_epi_df(additional_metadata = list(other_keys = "age"))
+  renamed_edf1 <- edf %>%
+    `[`(c("geo_value", "time_value", "age", "value")) %>%
+    `names<-`(c("geo_value", "time_value", "age_group", "value"))
+  expect_identical(names(renamed_edf1), c("geo_value", "time_value", "age_group", "value"))
+  expect_identical(attr(renamed_edf1, "metadata")$other_keys, c("age_group"))
+  renamed_edf2 <- edf %>%
+    as_epi_df(additional_metadata = list(other_keys = "age")) %>%
+    select(geo_value, time_value, age_group = age, value)
+  expect_identical(renamed_edf1, renamed_edf2)
+})