From cef051412b0c69234c242a42f5c3d4ce9ebe2584 Mon Sep 17 00:00:00 2001 From: prockenschaub Date: Mon, 7 Nov 2022 11:46:47 +0100 Subject: [PATCH 1/5] Apply change_interval to dur_var too --- R/data-load.R | 2 +- R/data-utils.R | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/data-load.R b/R/data-load.R index 711f6d43..c4e04594 100644 --- a/R/data-load.R +++ b/R/data-load.R @@ -440,7 +440,7 @@ load_win.src_tbl <- function(x, rows, cols = colnames(x), id_var = id_vars(x), time_vars <- setdiff(intersect(time_vars, colnames(res)), dur_var) res <- change_id(res, id_var, x, cols = time_vars, keep_old_id = FALSE) - res <- change_interval(res, interval, time_vars, by_ref = TRUE) + res <- change_interval(res, interval, c(time_vars, dur_var), by_ref = TRUE) res } diff --git a/R/data-utils.R b/R/data-utils.R index 3e1020d5..77b45ae0 100644 --- a/R/data-utils.R +++ b/R/data-utils.R @@ -680,7 +680,7 @@ upgrade_id.ts_tbl <- function(x, target_id, src, cols = time_vars(x), ...) { map <- id_map(src, id_vars(x), target_id, sft, idx) - res <- map[x, on = meta_vars(x), roll = -Inf, rollends = TRUE] + res <- map[x, on = c(id_vars(x), index_var(x)), roll = -Inf, rollends = TRUE] res <- res[, c(cols) := lapply(.SD, `-`, get(sft)), .SDcols = cols] res <- as_ts_tbl(res, target_id, idx, mins(1L), by_ref = TRUE) From 311cd79aead195d5c90648510db391bcb6fc8e22 Mon Sep 17 00:00:00 2001 From: prockenschaub Date: Mon, 7 Nov 2022 11:59:57 +0100 Subject: [PATCH 2/5] Redo meta_vars(x), create upgrade_id.win_tbl instead --- R/data-utils.R | 30 +++++++++++++++++++++++++++++- 1 file changed, 29 insertions(+), 1 deletion(-) diff --git a/R/data-utils.R b/R/data-utils.R index 77b45ae0..7a6aa445 100644 --- a/R/data-utils.R +++ b/R/data-utils.R @@ -680,7 +680,7 @@ upgrade_id.ts_tbl <- function(x, target_id, src, cols = time_vars(x), ...) { map <- id_map(src, id_vars(x), target_id, sft, idx) - res <- map[x, on = c(id_vars(x), index_var(x)), roll = -Inf, rollends = TRUE] + res <- map[x, on = meta_vars(x), roll = -Inf, rollends = TRUE] res <- res[, c(cols) := lapply(.SD, `-`, get(sft)), .SDcols = cols] res <- as_ts_tbl(res, target_id, idx, mins(1L), by_ref = TRUE) @@ -689,6 +689,34 @@ upgrade_id.ts_tbl <- function(x, target_id, src, cols = time_vars(x), ...) { res } +#' @rdname change_id +#' @export +#' +upgrade_id.win_tbl <- function(x, target_id, src, cols = time_vars(x), ...) { + + assert_that(index_var(x) %in% cols) + + if (!is_one_min(interval(x))) { + warn_ricu("Changing the ID of non-minute resolution data will change the + interval to 1 minute", class = "non_min_id_change") + } + + sft <- new_names(x) + idx <- index_var(x) + dur <- dur_var(x) + + map <- id_map(src, id_vars(x), target_id, sft, idx) + + res <- map[x, on = c(id_vars(x), index_var(x)), roll = -Inf, rollends = TRUE] + res <- res[, c(cols) := lapply(.SD, `-`, get(sft)), .SDcols = cols] + + res <- as_win_tbl(res, target_id, idx, mins(1L), dur, by_ref = TRUE) + res <- rm_cols(res, sft, by_ref = TRUE) + + res +} + + #' @rdname change_id #' @export #' From f36b43066220071ecf97b5bab0bba362cdb19a2c Mon Sep 17 00:00:00 2001 From: prockenschaub Date: Mon, 7 Nov 2022 19:39:09 +0100 Subject: [PATCH 3/5] Apply change_interval to win_tbl in load_concepts --- R/concept-load.R | 3 +++ 1 file changed, 3 insertions(+) diff --git a/R/concept-load.R b/R/concept-load.R index 2f2c6d7e..89af7f78 100644 --- a/R/concept-load.R +++ b/R/concept-load.R @@ -562,6 +562,9 @@ load_concepts.itm <- function(x, patient_ids = NULL, id_type = "icustay", if (is_ts_tbl(res)) { res <- change_interval(res, interval, index_var(res), by_ref = TRUE) + } + if (is_win_tbl(res)) { + res <- change_interval(res, interval, dur_var(res), by_ref = TRUE) } res From 86b8e6fd491e91e79cb05584ffc98ca94fa5a426 Mon Sep 17 00:00:00 2001 From: prockenschaub Date: Mon, 7 Nov 2022 19:56:29 +0100 Subject: [PATCH 4/5] Change dur_var interval before index_var --- R/concept-load.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/concept-load.R b/R/concept-load.R index 89af7f78..5a3c5bf0 100644 --- a/R/concept-load.R +++ b/R/concept-load.R @@ -560,12 +560,12 @@ load_concepts.itm <- function(x, patient_ids = NULL, id_type = "icustay", res <- merge_patid(res, patient_ids) res <- do_callback(x, res) - if (is_ts_tbl(res)) { - res <- change_interval(res, interval, index_var(res), by_ref = TRUE) - } if (is_win_tbl(res)) { res <- change_interval(res, interval, dur_var(res), by_ref = TRUE) } + if (is_ts_tbl(res)) { + res <- change_interval(res, interval, index_var(res), by_ref = TRUE) + } res } From 92179571eaa278fa114a0863484a4be637567024 Mon Sep 17 00:00:00 2001 From: prockenschaub Date: Mon, 7 Nov 2022 20:22:07 +0100 Subject: [PATCH 5/5] Change win_tbl interval even if index_var correct Currently a ts_tbl with the same correct interval will never by seen by change_interval.ts_tbl. This seems unwanted, as it for example prevents a win_tbl with index_var(x) in hours and dur_var(x) in mins from being changed. --- R/concept-load.R | 5 ++--- R/tbl-utils.R | 4 +--- 2 files changed, 3 insertions(+), 6 deletions(-) diff --git a/R/concept-load.R b/R/concept-load.R index 5a3c5bf0..66b22c35 100644 --- a/R/concept-load.R +++ b/R/concept-load.R @@ -561,9 +561,8 @@ load_concepts.itm <- function(x, patient_ids = NULL, id_type = "icustay", res <- do_callback(x, res) if (is_win_tbl(res)) { - res <- change_interval(res, interval, dur_var(res), by_ref = TRUE) - } - if (is_ts_tbl(res)) { + res <- change_interval(res, interval, c(index_var(res), dur_var(res)), by_ref = TRUE) + } else if (is_ts_tbl(res)) { res <- change_interval(res, interval, index_var(res), by_ref = TRUE) } diff --git a/R/tbl-utils.R b/R/tbl-utils.R index ad40ba51..be042cdf 100644 --- a/R/tbl-utils.R +++ b/R/tbl-utils.R @@ -501,9 +501,7 @@ change_interval <- function(x, new_interval, cols = time_vars(x), assert_that(is_scalar(new_interval), is_interval(new_interval), is.flag(by_ref)) - if (!length(cols) || - (is_ts_tbl(x) && all_equal(interval(x), new_interval))) { - + if (!length(cols)) { return(x) }