From 83d0346839b6ae5e291d8fd9de91dd62f42efcc2 Mon Sep 17 00:00:00 2001 From: Peter Dutey Date: Fri, 5 Aug 2022 16:22:08 +0100 Subject: [PATCH] add extend_table_start parameter in TherapyEpisode and Encounter to allow earlier start of longitudinal tables #86 --- DESCRIPTION | 2 +- NEWS.md | 4 + R/objects.R | 77 ++++++++-- man/Encounter.Rd | 8 +- man/TherapyEpisode.Rd | 10 +- tests/testthat/test-objects.R | 48 +++++- tests/testthat/test-warehousing-duckdb.R | 166 +++++++++++++++++---- tests/testthat/test-warehousing-postgres.R | 134 +++++++++++++---- vignettes/therapy-episodes.Rmd | 66 +++++++- 9 files changed, 437 insertions(+), 78 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index f14cff6..369078d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: Ramses Type: Package Title: R Package for Antimicrobial Stewardship & Surveillance -Version: 0.4.3 +Version: 0.5.0 Authors@R: c( person(given = "Peter", family = "Dutey-Magni", diff --git a/NEWS.md b/NEWS.md index ccfffb9..11a7c08 100644 --- a/NEWS.md +++ b/NEWS.md @@ -13,6 +13,10 @@ of class `RamsesObject` to manipulate hospitalisations (admissions) with associated methods for `show()`, `compute()`, `collect()`, `Patient()`, `longitudinal_table()`, `clinical_feature_*()` +* `TherapyEpisode()` and `Encounter()` have a new optional `extend_table_start` input +controlling their longitudinal table's start. This allows the creation of longitudinal +tables starting before the `therapy_start` or `admission_date`, respectively. More +detail is available from [`vignette("therapy-episodes")`](https://ramses-antibiotics.web.app/articles/therapy-episodes.html) ## Breaking changes diff --git a/R/objects.R b/R/objects.R index 6c68e04..2fe1c45 100644 --- a/R/objects.R +++ b/R/objects.R @@ -108,6 +108,11 @@ setGeneric(name = "Patient", def = Patient) #' @slot longitudinal_table a \code{tbl_sql} for the longitudinal encounter table #' @param id an encounter identifier #' @param conn a database connection +#' @param extend_table_start optional integer to specify an earlier start +#' (in hours) in the longitudinal table of the object. For example, a value of +#' 6 means the longitudinal table will begin 6 hours prior to the admission +#' date. The value must be a positive number. Decimal numbers will be +#' rounded up to the nearest integer. The default is \code{NULL}. #' @rdname Encounter #' @export setClass( @@ -118,7 +123,8 @@ setClass( #' @rdname Encounter #' @export -Encounter <- function(conn, id) { +Encounter <- function(conn, id, extend_table_start = NULL) { + id <- sort(na.omit(unique(id))) if ( is.null(id) | length(id) < 1) { stop("`id` must contain at least one identifier") @@ -133,6 +139,8 @@ Encounter <- function(conn, id) { stop(paste("`id` must be", id_data_type)) } + extend_table_start <- .validate_extended_table_input(extend_table_start) + record <- dplyr::inner_join( tbl(conn, "inpatient_episodes"), dplyr::tibble(encounter_id = id), @@ -140,7 +148,8 @@ Encounter <- function(conn, id) { longitudinal_table <- .longitudinal_table_create.Encounter( conn = conn, - id = id + id = id, + extend_table_start = extend_table_start ) # TODO @@ -154,13 +163,19 @@ Encounter <- function(conn, id) { longitudinal_table = longitudinal_table) } + #' Create the therapy episode longitudinal table #' #' @param conn a database connection #' @param id a vector of encounter identifiers +#' @param extend_table_start optional integer to specify an earlier start +#' (in hours) in the longitudinal table of the object. For example, a value of +#' 6 means the longitudinal table will begin 6 hours prior to the start of +#' therapy. The value must be a positive number. Decimal numbers will be +#' rounded up to the nearest integer. The default is \code{NULL}. #' @noRd -.longitudinal_table_create.Encounter <- function(conn, id) { - +.longitudinal_table_create.Encounter <- function(conn, id, extend_table_start) { + .build_tally_table(conn) longitudinal_table <- dplyr::inner_join( @@ -175,8 +190,9 @@ Encounter <- function(conn, id) { if(is(conn, "PqConnection") | is(conn, "duckdb_connection")) { tbl(conn, "ramses_tally") %>% + dplyr::mutate(t = .data$t - as.integer(extend_table_start)) %>% dplyr::full_join(longitudinal_table, by = character()) %>% - dplyr::mutate(t_start = dplyr::sql("admission_date + interval '1h' * t "))%>% + dplyr::mutate(t_start = dplyr::sql("admission_date + interval '1h' * t ")) %>% dplyr::filter(.data$t_start < .data$discharge_date) %>% dplyr::mutate(t_end = dplyr::sql("admission_date + interval '1h' * (t + 1)")) %>% dplyr::group_by(.data$patient_id, .data$encounter_id) %>% @@ -261,6 +277,11 @@ MedicationRequest <- function(conn, id) { #' @param conn a database connection #' @param object an object of class \code{MedicationRequest} or #' \code{Prescription} +#' @param extend_table_start optional integer to specify an earlier start +#' (in hours) in the longitudinal table of the object. For example, a value of +#' 6 means the longitudinal table will begin 6 hours prior to the start of +#' antimicrobial therapy. The value must be a positive number. Decimal numbers +#' will be rounded up to the nearest integer. The default is \code{NULL}. #' @rdname TherapyEpisode #' @export setClass( @@ -278,7 +299,8 @@ TherapyEpisode <- function(...) { #' @rdname TherapyEpisode #' @export -TherapyEpisode.DBIConnection <- function(conn, id) { +TherapyEpisode.DBIConnection <- function(conn, id, extend_table_start = NULL) { + id <- sort(na.omit(unique(id))) if ( is.null(id) | length(id) < 1) { stop("`id` must contain at least one identifier") @@ -293,12 +315,16 @@ TherapyEpisode.DBIConnection <- function(conn, id) { stop(paste("`id` must be", id_data_type)) } + extend_table_start <- .validate_extended_table_input(extend_table_start) + record <- dplyr::inner_join( tbl(conn, "drug_therapy_episodes"), dplyr::tibble(therapy_id = id), by = "therapy_id", copy = TRUE) - longitudinal_table <- .longitudinal_table_create.TherapyEpisode(conn = conn, - id = id) + longitudinal_table <- .longitudinal_table_create.TherapyEpisode( + conn = conn, + id = id, + extend_table_start) longitudinal_table <- .longitudinal_table_parenteral_indicator(longitudinal_table) new("TherapyEpisode", id = id, @@ -309,7 +335,7 @@ TherapyEpisode.DBIConnection <- function(conn, id) { #' @rdname TherapyEpisode #' @export -TherapyEpisode.RamsesObject <- function(object) { +TherapyEpisode.RamsesObject <- function(object, extend_table_start = NULL) { if( !is(object, "MedicationRequest") & !is(object, "Prescription") ) { stop("`object` must be of class `MedicationRequest` or `Prescription`") @@ -318,7 +344,7 @@ TherapyEpisode.RamsesObject <- function(object) { record <- collect(object) id <- unique(na.omit(record$therapy_id)) - TherapyEpisode.DBIConnection(conn = conn, id = id) + TherapyEpisode.DBIConnection(conn = conn, id = id, extend_table_start = extend_table_start) } #' @export @@ -330,9 +356,14 @@ setGeneric(name = "TherapyEpisode", def = TherapyEpisode) #' #' @param conn a database connection #' @param id a vector of therapy episode character identifiers (by design, Ramses creates -#' this as the identifier of the first prescription ordered in an episode) +#' this as the identifier of the first prescription ordered in an episode) +#' @param extend_table_start optional integer to specify an earlier start +#' (in hours) in the longitudinal table of the object. For example, a value of +#' 6 means the longitudinal table will begin 6 hours prior to the admission +#' date. The value must be a positive number. Decimal numbers will be +#' rounded up to the nearest integer. The default is \code{NULL}. #' @noRd -.longitudinal_table_create.TherapyEpisode <- function(conn, id) { +.longitudinal_table_create.TherapyEpisode <- function(conn, id, extend_table_start) { .build_tally_table(conn) @@ -348,6 +379,7 @@ setGeneric(name = "TherapyEpisode", def = TherapyEpisode) if(is(conn, "PqConnection") | is(conn, "duckdb_connection")) { tbl(conn, "ramses_tally") %>% + dplyr::mutate(t = .data$t - as.integer(extend_table_start)) %>% dplyr::full_join(longitudinal_table, by = character()) %>% dplyr::mutate(t_start = dplyr::sql("therapy_start + interval '1h' * t "))%>% dplyr::filter(.data$t_start < .data$therapy_end) %>% @@ -787,3 +819,24 @@ setMethod("compute", "TherapyEpisode", function(x) { x }) + + + +#' Return a single positive integer +#' +#' @param x input +#' @noRd +.validate_extended_table_input <- function(x) { + if ( is.null(x) || all(is.na(x)) ) { + x <- 0 + } + if ( length(x) > 1 || !is.numeric(x) ) { + stop("`", substitute(x), "` must be a numeric or integer of length 1.") + } + if ( x < 0 ) { + stop("`", substitute(x), "` must be >= 0") + } + x <- ceiling(x) + + x +} \ No newline at end of file diff --git a/man/Encounter.Rd b/man/Encounter.Rd index f3d55b9..0f478c8 100644 --- a/man/Encounter.Rd +++ b/man/Encounter.Rd @@ -6,12 +6,18 @@ \alias{Encounter} \title{An S4 class to represent inpatient encounters} \usage{ -Encounter(conn, id) +Encounter(conn, id, extend_table_start = NULL) } \arguments{ \item{conn}{a database connection} \item{id}{an encounter identifier} + +\item{extend_table_start}{optional integer to specify an earlier start +(in hours) in the longitudinal table of the object. For example, a value of +6 means the longitudinal table will begin 6 hours prior to the admission +date. The value must be a positive number. Decimal numbers will be +rounded up to the nearest integer. The default is \code{NULL}.} } \description{ An S4 class to represent inpatient encounters diff --git a/man/TherapyEpisode.Rd b/man/TherapyEpisode.Rd index 99c6801..7fe71e0 100644 --- a/man/TherapyEpisode.Rd +++ b/man/TherapyEpisode.Rd @@ -10,9 +10,9 @@ \usage{ TherapyEpisode(...) -TherapyEpisode.DBIConnection(conn, id) +TherapyEpisode.DBIConnection(conn, id, extend_table_start = NULL) -TherapyEpisode.RamsesObject(object) +TherapyEpisode.RamsesObject(object, extend_table_start = NULL) } \arguments{ \item{...}{generic signature} @@ -24,6 +24,12 @@ database field \code{drug_therapy_episodes.therapy_id} as generated by \code{\link{load_medications}()} or \code{\link{create_therapy_episodes}()})} +\item{extend_table_start}{optional integer to specify an earlier start +(in hours) in the longitudinal table of the object. For example, a value of +6 means the longitudinal table will begin 6 hours prior to the start of +antimicrobial therapy. The value must be a positive number. Decimal numbers +will be rounded up to the nearest integer. The default is \code{NULL}.} + \item{object}{an object of class \code{MedicationRequest} or \code{Prescription}} } diff --git a/tests/testthat/test-objects.R b/tests/testthat/test-objects.R index 6732716..a8845af 100644 --- a/tests/testthat/test-objects.R +++ b/tests/testthat/test-objects.R @@ -894,4 +894,50 @@ test_that("Encounter..interface_methods Postgres", { forget <- therapy_table(encounter_object), "^'therapy_table' is deprecated[.]" ) -}) \ No newline at end of file +}) + +test_that(".validate_extended_table_input", { + invalid_input <- 1:2 + expect_error( + .validate_extended_table_input(invalid_input), + "`invalid_input` must be a numeric or integer of length 1" + ) + expect_error( + .validate_extended_table_input(-1) + ) + expect_error( + .validate_extended_table_input("1") + ) + expect_equal( + .validate_extended_table_input(NULL), + 0 + ) + expect_equal( + .validate_extended_table_input(NA), + 0 + ) + expect_equal( + .validate_extended_table_input(1), + 1 + ) + expect_equal( + .validate_extended_table_input(1L), + 1 + ) + expect_equal( + .validate_extended_table_input(1.1), + 2 + ) + expect_equal( + .validate_extended_table_input(1.9), + 2 + ) + expect_equal( + .validate_extended_table_input(0.1), + 1 + ) + expect_equal( + .validate_extended_table_input(0), + 0 + ) +}) diff --git a/tests/testthat/test-warehousing-duckdb.R b/tests/testthat/test-warehousing-duckdb.R index 0daf13f..08a404a 100644 --- a/tests/testthat/test-warehousing-duckdb.R +++ b/tests/testthat/test-warehousing-duckdb.R @@ -321,14 +321,10 @@ test_that("Ramses on DuckDB (system test)", { t = 0:5, patient_id = "99999999999", therapy_id = "5528fc41106bb48eb4d48bc412e13e67", - therapy_start = structure(c(1438939620, 1438939620, 1438939620, 1438939620, - 1438939620, 1438939620), tzone = "Europe/London", class = c("POSIXct", "POSIXt")), - therapy_end = structure(c(1439810400, 1439810400, 1439810400, 1439810400, - 1439810400, 1439810400), tzone = "Europe/London", class = c("POSIXct", "POSIXt")), - t_start = structure(c(1438939620, 1438943220, 1438946820, 1438950420, - 1438954020, 1438957620), tzone = "Europe/London", class = c("POSIXct", "POSIXt")), - t_end = structure(c(1438943220, 1438946820, 1438950420, 1438954020, - 1438957620, 1438961220), tzone = "Europe/London", class = c("POSIXct", "POSIXt")), + therapy_start = structure(1438939620, tzone = "Europe/London", class = c("POSIXct", "POSIXt")), + therapy_end = structure(1439810400, tzone = "Europe/London", class = c("POSIXct", "POSIXt")), + t_start = structure(1438939620 + 0:5 * 3600, tzone = "Europe/London", class = c("POSIXct", "POSIXt")), + t_end = structure(c(1438939620 + 1:6 * 3600), tzone = "Europe/London", class = c("POSIXct", "POSIXt")), parenteral = 1L ) test_expected_tail <- dplyr::tibble( @@ -337,20 +333,41 @@ test_that("Ramses on DuckDB (system test)", { therapy_id = "5528fc41106bb48eb4d48bc412e13e67", therapy_start = structure(1438939620, tzone = "Europe/London", class = c("POSIXct", "POSIXt")), therapy_end = structure(1439810400, tzone = "Europe/London", class = c("POSIXct", "POSIXt")), - t_start = structure(c(1439789220, 1439792820, 1439796420, 1439800020, - 1439803620, 1439807220), tzone = "Europe/London", class = c("POSIXct", "POSIXt")), - t_end = structure(c(1439792820, 1439796420, 1439800020, 1439803620, 1439807220, - 1439810400), tzone = "Europe/London", class = c("POSIXct", "POSIXt")), + t_start = structure(1438939620 + 236:241 * 3600, tzone = "Europe/London", class = c("POSIXct", "POSIXt")), + t_end = structure(c(1438939620 + 237:241 * 3600, 1439810400), tzone = "Europe/London", class = c("POSIXct", "POSIXt")), parenteral = 0L ) expect_equal(head(test_output), test_expected_head) expect_equal(tail(test_output), test_expected_tail) expect_equal( - sum(difftime(test_output$t_end, test_output$t_start,units = "hours")), + sum(difftime(test_output$t_end, test_output$t_start,units = "hours")), structure(241.883333333333, class = "difftime", units = "hours") ) + test_episode_extended <- TherapyEpisode(db_conn, "5528fc41106bb48eb4d48bc412e13e67", + extend_table_start = 2) + test_output_extended <- longitudinal_table(test_episode_extended, collect = T) + + test_expected_head_extended <- dplyr::tibble( + t = -2:3, + patient_id = "99999999999", + therapy_id = "5528fc41106bb48eb4d48bc412e13e67", + therapy_start = structure(1438939620, tzone = "Europe/London", class = c("POSIXct", "POSIXt")), + therapy_end = structure(1439810400, tzone = "Europe/London", class = c("POSIXct", "POSIXt")), + t_start = structure(1438939620 + -2:3 * 3600, tzone = "Europe/London", class = c("POSIXct", "POSIXt")), + t_end = structure(c(1438939620 + -1:4 * 3600), tzone = "Europe/London", class = c("POSIXct", "POSIXt")), + parenteral = c(NA, 1L, 1L, 1L, 1L, 1L) + ) + expect_equal(head(test_output_extended), test_expected_head_extended) + expect_equal(tail(test_output_extended), test_expected_tail) + expect_equal( + sum(difftime(test_output_extended$t_end, test_output_extended$t_start, units = "hours")), + structure(241.883333333333 + 2, class = "difftime", units = "hours") + ) + + # TherapyEpisode() method for MedicationRequest object + test_medication_request <- MedicationRequest(db_conn, "5528fc41106bb48eb4d48bc412e13e67") expect_is(test_medication_request, "MedicationRequest") expect_is(TherapyEpisode(test_medication_request), "TherapyEpisode") @@ -374,18 +391,10 @@ test_that("Ramses on DuckDB (system test)", { t = 117:122, patient_id = "8258333156", therapy_id = "f770855cf9d424c76fdfbc9786d508ac", - therapy_start = structure( - c(1444239793, 1444239793, 1444239793, 1444239793, - 1444239793, 1444239793), tzone = "Europe/London", class = c("POSIXct", "POSIXt")), - therapy_end = structure( - c(1444681333, 1444681333, 1444681333, 1444681333, - 1444681333, 1444681333), tzone = "Europe/London", class = c("POSIXct", "POSIXt")), - t_start = structure( - c(1444660993, 1444664593, 1444668193, 1444671793, - 1444675393, 1444678993), tzone = "Europe/London", class = c("POSIXct", "POSIXt")), - t_end = structure( - c(1444664593, 1444668193, 1444671793, 1444675393, - 1444678993, 1444681333), tzone = "Europe/London", class = c("POSIXct", "POSIXt")), + therapy_start = structure(1444239793, tzone = "Europe/London", class = c("POSIXct", "POSIXt")), + therapy_end = structure(1444681333, tzone = "Europe/London", class = c("POSIXct", "POSIXt")), + t_start = structure(1444239793 + 117:122 * 3600, tzone = "Europe/London", class = c("POSIXct", "POSIXt")), + t_end = structure(c(1444239793 + 118:122 * 3600, 1444681333), tzone = "Europe/London", class = c("POSIXct", "POSIXt")), parenteral = 0L ) expect_equal(head(longitudinal_table(test_episode, collect = TRUE)), @@ -394,6 +403,39 @@ test_that("Ramses on DuckDB (system test)", { expect_equal(tail(longitudinal_table(test_episode, collect = TRUE)), test_expected_tail_second_therapy_episode) + + test_episode_extended <- TherapyEpisode( + conn = db_conn, + id = c("f770855cf9d424c76fdfbc9786d508ac", + "5528fc41106bb48eb4d48bc412e13e67"), + extend_table_start = 2 + ) + + test_expected_head_second_episode <- dplyr::tibble( + t = -2:3, + patient_id = "8258333156", + therapy_id = "f770855cf9d424c76fdfbc9786d508ac", + therapy_start = structure(1444239793, tzone = "Europe/London", class = c("POSIXct", "POSIXt")), + therapy_end = structure(1444681333, tzone = "Europe/London", class = c("POSIXct", "POSIXt")), + t_start = structure(1444239793 + -2:3 * 3600, tzone = "Europe/London", class = c("POSIXct", "POSIXt")), + t_end = structure(1444239793 + -1:4 * 3600, tzone = "Europe/London", class = c("POSIXct", "POSIXt")), + parenteral = c(NA, 1L, 1L, 1L, 1L, 1L) + ) + + expect_equal( + head(longitudinal_table(test_episode_extended, collect = TRUE)), + test_expected_head_extended + ) + expect_equal( + tail(longitudinal_table(test_episode_extended, collect = TRUE)), + test_expected_tail_second_therapy_episode + ) + expect_equal( + head(dplyr::filter(longitudinal_table(test_episode_extended, collect = TRUE), + .data$therapy_id == "f770855cf9d424c76fdfbc9786d508ac")), + test_expected_head_second_episode + ) + # TherapyEpisode .longitudinal_table_completeness_check ------------------------------------- expect_true( @@ -783,7 +825,6 @@ test_that("Encounter class on DuckDB", { # Encounter ------------------------------------------------------------------ - # Single IVPO change pt 99999999999 test_encounter <- Encounter(db_conn, "3968305736") test_output <- longitudinal_table(test_encounter, collect = T) test_expected_head <- dplyr::tibble( @@ -812,6 +853,26 @@ test_that("Encounter class on DuckDB", { sum(collect(test_encounter)[["ramses_bed_days"]]) ) + test_encounter_extended <- Encounter(db_conn, "3968305736", extend_table_start = 2) + test_output_extended <- longitudinal_table(test_encounter_extended, collect = T) + + test_expected_head_extended <- dplyr::tibble( + t = -2:3, + patient_id = "99999999999", + encounter_id = "3968305736", + admission_date = structure(1486982520, tzone = "UTC", class = c("POSIXct", "POSIXt")), + discharge_date = structure(1487932800, tzone = "UTC", class = c("POSIXct", "POSIXt")), + t_start = structure(1486982520 + -2:3*3600, tzone = "UTC", class = c("POSIXct", "POSIXt")), + t_end = structure(1486982520 + -1:4*3600, tzone = "UTC", class = c("POSIXct", "POSIXt")) + ) + + expect_equal(head(test_output_extended), test_expected_head_extended) + expect_equal(tail(test_output_extended), test_expected_tail) + expect_equal( + as.numeric(sum(difftime(test_output_extended$t_end, test_output_extended$t_start, units = "days"))), + sum(collect(test_encounter)[["ramses_bed_days"]]) + 2/24 + ) + # 2+ Encounters -------------------------------------------------------------- test_encounter <- Encounter(conn = db_conn, @@ -834,6 +895,44 @@ test_that("Encounter class on DuckDB", { expect_equal(tail(longitudinal_table(test_encounter, collect = TRUE)), test_expected_tail_second_encounter) + test_encounter_extended <- Encounter(conn = db_conn, + id = c("3968305736", "9278078393"), + extend_table_start = 2) + + test_expected_head_second_encounter <- dplyr::tibble( + t = -2:3, + patient_id = "99999999999", + encounter_id = "9278078393", + admission_date = structure(1459332000, class = c("POSIXct", "POSIXt"), tzone = "UTC"), + discharge_date = structure(1459425600, class = c("POSIXct", "POSIXt"), tzone = "UTC"), + t_start = structure(1459332000 + -2:3*3600, tzone = "UTC", class = c("POSIXct", "POSIXt")), + t_end = structure(c(1459332000 + -1:4*3600), tzone = "UTC", class = c("POSIXct", "POSIXt")) + ) + + test_expected_tail_second_encounter <- dplyr::tibble( + t = 20:25, + patient_id = "99999999999", + encounter_id = "9278078393", + admission_date = structure(1459332000, class = c("POSIXct", "POSIXt"), tzone = "UTC"), + discharge_date = structure(1459425600, class = c("POSIXct", "POSIXt"), tzone = "UTC"), + t_start = structure(1459332000 + 20:25*3600, tzone = "UTC", class = c("POSIXct", "POSIXt")), + t_end = structure(c(1459332000 + 21:25*3600, 1459425600), tzone = "UTC", class = c("POSIXct", "POSIXt")) + ) + + expect_equal( + head(longitudinal_table(test_encounter_extended, collect = TRUE)), + test_expected_head_extended + ) + expect_equal( + tail(longitudinal_table(test_encounter_extended, collect = TRUE)), + test_expected_tail_second_encounter + ) + expect_equal( + head(dplyr::filter(longitudinal_table(test_encounter_extended, collect = TRUE), + .data$encounter_id == 9278078393)), + test_expected_head_second_encounter + ) + # Encounter .longitudinal_table_completeness_check --------------------------- expect_true( @@ -873,14 +972,29 @@ test_that("Encounter class on DuckDB", { ) %>% longitudinal_table(collect = T) + last_temp_extended_1h <- clinical_feature_last( + Encounter(db_conn, "9278078393", extend_table_start = 1), + observation_code = "8310-5", + hours = 24 + ) %>% + longitudinal_table(collect = T) + expect_equal( last_temp$last_temperature_24h[1:5], c(NA, NA, NA, 35.7, 35.7) ) + expect_equal( + last_temp_extended_1h$last_temperature_24h[1:6], + c(NA, NA, NA, NA, 35.7, 35.7) + ) expect_equal( last_temp$last_temperature_24h[21:25], c(37.1, 37.1, 37.1, 37.1, 37.1) ) + expect_equal( + last_temp_extended_1h$last_temperature_24h[22:26], + c(37.1, 37.1, 37.1, 37.1, 37.1) + ) rm(last_temp) last_temp_2encounters <- clinical_feature_last( diff --git a/tests/testthat/test-warehousing-postgres.R b/tests/testthat/test-warehousing-postgres.R index 5190d07..affdd0d 100644 --- a/tests/testthat/test-warehousing-postgres.R +++ b/tests/testthat/test-warehousing-postgres.R @@ -351,38 +351,53 @@ test_that("Ramses on PosgreSQL (system test)", { t = 0:5, patient_id = "99999999999", therapy_id = "5528fc41106bb48eb4d48bc412e13e67", - therapy_start = as.POSIXct("2015-08-07 10:27:00", tz = "Europe/London"), - therapy_end = as.POSIXct("2015-08-17 12:20:00", tz = "Europe/London"), - t_start = as.POSIXct( - c("2015-08-07 10:27:00", "2015-08-07 11:27:00", "2015-08-07 12:27:00", - "2015-08-07 13:27:00", "2015-08-07 14:27:00", "2015-08-07 15:27:00"), tz = "Europe/London"), - t_end = as.POSIXct( - c("2015-08-07 11:27:00", "2015-08-07 12:27:00", "2015-08-07 13:27:00", - "2015-08-07 14:27:00", "2015-08-07 15:27:00", "2015-08-07 16:27:00"), tz = "Europe/London"), + therapy_start = structure(1438939620, tzone = "Europe/London", class = c("POSIXct", "POSIXt")), + therapy_end = structure(1439810400, tzone = "Europe/London", class = c("POSIXct", "POSIXt")), + t_start = structure(1438939620 + 0:5 * 3600, tzone = "Europe/London", class = c("POSIXct", "POSIXt")), + t_end = structure(c(1438939620 + 1:6 * 3600), tzone = "Europe/London", class = c("POSIXct", "POSIXt")), parenteral = 1L ) test_expected_tail <- dplyr::tibble( t = 236:241, patient_id = "99999999999", therapy_id = "5528fc41106bb48eb4d48bc412e13e67", - therapy_start = as.POSIXct("2015-08-07 10:27:00", tz = "Europe/London"), - therapy_end = as.POSIXct("2015-08-17 12:20:00", tz = "Europe/London"), - t_start = as.POSIXct( - c("2015-08-17 06:27:00", "2015-08-17 07:27:00", "2015-08-17 08:27:00", - "2015-08-17 09:27:00", "2015-08-17 10:27:00", "2015-08-17 11:27:00"), tz = "Europe/London"), - t_end = as.POSIXct( - c("2015-08-17 07:27:00", "2015-08-17 08:27:00", "2015-08-17 09:27:00", "2015-08-17 10:27:00", - "2015-08-17 11:27:00", "2015-08-17 12:20:00"), tz = "Europe/London"), + therapy_start = structure(1438939620, tzone = "Europe/London", class = c("POSIXct", "POSIXt")), + therapy_end = structure(1439810400, tzone = "Europe/London", class = c("POSIXct", "POSIXt")), + t_start = structure(1438939620 + 236:241 * 3600, tzone = "Europe/London", class = c("POSIXct", "POSIXt")), + t_end = structure(c(1438939620 + 237:241 * 3600, 1439810400), tzone = "Europe/London", class = c("POSIXct", "POSIXt")), parenteral = 0L ) expect_equal(head(test_output), test_expected_head) expect_equal(tail(test_output), test_expected_tail) expect_equal( - sum(difftime(test_output$t_end, test_output$t_start,units = "hours")), + sum(difftime(test_output$t_end, test_output$t_start,units = "hours")), structure(241.883333333333, class = "difftime", units = "hours") ) + test_episode_extended <- TherapyEpisode(pq_conn, "5528fc41106bb48eb4d48bc412e13e67", + extend_table_start = 2) + test_output_extended <- longitudinal_table(test_episode_extended, collect = T) + + test_expected_head_extended <- dplyr::tibble( + t = -2:3, + patient_id = "99999999999", + therapy_id = "5528fc41106bb48eb4d48bc412e13e67", + therapy_start = structure(1438939620, tzone = "Europe/London", class = c("POSIXct", "POSIXt")), + therapy_end = structure(1439810400, tzone = "Europe/London", class = c("POSIXct", "POSIXt")), + t_start = structure(1438939620 + -2:3 * 3600, tzone = "Europe/London", class = c("POSIXct", "POSIXt")), + t_end = structure(c(1438939620 + -1:4 * 3600), tzone = "Europe/London", class = c("POSIXct", "POSIXt")), + parenteral = c(NA, 1L, 1L, 1L, 1L, 1L) + ) + expect_equal(head(test_output_extended), test_expected_head_extended) + expect_equal(tail(test_output_extended), test_expected_tail) + expect_equal( + sum(difftime(test_output_extended$t_end, test_output_extended$t_start, units = "hours")), + structure(241.883333333333 + 2, class = "difftime", units = "hours") + ) + + # TherapyEpisode() method for MedicationRequest object + test_medication_request <- MedicationRequest(pq_conn, "5528fc41106bb48eb4d48bc412e13e67") expect_is(test_medication_request, "MedicationRequest") expect_is(TherapyEpisode(test_medication_request), "TherapyEpisode") @@ -406,18 +421,10 @@ test_that("Ramses on PosgreSQL (system test)", { t = 117:122, patient_id = "8258333156", therapy_id = "f770855cf9d424c76fdfbc9786d508ac", - therapy_start = structure( - c(1444239793, 1444239793, 1444239793, 1444239793, - 1444239793, 1444239793), tzone = "Europe/London", class = c("POSIXct", "POSIXt")), - therapy_end = structure( - c(1444681333, 1444681333, 1444681333, 1444681333, - 1444681333, 1444681333), tzone = "Europe/London", class = c("POSIXct", "POSIXt")), - t_start = structure( - c(1444660993, 1444664593, 1444668193, 1444671793, - 1444675393, 1444678993), tzone = "Europe/London", class = c("POSIXct", "POSIXt")), - t_end = structure( - c(1444664593, 1444668193, 1444671793, 1444675393, - 1444678993, 1444681333), tzone = "Europe/London", class = c("POSIXct", "POSIXt")), + therapy_start = structure(1444239793, tzone = "Europe/London", class = c("POSIXct", "POSIXt")), + therapy_end = structure(1444681333, tzone = "Europe/London", class = c("POSIXct", "POSIXt")), + t_start = structure(1444239793 + 117:122 * 3600, tzone = "Europe/London", class = c("POSIXct", "POSIXt")), + t_end = structure(c(1444239793 + 118:122 * 3600, 1444681333), tzone = "Europe/London", class = c("POSIXct", "POSIXt")), parenteral = 0L ) expect_equal(head(longitudinal_table(test_episode, collect = TRUE)), @@ -425,6 +432,38 @@ test_that("Ramses on PosgreSQL (system test)", { expect_equal(tail(longitudinal_table(test_episode, collect = TRUE)), test_expected_tail_second_therapy_episode) + test_episode_extended <- TherapyEpisode( + conn = pq_conn, + id = c("f770855cf9d424c76fdfbc9786d508ac", + "5528fc41106bb48eb4d48bc412e13e67"), + extend_table_start = 2 + ) + + test_expected_head_second_episode <- dplyr::tibble( + t = -2:3, + patient_id = "8258333156", + therapy_id = "f770855cf9d424c76fdfbc9786d508ac", + therapy_start = structure(1444239793, tzone = "Europe/London", class = c("POSIXct", "POSIXt")), + therapy_end = structure(1444681333, tzone = "Europe/London", class = c("POSIXct", "POSIXt")), + t_start = structure(1444239793 + -2:3 * 3600, tzone = "Europe/London", class = c("POSIXct", "POSIXt")), + t_end = structure(1444239793 + -1:4 * 3600, tzone = "Europe/London", class = c("POSIXct", "POSIXt")), + parenteral = c(NA, 1L, 1L, 1L, 1L, 1L) + ) + + expect_equal( + head(longitudinal_table(test_episode_extended, collect = TRUE)), + test_expected_head_extended + ) + expect_equal( + tail(longitudinal_table(test_episode_extended, collect = TRUE)), + test_expected_tail_second_therapy_episode + ) + expect_equal( + head(dplyr::filter(longitudinal_table(test_episode_extended, collect = TRUE), + .data$therapy_id == "f770855cf9d424c76fdfbc9786d508ac")), + test_expected_head_second_episode + ) + # TherapyEpisode .longitudinal_table_completeness_check ------------------------------------- expect_true( @@ -849,7 +888,6 @@ test_that("Encounter class on Postgres", { )) # Encounter ------------------------------------------------------------------ - # Single IVPO change pt 99999999999 test_encounter <- Encounter(pq_conn, "3968305736") test_output <- longitudinal_table(test_encounter, collect = T) test_expected_head <- dplyr::tibble( @@ -878,6 +916,26 @@ test_that("Encounter class on Postgres", { sum(collect(test_encounter)[["ramses_bed_days"]]) ) + test_encounter_extended <- Encounter(pq_conn, "3968305736", extend_table_start = 2) + test_output_extended <- longitudinal_table(test_encounter_extended, collect = T) + + test_expected_head_extended <- dplyr::tibble( + t = -2:3, + patient_id = "99999999999", + encounter_id = "3968305736", + admission_date = structure(1486982520, tzone = "UTC", class = c("POSIXct", "POSIXt")), + discharge_date = structure(1487932800, tzone = "UTC", class = c("POSIXct", "POSIXt")), + t_start = structure(1486982520 + -2:3*3600, tzone = "UTC", class = c("POSIXct", "POSIXt")), + t_end = structure(1486982520 + -1:4*3600, tzone = "UTC", class = c("POSIXct", "POSIXt")) + ) + + expect_equal(head(test_output_extended), test_expected_head_extended) + expect_equal(tail(test_output_extended), test_expected_tail) + expect_equal( + as.numeric(sum(difftime(test_output_extended$t_end, test_output_extended$t_start, units = "days"))), + sum(collect(test_encounter)[["ramses_bed_days"]]) + 2/24 + ) + # 2+ Encounters -------------------------------------------------------------- test_encounter <- Encounter(conn = pq_conn, @@ -939,14 +997,30 @@ test_that("Encounter class on Postgres", { ) %>% longitudinal_table(collect = T) + last_temp_extended_1h <- clinical_feature_last( + Encounter(pq_conn, "9278078393", extend_table_start = 1), + observation_code = "8310-5", + hours = 24 + ) %>% + longitudinal_table(collect = T) + expect_equal( last_temp$last_temperature_24h[1:5], c(NA, NA, NA, 35.7, 35.7) ) + expect_equal( + last_temp_extended_1h$last_temperature_24h[1:6], + c(NA, NA, NA, NA, 35.7, 35.7) + ) expect_equal( last_temp$last_temperature_24h[21:25], c(37.1, 37.1, 37.1, 37.1, 37.1) ) + expect_equal( + last_temp_extended_1h$last_temperature_24h[22:26], + c(37.1, 37.1, 37.1, 37.1, 37.1) + ) + rm(last_temp) last_temp_2encounters <- clinical_feature_last( diff --git a/vignettes/therapy-episodes.Rmd b/vignettes/therapy-episodes.Rmd index 3bcc8c3..40e0399 100644 --- a/vignettes/therapy-episodes.Rmd +++ b/vignettes/therapy-episodes.Rmd @@ -176,14 +176,15 @@ For more information on S4 classes used in Ramses and their associated methods, # Longitudinal analysis -## Longitudinal tables +## Therapy tables Therapy episodes can be studied by creating a longitudinal, hour-by-hour matrix called 'longitudinal table'. -```{r longitudinal_table_code, eval=FALSE} -longitudinal_table(uti_episode, collect = TRUE) +```{r therapy_table_code, eval=FALSE} +longitudinal_table(uti_episode, collect = TRUE) %>% + select(t, therapy_start, therapy_end, t_start, t_end, parenteral) ``` -```{r longitudinal_table_output, echo=FALSE, paged.print=TRUE} +```{r therapy_table_output, echo=FALSE, paged.print=TRUE} longitudinal_table(uti_episode, collect = TRUE) %>% select(t, therapy_start, therapy_end, t_start, t_end, parenteral) %>% rmarkdown::paged_table() @@ -212,9 +213,62 @@ parenteral_changes(TherapyEpisode(ramses_db, "a028cf950c29ca73c01803b54642d513") In this example, parenteral therapy was first initiated at $t$ = 0, then converted to oral administration at $t$ = 97, until $t$ = 144. A new sequence of parenteral therapy begins at $t$ = 146, all within the same therapy episode. + +## Encounter tables + +Encounters (hospitalisations) can also be used to +generate longitudinal tables thanks to the `Encounter()` function. In the example +below, an encounter table is created for the same patient `99999999998` for +encounter `8895465895`, which is the same admission during which antimicrobial +therapy episode `d7c0310a08cf9f0f318276125cd282ed` was administered. + +Like therapy tables, encounter tables can be enhanced with [clinical features](#adding-clinical-features). + + +```{r encounter_table_code, eval=FALSE} +Encounter(ramses_db, "8895465895") %>% + longitudinal_table(collect = TRUE) %>% + select(t, admission_date, discharge_date, t_start, t_end) +``` +```{r encounter_output, echo=FALSE, paged.print=TRUE} +Encounter(ramses_db, "8895465895") %>% + longitudinal_table(collect = TRUE) %>% + select(t, admission_date, discharge_date, t_start, t_end) %>% + rmarkdown::paged_table() +``` + +## Extended longitudinal tables + +Both therapy and encounter tables can be extended so they begin earlier than +the start of antimicrobial therapy, or the admission date, respectively. Doing +so is controlled by the `TherapyEpisode` and `Encounter` objects via an +optional parameter `extend_table_start`. This parameter expresses how many +hours earlier the table should start. + +For example, the encounter table can be made to begin 5 hours before admission. +This can be very useful if the patient is known to have stayed in the Emergency +Department before being admitted: + + +```{r extended_encounter_table_code, echo=FALSE} +Encounter(ramses_db, "8895465895", extend_table_start = 5) %>% + longitudinal_table(collect = TRUE) %>% + select(t, admission_date, discharge_date, t_start, t_end) +``` + + +```{r extended_encounter_table, include=FALSE} +Encounter(ramses_db, "8895465895", extend_table_start = 5) %>% + longitudinal_table(collect = TRUE) %>% + select(t, admission_date, discharge_date, t_start, t_end) %>% + rmarkdown::paged_table() +``` + +The `extend_table_start` parameter may also be used in the `TherapyEpisode()` function. + ## Adding clinical features -Several functions can enhance therapy tables with variables characterising the clinical state and trajectory of the patient. For instance, we may be interested in temperature: +Several functions can enhance both therapy and encounter tables with variables characterising the clinical state and trajectory of the patient. For instance, we may be interested in temperature: - `clinical_feature_last()` fetches the most recent temperature value. - `clinical_feature_mean()` computes a running arithmetic mean of the temperature time series. @@ -256,6 +310,8 @@ Note that the intercept is defined for $t$ = `t_start`. In other words, its valu We can see that, at the time of therapy initiation, the neutrophil count was increasing by an average 0.09 per nanoliter every hour (neutrophilia). After 80 hours (day 3), we find first evidence of the neutrophil count going down at a rate of 0.09 per nanoliter every hour, returning to a normal range (2--7.5 109/L). Depending on the patient's other vitals, this could indicate the infection is under control. + + ```{r dbDisconnect, include=FALSE} DBI::dbDisconnect(ramses_db, shutdown = TRUE) file.remove("ramses-db.duckdb")