doc+test: update epix_merge tests and docs (#514)

Co-authored-by: rnayebi21 <[email protected]>
Co-authored-by: Dmitry Shemetov <[email protected]>

Author: rnayebi21

R/methods-epi_archive.R

@@ -245,16 +245,75 @@ epix_fill_through_version <- function(x, fill_versions_end,
 #'   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,

man/epiprocess.Rd

@@ -62,6 +62,95 @@ test_that("epix_merge merges and carries forward updates properly", {
   )
 
   expect_identical(xy, xy_expected)
+
+
+  s1 <- 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("XA", "XB", "XC")
+  )
+
+  s2 <- 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("YA", "YB")
+  )
+
+  s1 <- s1 %>% as_epi_archive()
+  s2 <- s2 %>% as_epi_archive()
+
+  merge1_expected <- tibble(
+    geo_value = rep("ca", 5),
+    time_value = as.Date(c("2024-08-01", "2024-08-01", "2024-08-01", "2024-08-02", "2024-08-02")),
+    version = as.Date(c("2024-08-01", "2024-08-02", "2024-08-03", "2024-08-02", "2024-08-03")),
+    signal1 = c("XA", "XB", "XB", "XC", "XC"),
+    signal2 = c(NA, NA, "YA", NA, "YB")
+  ) %>% as_epi_archive()
+
+  merged1 <- epix_merge(s1, s2, sync = "locf")
+
+  expect_identical(merged1, merge1_expected)
+
+  s1 <- 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("XA", "XB", "XC", "XD")
+  )
+
+  s2 <- 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("YA", "YB"),
+  )
+
+
+  s1 <- s1 %>% as_epi_archive()
+  s2 <- s2 %>% as_epi_archive()
+
+  merge2_expected <- tibble(
+    geo_value = rep("ca", 6),
+    time_value = as.Date(c("2024-08-01", "2024-08-01", "2024-08-01", "2024-08-02", "2024-08-02", "2024-08-03")),
+    version = as.Date(c("2024-08-01", "2024-08-02", "2024-08-03", "2024-08-02", "2024-08-03", "2024-08-03")),
+    signal1 = c("XA", "XA", "XB", NA, "XC", "XD"),
+    signal2 = c(NA, "YA", "YA", "YB", "YB", NA)
+  ) %>% as_epi_archive()
+
+  merged2 <- epix_merge(s1, s2, sync = "locf")
+
+  expect_identical(merged2, merge2_expected)
+
+  s1 <- 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("XA", "XB", "XC")
+  )
+
+  s2 <- 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("YA", "YB", "YC"),
+  )
+
+  s1 <- s1 %>% as_epi_archive()
+  s2 <- s2 %>% as_epi_archive()
+
+  merge3_expected <- tibble(
+    geo_value = rep("ca", 6),
+    time_value = as.Date(c("2024-08-01", "2024-08-01", "2024-08-01", "2024-08-02", "2024-08-02", "2024-08-03")),
+    version = as.Date(c("2024-08-01", "2024-08-02", "2024-08-03", "2024-08-02", "2024-08-03", "2024-08-03")),
+    signal1 = c("XA", "XA", "XA", "XB", "XB", "XC"),
+    signal2 = c(NA, "YA", "YB", NA, "YC", NA)
+  ) %>% as_epi_archive()
+
+  merged3 <- epix_merge(s1, s2, sync = "locf")
+
+  expect_identical(merged3, merge3_expected)
 })
 
 test_that("epix_merge forbids and warns on metadata and naming issues", {