simplify load_difftime to a single function

load_mihi, load_au, and load_ei only differ in the rounding function they apply (and the fact that eicu strictly speaking doesn't require merging of origin). They can thus all be replaced with a single function that receives the rounding function as a parameter.

R/data-load.R

@@ -119,8 +119,8 @@ load_difftime.mimic_tbl <- function(x, rows, cols = colnames(x),
  time_vars = ricu::time_vars(x), ...) {
 
  warn_dots(...)
-
- load_mihi(x, {{ rows }}, cols, id_hint, time_vars)
+ dt_round_min <- function(x, y) round_to(difftime(x, y, units = "mins"))
+ do_load_difftime(x, {{ rows }}, cols, id_hint, time_vars, dt_round_min)
 }
 
 #' @rdname load_src
@@ -130,8 +130,8 @@ load_difftime.eicu_tbl <- function(x, rows, cols = colnames(x),
  time_vars = ricu::time_vars(x), ...) {
 
  warn_dots(...)
-
- load_ei(x, {{ rows }}, cols, id_hint, time_vars, min_as_mins)
+ dt_round_min <- function(x, y) min_as_mins(x)
+ do_load_difftime(x, {{ rows }}, cols, id_hint, time_vars, dt_round_min)
 }
 
 #' @rdname load_src
@@ -141,8 +141,8 @@ load_difftime.hirid_tbl <- function(x, rows, cols = colnames(x),
  time_vars = ricu::time_vars(x), ...) {
 
  warn_dots(...)
-
- load_mihi(x, {{ rows }}, cols, id_hint, time_vars)
+ dt_round_min <- function(x, y) round_to(difftime(x, y, units = "mins"))
+ do_load_difftime(x, {{ rows }}, cols, id_hint, time_vars, dt_round_min)
 }
 
 #' @rdname load_src
@@ -152,8 +152,8 @@ load_difftime.aumc_tbl <- function(x, rows, cols = colnames(x),
  time_vars = ricu::time_vars(x), ...) {
 
  warn_dots(...)
-
- load_au(x, {{ rows }}, cols, id_hint, time_vars)
+ dt_round_min <- function(x, y) round_to(ms_as_mins(x - y))
+ do_load_difftime(x, {{ rows }}, cols, id_hint, time_vars, dt_round_min)
 }
 
 #' @rdname load_src
@@ -163,8 +163,8 @@ load_difftime.miiv_tbl <- function(x, rows, cols = colnames(x),
  time_vars = ricu::time_vars(x), ...) {
 
  warn_dots(...)
-
- load_mihi(x, {{ rows }}, cols, id_hint, time_vars)
+ dt_round_min <- function(x, y) round_to(difftime(x, y, units = "mins"))
+ do_load_difftime(x, {{ rows }}, cols, id_hint, time_vars, dt_round_min)
 }
 
 #' @rdname load_src
@@ -195,41 +195,7 @@ resolve_id_hint <- function(tbl, hint) {
  id_vars(opts[hits])
 }
 
-load_mihi <- function(x, rows, cols, id_hint, time_vars) {
-
- dt_round_min <- function(x, y) round_to(difftime(x, y, units = "mins"))
-
- 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_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))
+do_load_difftime <- function(x, rows, cols, id_hint, time_vars, time_fn) {
 
  id_col <- resolve_id_hint(x, id_hint)
 
@@ -247,35 +213,14 @@ load_au <- function(x, rows, cols, id_hint, 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")),
+ c(time_vars) := lapply(.SD, time_fn, 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)
-
- if (!id_col %in% cols) {
- cols <- c(id_col, cols)
- }
-
- time_vars <- intersect(time_vars, cols)
-
- dat <- load_src(x, {{ rows }}, cols)
-
- if (length(time_vars)) {
-
- assert_that(has_col(dat, id_col))
-
- dat <- dat[, c(time_vars) := lapply(.SD, mins_fun), .SDcols = time_vars]
- }
-
  as_id_tbl(dat, id_vars = id_col, by_ref = TRUE)
 }