Fix compactification with dist_quantiles columns

Author: brookslogan

NAMESPACE

@@ -99,12 +99,14 @@ export(time_column_names)
 export(ungroup)
 export(unnest)
 export(validate_epi_archive)
+export(vec_position_lag)
 export(version_column_names)
 importFrom(checkmate,anyInfinite)
 importFrom(checkmate,anyMissing)
 importFrom(checkmate,assert)
 importFrom(checkmate,assert_character)
 importFrom(checkmate,assert_class)
+importFrom(checkmate,assert_count)
 importFrom(checkmate,assert_data_frame)
 importFrom(checkmate,assert_function)
 importFrom(checkmate,assert_int)
@@ -232,4 +234,8 @@ importFrom(tidyselect,starts_with)
 importFrom(tsibble,as_tsibble)
 importFrom(utils,capture.output)
 importFrom(utils,tail)
+importFrom(vctrs,obj_check_vector)
+importFrom(vctrs,vec_c)
 importFrom(vctrs,vec_cast)
+importFrom(vctrs,vec_size)
+importFrom(vctrs,vec_slice)

R/archive.R

@@ -385,6 +385,23 @@ removed_by_compactify <- function(df, keys, tolerance) {
     )) # nolint: object_usage_linter
 }
 
+#' Lag entries in a vctrs-style vector by their position in the vector
+#'
+#' @importFrom checkmate assert_count
+#' @importFrom vctrs obj_check_vector vec_slice vec_size
+#' @keywords internal
+#' @importFrom vctrs vec_c vec_slice vec_size
+#' @export
+vec_position_lag <- function(x, n) {
+  # obj_check_vector(x)
+  assert_count(n)
+  if (length(x) == 0L) {
+    x
+  } else {
+    vec_c(rep(NA, n), vec_slice(x, seq_len(vec_size(x) - 1L)))
+  }
+}
+
 #' Checks to see if a value in a vector is LOCF
 #' @description
 #' LOCF meaning last observation carried forward. lags the vector by 1, then
@@ -394,8 +411,8 @@ removed_by_compactify <- function(df, keys, tolerance) {
 #' @importFrom dplyr lag if_else near
 #' @keywords internal
 is_locf <- function(vec, tolerance) { # nolint: object_usage_linter
-  lag_vec <- dplyr::lag(vec)
-  if (typeof(vec) == "double") {
+  lag_vec <- vec_position_lag(vec, 1L)
+  if (inherits(vec, "numeric")) { # (no matrix/array/general support)
     res <- if_else(
       !is.na(vec) & !is.na(lag_vec),
       near(vec, lag_vec, tol = tolerance),