refactor+doc: key_colnames and vignettes

* key_colnames order change
* replace kill_time_value with exclude arg in key_colnames
* move duplicate time_values check in epi_slide

Author: dshemetov

.Rbuildignore

@@ -16,3 +16,5 @@
 ^.lintr$
 ^DEVELOPMENT.md$
 man-roxygen
+^.venv$
+^sandbox.R$

.gitignore

@@ -13,3 +13,4 @@ docs
 renv/
 renv.lock
 .Rprofile
+sandbox.R

DESCRIPTION

@@ -50,7 +50,8 @@ Imports:
     tidyselect (>= 1.2.0),
     tsibble,
     utils,
-    vctrs
+    vctrs,
+    waldo
 Suggests:
     covidcast,
     devtools,

NAMESPACE

@@ -55,10 +55,8 @@ export("%>%")
 export(archive_cases_dv_subset)
 export(arrange)
 export(arrange_canonical)
-export(as_diagonal_slide_computation)
 export(as_epi_archive)
 export(as_epi_df)
-export(as_time_slide_computation)
 export(as_tsibble)
 export(autoplot)
 export(clone)

R/autoplot.R

@@ -55,7 +55,7 @@ autoplot.epi_df <- function(
 
   key_cols <- key_colnames(object)
   non_key_cols <- setdiff(names(object), key_cols)
-  geo_and_other_keys <- kill_time_value(key_cols)
+  geo_and_other_keys <- key_colnames(object, exclude = "time_value")
 
   # --- check for numeric variables
   allowed <- purrr::map_lgl(object[non_key_cols], is.numeric)

R/epi_df.R

@@ -184,18 +184,14 @@ new_epi_df <- function(x = tibble::tibble(geo_value = character(), time_value =
   metadata$other_keys <- other_keys
 
   # Reorder columns (geo_value, time_value, ...)
-  if (sum(dim(x)) != 0) {
-    cols_to_put_first <- c("geo_value", "time_value", other_keys)
-    x <- x[, c(
-      cols_to_put_first,
-      # All other columns
-      names(x)[!(names(x) %in% cols_to_put_first)]
-    )]
+  if (nrow(x) > 0) {
+    x <- x %>% relocate(all_of(c("geo_value", other_keys, "time_value")), .before = 1)
   }
 
   # Apply epi_df class, attach metadata, and return
   class(x) <- c("epi_df", class(x))
   attributes(x)$metadata <- metadata
+
   return(x)
 }
 
@@ -281,6 +277,7 @@ as_epi_df.tbl_df <- function(
   if (".time_value_counts" %in% other_keys) {
     cli_abort("as_epi_df: `other_keys` can't include \".time_value_counts\"")
   }
+
   duplicated_time_values <- x %>%
     group_by(across(all_of(c("geo_value", "time_value", other_keys)))) %>%
     filter(dplyr::n() > 1) %>%

R/grouped_epi_archive.R

@@ -397,8 +397,8 @@ epix_slide.grouped_epi_archive <- function(
               )),
               capture.output(print(waldo::compare(
                 res[[comp_nms[[comp_i]]]], comp_value[[comp_i]],
-                x_arg = rlang::expr_deparse(expr(`$`(label, !!sym(comp_nms[[comp_i]])))),
-                y_arg = rlang::expr_deparse(expr(`$`(comp_value, !!sym(comp_nms[[comp_i]]))))
+                x_arg = rlang::expr_deparse(dplyr::expr(`$`(label, !!sym(comp_nms[[comp_i]])))), # nolint: object_usage_linter
+                y_arg = rlang::expr_deparse(dplyr::expr(`$`(comp_value, !!sym(comp_nms[[comp_i]]))))
               ))),
               cli::format_message(c(
                 "You likely want to rename or remove this column in your output, or debug why it has a different value."

R/key_colnames.R

@@ -2,39 +2,46 @@
 #'
 #' @param x a data.frame, tibble, or epi_df
 #' @param ... additional arguments passed on to methods
-#'
-#' @return If an `epi_df`, this returns all "keys". Otherwise `NULL`
+#' @param other_keys an optional character vector of other keys to include
+#' @param exclude an optional character vector of keys to exclude
+#' @return If an `epi_df`, this returns all "keys". Otherwise `NULL`.
 #' @keywords internal
 #' @export
 key_colnames <- function(x, ...) {
   UseMethod("key_colnames")
 }
 
+#' @rdname key_colnames
+#' @method key_colnames default
 #' @export
 key_colnames.default <- function(x, ...) {
   character(0L)
 }
 
+#' @rdname key_colnames
+#' @method key_colnames data.frame
 #' @export
-key_colnames.data.frame <- function(x, other_keys = character(0L), ...) {
+key_colnames.data.frame <- function(x, other_keys = character(0L), exclude = character(0L), ...) {
   assert_character(other_keys)
-  nm <- c("geo_value", "time_value", other_keys)
+  assert_character(exclude)
+  nm <- setdiff(c("geo_value", other_keys, "time_value"), exclude)
   intersect(nm, colnames(x))
 }
 
+#' @rdname key_colnames
+#' @method key_colnames epi_df
 #' @export
-key_colnames.epi_df <- function(x, ...) {
+key_colnames.epi_df <- function(x, exclude = character(0L), ...) {
+  assert_character(exclude)
   other_keys <- attr(x, "metadata")$other_keys
-  c("geo_value", "time_value", other_keys)
+  setdiff(c("geo_value", other_keys, "time_value"), exclude)
 }
 
+#' @rdname key_colnames
+#' @method key_colnames epi_archive
 #' @export
-key_colnames.epi_archive <- function(x, ...) {
+key_colnames.epi_archive <- function(x, exclude = character(0L), ...) {
+  assert_character(exclude)
   other_keys <- attr(x, "metadata")$other_keys
-  c("geo_value", "time_value", other_keys)
-}
-
-kill_time_value <- function(v) {
-  assert_character(v)
-  v[v != "time_value"]
+  setdiff(c("geo_value", other_keys, "time_value"), exclude)
 }

R/methods-epi_archive.R

@@ -731,7 +731,7 @@ epix_detailed_restricted_mutate <- function(.data, ...) {
 #' library(dplyr)
 #'
 #' # Reference time points for which we want to compute slide values:
-#' versions <- seq(as.Date("2020-06-01"),
+#' versions <- seq(as.Date("2020-06-02"),
 #'   as.Date("2020-06-15"),
 #'   by = "1 day"
 #' )
@@ -780,7 +780,7 @@ epix_detailed_restricted_mutate <- function(.data, ...) {
 #'     .versions = versions
 #'   ) %>%
 #'   ungroup() %>%
-#'   arrange(geo_value, time_value)
+#'   arrange(geo_value, version)
 #'
 #' # --- Advanced: ---
 #'

R/methods-epi_df.R

@@ -41,10 +41,13 @@ as_tibble.epi_df <- function(x, ...) {
 #' @export
 as_tsibble.epi_df <- function(x, key, ...) {
   if (missing(key)) key <- c("geo_value", attributes(x)$metadata$other_keys)
-  return(as_tsibble(tibble::as_tibble(x),
-    key = tidyselect::all_of(key), index = "time_value",
-    ...
-  ))
+  return(
+    as_tsibble(
+      tibble::as_tibble(x),
+      key = tidyselect::all_of(key), index = "time_value",
+      ...
+    )
+  )
 }
 
 #' Base S3 methods for an `epi_df` object
@@ -150,10 +153,10 @@ dplyr_reconstruct.epi_df <- function(data, template) {
   # keep any grouping that has been applied:
   res <- NextMethod()
 
-  cn <- names(res)
+  col_names <- names(res)
 
   # Duplicate columns, cli_abort
-  dup_col_names <- cn[duplicated(cn)]
+  dup_col_names <- col_names[duplicated(col_names)]
   if (length(dup_col_names) != 0) {
     cli_abort(c(
       "Duplicate column names are not allowed",
@@ -163,7 +166,7 @@ dplyr_reconstruct.epi_df <- function(data, template) {
     ))
   }
 
-  not_epi_df <- !("time_value" %in% cn) || !("geo_value" %in% cn)
+  not_epi_df <- !("time_value" %in% col_names) || !("geo_value" %in% col_names)
 
   if (not_epi_df) {
     # If we're calling on an `epi_df` from one of our own functions, we need to
@@ -182,7 +185,7 @@ dplyr_reconstruct.epi_df <- function(data, template) {
 
   # Amend additional metadata if some other_keys cols are dropped in the subset
   old_other_keys <- attr(template, "metadata")$other_keys
-  attr(res, "metadata")$other_keys <- old_other_keys[old_other_keys %in% cn]
+  attr(res, "metadata")$other_keys <- old_other_keys[old_other_keys %in% col_names]
 
   res
 }
@@ -424,9 +427,13 @@ arrange_col_canonical.epi_df <- function(x, ...) {
   x %>% dplyr::relocate(dplyr::all_of(cols), .before = 1)
 }
 
+#' Group an `epi_df` object by default keys
+#' @param x an `epi_df`
+#' @param exclude character vector of column names to exclude from grouping
+#' @return a grouped `epi_df`
 #' @export
-group_epi_df <- function(x) {
-  cols <- kill_time_value(key_colnames(x))
+group_epi_df <- function(x, exclude = character()) {
+  cols <- key_colnames(x, exclude = exclude)
   x %>% group_by(across(all_of(cols)))
 }
 
@@ -437,7 +444,7 @@ group_epi_df <- function(x) {
 #' the resulting `epi_df` will have `geo_value` set to `"total"`.
 #'
 #' @param .x an `epi_df`
-#' @param value_col character vector of the columns to aggregate
+#' @param sum_cols character vector of the columns to aggregate
 #' @param group_cols character vector of column names to group by. "time_value" is
 #' included by default.
 #' @return an `epi_df` object