Merge remote-tracking branch 'upstream/dev' into 446-promote-other_keys

Resolve conflict regarding testing tz (US/Aleutian instead of alternative UTC or
old buggy ET).

Author: brookslogan

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: epiprocess
 Title: Tools for basic signal processing in epidemiology
-Version: 0.8.3
+Version: 0.8.4
 Authors@R: c(
     person("Jacob", "Bien", role = "ctb"),
     person("Logan", "Brooks", , "[email protected]", role = c("aut", "cre")),

NAMESPACE

@@ -2,6 +2,8 @@
 
 S3method("[",epi_df)
 S3method("names<-",epi_df)
+S3method(arrange_canonical,default)
+S3method(arrange_canonical,epi_df)
 S3method(as_epi_df,data.frame)
 S3method(as_epi_df,epi_df)
 S3method(as_epi_df,tbl_df)
@@ -45,6 +47,7 @@ S3method(unnest,epi_df)
 export("%>%")
 export(archive_cases_dv_subset)
 export(arrange)
+export(arrange_canonical)
 export(as_epi_archive)
 export(as_epi_df)
 export(as_tsibble)

NEWS.md

@@ -18,6 +18,7 @@ Pre-1.0.0 numbering scheme: 0.x will indicate releases, while 0.x.y will indicat
 ## Bug fixes
 
 - Fix `epi_slide_opt` (and related functions) to correctly handle `before=Inf`.
+  Also allow multiple columns specified as a list of strings.
 - Disallow `after=Inf` in slide functions, since it doesn't seem like a likely
   use case and complicates code.
 

R/key_colnames.R

@@ -18,20 +18,20 @@ key_colnames.default <- function(x, ...) {
 #' @export
 key_colnames.data.frame <- function(x, other_keys = character(0L), ...) {
   assert_character(other_keys)
-  nm <- c("time_value", "geo_value", other_keys)
+  nm <- c("geo_value", "time_value", other_keys)
   intersect(nm, colnames(x))
 }
 
 #' @export
 key_colnames.epi_df <- function(x, ...) {
   other_keys <- attr(x, "metadata")$other_keys
-  c("time_value", "geo_value", other_keys)
+  c("geo_value", "time_value", other_keys)
 }
 
 #' @export
 key_colnames.epi_archive <- function(x, ...) {
   other_keys <- attr(x, "metadata")$other_keys
-  c("time_value", "geo_value", other_keys)
+  c("geo_value", "time_value", other_keys)
 }
 
 kill_time_value <- function(v) {

R/methods-epi_archive.R

@@ -240,16 +240,75 @@ epix_fill_through_version <- function(x, fill_versions_end,
 #'   earliest version that could be clobbered in either input archive.
 #'
 #' @examples
-#' # create two example epi_archive datasets
-#' x <- archive_cases_dv_subset$DT %>%
-#'   dplyr::select(geo_value, time_value, version, case_rate_7d_av) %>%
-#'   as_epi_archive(compactify = TRUE)
-#' y <- archive_cases_dv_subset$DT %>%
-#'   dplyr::select(geo_value, time_value, version, percent_cli) %>%
-#'   as_epi_archive(compactify = TRUE)
-#' # merge results stored in a third object:
-#' xy <- epix_merge(x, y)
+#' # Example 1
+#' # The s1 signal at August 1st gets revised from 10 to 11 on August 2nd
+#' s1 <- tibble::tibble(
+#'   geo_value = c("ca", "ca", "ca"),
+#'   time_value = as.Date(c("2024-08-01", "2024-08-01", "2024-08-02")),
+#'   version = as.Date(c("2024-08-01", "2024-08-02", "2024-08-02")),
+#'   signal1 = c(10, 11, 7)
+#' )
+#'
+#' s2 <- tibble::tibble(
+#'   geo_value = c("ca", "ca"),
+#'   time_value = as.Date(c("2024-08-01", "2024-08-02")),
+#'   version = as.Date(c("2024-08-03", "2024-08-03")),
+#'   signal2 = c(2, 3)
+#' )
+#'
+#'
+#' s1 <- s1 %>% as_epi_archive()
+#' s2 <- s2 %>% as_epi_archive()
+#'
+#' merged <- epix_merge(s1, s2, sync = "locf")
+#' merged[["DT"]]
+#'
+#' # Example 2
+#' # The s1 signal at August 1st gets revised from 12 to 13 on August 3rd
+#' s1 <- tibble::tibble(
+#'   geo_value = c("ca", "ca", "ca", "ca"),
+#'   time_value = as.Date(c("2024-08-01", "2024-08-01", "2024-08-02", "2024-08-03")),
+#'   version = as.Date(c("2024-08-01", "2024-08-03", "2024-08-03", "2024-08-03")),
+#'   signal1 = c(12, 13, 22, 19)
+#' )
+#'
+#' s2 <- tibble::tibble(
+#'   geo_value = c("ca", "ca"),
+#'   time_value = as.Date(c("2024-08-01", "2024-08-02")),
+#'   version = as.Date(c("2024-08-02", "2024-08-02")),
+#'   signal2 = c(4, 5),
+#' )
+#'
+#'
+#' s1 <- s1 %>% as_epi_archive()
+#' s2 <- s2 %>% as_epi_archive()
+#'
+#' merged <- epix_merge(s1, s2, sync = "locf")
+#' merged[["DT"]]
+#'
+#'
+#' # Example 3:
+#' s1 <- tibble::tibble(
+#'   geo_value = c("ca", "ca", "ca"),
+#'   time_value = as.Date(c("2024-08-01", "2024-08-02", "2024-08-03")),
+#'   version = as.Date(c("2024-08-01", "2024-08-02", "2024-08-03")),
+#'   signal1 = c(14, 11, 9)
+#' )
+#'
+#' # The s2 signal at August 1st gets revised from 3 to 5 on August 3rd
+#' s2 <- tibble::tibble(
+#'   geo_value = c("ca", "ca", "ca"),
+#'   time_value = as.Date(c("2024-08-01", "2024-08-01", "2024-08-02")),
+#'   version = as.Date(c("2024-08-02", "2024-08-03", "2024-08-03")),
+#'   signal2 = c(3, 5, 2),
+#' )
+#'
+#' s1 <- s1 %>% as_epi_archive()
+#' s2 <- s2 %>% as_epi_archive()
 #'
+#' # Some LOCF for signal 1 as signal 2 gets updated
+#' merged <- epix_merge(s1, s2, sync = "locf")
+#' merged[["DT"]]
 #' @importFrom data.table key set setkeyv
 #' @export
 epix_merge <- function(x, y,

R/methods-epi_df.R

@@ -347,3 +347,36 @@ reclass <- function(x, metadata) {
   attributes(x)$metadata <- metadata
   return(x)
 }
+
+#' Arrange an epi_df into a standard order
+#'
+#' Moves [key_colnames()] to the left, then arranges rows based on that
+#' ordering. This function is mainly for use in tests and so that
+#' other function output will be in predictable order, where necessary.
+#'
+#' @param x an `epi_df`. Other objects will produce a warning and return as is.
+#' @param ... not used
+#'
+#' @keywords internal
+#' @export
+arrange_canonical <- function(x, ...) {
+  UseMethod("arrange_canonical")
+}
+
+#' @export
+arrange_canonical.default <- function(x, ...) {
+  rlang::check_dots_empty()
+  cli::cli_abort(c(
+    "`arrange_canonical()` is only meaningful for an {.cls epi_df}."
+  ))
+  return(x)
+}
+
+#' @export
+arrange_canonical.epi_df <- function(x, ...) {
+  rlang::check_dots_empty()
+  keys <- key_colnames(x)
+  x %>%
+    dplyr::relocate(dplyr::all_of(keys), .before = 1) %>%
+    dplyr::arrange(dplyr::across(dplyr::all_of(keys)))
+}

R/slide.R

@@ -39,7 +39,7 @@
 #'
 #' @importFrom lubridate days weeks
 #' @importFrom dplyr bind_rows group_vars filter select
-#' @importFrom rlang .data .env !! enquo enquos sym env missing_arg
+#' @importFrom rlang .data .env !! enquos sym env missing_arg
 #' @export
 #' @seealso [`epi_slide_opt`] [`epi_slide_mean`] [`epi_slide_sum`]
 #' @examples
@@ -327,7 +327,7 @@ epi_slide <- function(x, f, ..., before = NULL, after = NULL, ref_time_values =
 #'
 #' @template opt-slide-details
 #'
-#' @importFrom dplyr bind_rows mutate %>% arrange tibble select
+#' @importFrom dplyr bind_rows mutate %>% arrange tibble select all_of
 #' @importFrom rlang enquo quo_get_expr as_label expr_label caller_arg
 #' @importFrom tidyselect eval_select
 #' @importFrom purrr map map_lgl
@@ -509,7 +509,11 @@ epi_slide_opt <- function(x, col_names, f, ..., before = NULL, after = NULL, ref
   # positions of user-provided `col_names` into string column names. We avoid
   # using `names(pos)` directly for robustness and in case we later want to
   # allow users to rename fields via tidyselection.
-  pos <- eval_select(rlang::enquo(col_names), data = x, allow_rename = FALSE)
+  if (class(quo_get_expr(enquo(col_names))) == "character") {
+    pos <- eval_select(all_of(col_names), data = x, allow_rename = FALSE)
+  } else {
+    pos <- eval_select(enquo(col_names), data = x, allow_rename = FALSE)
+  }
   col_names_chr <- names(x)[pos]
   # Always rename results to "slide_value_<original column name>".
   result_col_names <- paste0("slide_value_", col_names_chr)

man-roxygen/opt-slide-params.R

@@ -1,9 +1,9 @@
 #' @param col_names <[`tidy-select`][dplyr_tidy_select]> An unquoted column
-#'  name(e.g., `cases`), multiple column names (e.g., `c(cases, deaths)`), or
-#'  [other tidy-select expression][tidyselect::language]. Variable names can
-#'  be used as if they were positions in the data frame, so expressions like
-#'  `x:y` can be used to select a range of variables. If you have the desired
-#'  column names stored in a vector `vars`, use `col_names = all_of(vars)`.
+#'   name(e.g., `cases`), multiple column names (e.g., `c(cases, deaths)`),
+#'   [other tidy-select expression][tidyselect::language], or a vector of
+#'   characters (e.g. `c("cases", "deaths")`). Variable names can be used as if
+#'   they were positions in the data frame, so expressions like `x:y` can be
+#'   used to select a range of variables.
 #'
 #'   The tidy-selection renaming interface is not supported, and cannot be used
 #'   to provide output column names; if you want to customize the output column