Fix epix_merge sync="truncate" err (with=F no j), add tests

Also:
- Add an internal warning + recovery if our DT preprocessing unexpectedly
  produces a DT with a different key (although in a way that won't catch if we
  accidentally mutated the original DT's key and matched it in the intermediate
  DT). If this is triggered, we will likely need to rethink/bugfix some other DT
  usage in other code which may have made similar assumptions about certain DT
  operations not dropping/modifying the key.
- Edit the input to one set of epix_merge tests to make the truncate test more
  restrictive than it would have been otherwise, and edit a non-truncate test with
  an `expected` value that changes as a result.

Author: lcbrooks

R/methods-epi_archive.R

@@ -152,7 +152,7 @@ epix_fill_through_version = function(x, fill_versions_end,
 #' # vs. mutating x to hold the merge result:
 #' x$merge(y)
 #'
-#' @importFrom data.table key set
+#' @importFrom data.table key set setkeyv
 #' @export
 epix_merge = function(x, y,
                       sync = c("forbid","na","locf","truncate"),
@@ -215,18 +215,34 @@ epix_merge = function(x, y,
     y_DT = epix_fill_through_version(y, new_versions_end, sync)$DT
   } else if (sync == "truncate") {
     new_versions_end = min(x$versions_end, y$versions_end)
-    x_DT = x$DT[x[["DT"]][["version"]] <= new_versions_end, with=FALSE]
-    y_DT = y$DT[y[["DT"]][["version"]] <= new_versions_end, with=FALSE]
+    x_DT = x$DT[x[["DT"]][["version"]] <= new_versions_end, names(x$DT), with=FALSE]
+    y_DT = y$DT[y[["DT"]][["version"]] <= new_versions_end, names(y$DT), with=FALSE]
   } else Abort("unimplemented")
 
   if (!identical(key(x$DT), key(x_DT)) || !identical(key(y$DT), key(y_DT))) {
     Abort("preprocessing of data tables in merge changed the key unexpectedly",
           internal=TRUE)
   }
-  ## key(x_DT) should be the same as key(x$DT) and key(y_DT) should be the same
-  ## as key(y$DT). If we want to break this function into parts it makes sense
-  ## to use {x,y}_DT below, but this makes the error checks and messages look a
-  ## little weird and rely on the key-matching assumption above.
+  # key(x_DT) should be the same as key(x$DT) and key(y_DT) should be the same
+  # as key(y$DT). If we want to break this function into parts it makes sense
+  # to use {x,y}_DT below, but this makes the error checks and messages look a
+  # little weird and rely on the key-matching assumption above.
+  #
+  # Just go ahead and test the above assumption in case different versions of
+  # data.table or certain inputs cause different behavior:
+  x_DT_key_as_expected = identical(key(x$DT), key(x_DT))
+  y_DT_key_as_expected = identical(key(y$DT), key(y_DT))
+  if (!x_DT_key_as_expected || !y_DT_key_as_expected) {
+    Warn("
+      `epiprocess` internal warning (please report): pre-processing for
+      epix_merge unexpectedly resulted in an intermediate data table (or
+      tables) with a different key than the corresponding input archive.
+      Manually setting intermediate data table keys to the expected values.
+    ", internal=TRUE)
+    setkeyv(x_DT, key(x$DT))
+    setkeyv(y_DT, key(y$DT))
+  }
+
   if (!identical(sort(key(x_DT)), sort(key(y_DT)))) {
     Abort("
             The archives must have the same set of key column names; if the

tests/testthat/test-epix_merge.R

@@ -121,9 +121,13 @@ local({
 })
 
 local({
-  x = as_epi_archive(tibble::tibble(geo_value=1L, time_value=1L, version=1L, x_value=10L))
-  y = as_epi_archive(tibble::tibble(geo_value=1L, time_value=1L, version=5L, y_value=20L))
-  print(epix_merge(x,y, sync = "na"))
+  x = as_epi_archive(
+    tibble::tibble(geo_value=1L, time_value=1L, version=1L, x_value=10L),
+    versions_end = 3L
+  )
+  y = as_epi_archive(
+    tibble::tibble(geo_value=1L, time_value=1L, version=5L, y_value=20L)
+  )
   test_that('epix_merge forbids on sync default or "forbid"', {
     expect_error(epix_merge(x,y),
                  class="epiprocess__epix_merge_unresolved_sync")
@@ -136,8 +140,10 @@ local({
       as_epi_archive(tibble::tribble(
         ~geo_value, ~time_value, ~version, ~x_value, ~y_value,
         1L, 1L, 1L, 10L, NA_integer_,         # x updated, y not observed yet
-        1L, 1L, 2L, NA_integer_, NA_integer_, # NA-ing out x, y not observed yet
+        1L, 1L, 4L, NA_integer_, NA_integer_, # NA-ing out x, y not observed yet
         1L, 1L, 5L, NA_integer_, 20L,         # x still NA, y updated
+        # (we should not have a y vals -> NA update here; version 5 should be
+        # the `versions_end` of the result)
         ), clobberable_versions_start=1L)
     )
   })
@@ -151,6 +157,16 @@ local({
         ), clobberable_versions_start=1L)
     )
   })
+  test_that('epix_merge sync="truncate" works', {
+    expect_equal(
+      epix_merge(x,y, sync = "truncate"),
+      as_epi_archive(tibble::tribble(
+        ~geo_value, ~time_value, ~version, ~x_value, ~y_value,
+        1L, 1L, 1L, 10L, NA_integer_, # x updated, y not observed yet
+        # y's update beyond x's last update has been truncated
+        ), clobberable_versions_start=1L, versions_end=3L)
+    )
+  })
   x_no_conflict = as_epi_archive(tibble::tibble(geo_value=1L, time_value=1L, version=1L, x_value=10L))
   y_no_conflict = as_epi_archive(tibble::tibble(geo_value=1L, time_value=1L, version=1L, y_value=20L))
   xy_no_conflict_expected = as_epi_archive(tibble::tribble(
@@ -178,6 +194,12 @@ local({
       xy_no_conflict_expected
     )
   })
+  test_that('epix_merge sync="truncate" on no-conflict works', {
+    expect_equal(
+      epix_merge(x_no_conflict, y_no_conflict, sync = "truncate"),
+      xy_no_conflict_expected
+    )
+  })
 })