From 5edafd2e9b831dcee591757f74a573161dabeae3 Mon Sep 17 00:00:00 2001 From: prockenschaub Date: Tue, 4 Oct 2022 15:02:34 +0200 Subject: [PATCH] Fix AUMC difftime calculation --- R/data-load.R | 37 ++++++++++++++++++++++++++++++++++--- 1 file changed, 34 insertions(+), 3 deletions(-) diff --git a/R/data-load.R b/R/data-load.R index 711f6d43..c1e8be7b 100644 --- a/R/data-load.R +++ b/R/data-load.R @@ -132,7 +132,7 @@ load_difftime.eicu_tbl <- function(x, rows, cols = colnames(x), warn_dots(...) - load_eiau(x, {{ rows }}, cols, id_hint, time_vars, min_as_mins) + load_ei(x, {{ rows }}, cols, id_hint, time_vars, min_as_mins) } #' @rdname load_src @@ -154,7 +154,7 @@ load_difftime.aumc_tbl <- function(x, rows, cols = colnames(x), warn_dots(...) - load_eiau(x, {{ rows }}, cols, id_hint, time_vars, ms_as_mins) + load_au(x, {{ rows }}, cols, id_hint, time_vars) } #' @rdname load_src @@ -227,7 +227,38 @@ load_mihi <- function(x, rows, cols, id_hint, time_vars) { as_id_tbl(dat, id_vars = id_col, by_ref = TRUE) } -load_eiau <- function(x, rows, cols, id_hint, time_vars, mins_fun) { +load_au <- function(x, rows, cols, id_hint, time_vars) { + # TODO: this is closely related to load_mihi, extract common functionality + # and remove code duplication + dt_round_min <- function(x, y) round_to(ms_as_mins(x - y)) + + id_col <- resolve_id_hint(x, id_hint) + + assert_that(is.string(id_col), id_col %in% colnames(x)) + + if (!id_col %in% cols) { + cols <- c(cols, id_col) + } + + time_vars <- intersect(time_vars, cols) + + dat <- load_src(x, {{ rows }}, cols) + + if (length(time_vars)) { + + dat <- merge(dat, id_origin(x, id_col, origin_name = "origin"), + by = id_col) + dat <- dat[, + c(time_vars) := lapply(.SD, dt_round_min, get("origin")), + .SDcols = time_vars + ] + dat <- dat[, c("origin") := NULL] + } + + as_id_tbl(dat, id_vars = id_col, by_ref = TRUE) +} + +load_ei <- function(x, rows, cols, id_hint, time_vars, mins_fun) { id_col <- resolve_id_hint(x, id_hint)