RXR-550: bring 48-hour criteria to KDIGO staging definitions

R/calc_aki_stage.R

@@ -162,9 +162,7 @@ calc_aki_stage <- function (
     dat$stage[dat$baseline_scr_diff >= 0.5 | dat$scr >= 4.0] <- 3
 
   } else if (method == "kdigo") {
-    dat$stage[dat$scr / baseline_scr >= 1.5 | dat$baseline_scr_diff >= 0.3] <- 1
-    dat$stage[dat$scr / baseline_scr >= 2 ] <- 2
-    dat$stage[dat$scr / baseline_scr >= 3 | dat$scr >= 4 | (dat$egfr < 35 & age < 18)] <- 3
+    dat$stage <- kdigo_stage(dat = dat, baseline_scr = baseline_scr, age = age)
   }
 
   ## get max class, convert to character class:
@@ -200,3 +198,44 @@ calc_aki_stage <- function (
 
   return(obj)
 }
+
+#' Calculate AKI stage according to KDIGO criteria
+#'
+#' @param dat Data frame containing at least the following columns:
+#'  * `scr`: serum creatinine
+#'  * `t`: creatinine sample times in hours
+#'  * `baseline_scr_diff`: difference between baseline scr and scr at current
+#'     timepoint
+#'  * `egfr`: eGFR at timepoint
+#' @param baseline_scr Baseline serum creatinine value (numeric)
+#' @param age Patient age
+#' @md
+#'
+kdigo_stage <- function(dat, baseline_scr, age) {
+  stage <- rep(NA, nrow(dat))
+  for (i in seq_along(dat$t)) {
+    current_time <- dat$t[i]
+    last_48h <- which(dat$t < current_time & dat$t > (current_time - 48))
+    scr <- dat$scr[i]
+    scr_last_48h <- dat$scr[last_48h]
+    # An AKI has occurred if there's a rise by 0.3 mg/dl within 48 hours or if
+    # there's a rise to 1.5x baseline*. We only check for the 0.3 mg/dl rise if
+    # scr_last_48h contains at least one value, since otherwise we don't have
+    # any prior timepoints to compare to.
+    #
+    # *technically the rise to 1.5x baseline should be "known or presumed to
+    # have occurred within the prior 7 days", but that is a bit hard to pin
+    # down and raises a lot of edge cases, so we do not implement that logic
+    # here currently.
+    if ((scr / baseline_scr) %>=% 1.5 || (length(scr_last_48h) > 0 && (scr - min(scr_last_48h)) %>=% 0.3)) {
+      stage[i] <- 1
+    }
+    if ((scr / baseline_scr) %>=% 2) {
+      stage[i] <- 2
+    }
+    if ((scr / baseline_scr) %>=% 3 || scr %>=% 4 || isTRUE(dat$egfr[i] < 35 & age < 18)) {
+      stage[i] <- 3
+    }
+  }
+  stage
+}

R/utils.R

@@ -21,3 +21,12 @@ remove_lt_gt <- function(x) {
     return(as.numeric(x))
   }
 }
+
+#' Greater-than-or-equal-to with a little room for floating point precision
+#' issues
+#'
+#' @param x Numeric vector
+#' @param y Numeric vector
+`%>=%` <- function(x, y) {
+  x > y | mapply(function(x, y) isTRUE(all.equal(x, y)), x, y)
+}

tests/testthat/test_calc_aki_stage.R

@@ -1,32 +1,37 @@
 test_that("AKI stage is calculated correctly", {
+  # egfr < 35 and age < 18
   test0 <- calc_aki_stage(
     scr = c(3),
     t = c(0),
     egfr = 30,
     age = 15,
     verbose = FALSE
   )
+  # increase by >= 0.3 mg/dl from t=36 to t=48
   test1 <- calc_aki_stage(
     scr = c(0.7, 0.8, 1.2, 1.6, 1),
     t = c(0, 24, 36, 48, 72),
     egfr = c(60, 40, 30, 36, 50),
     method = "KDIGO",
     verbose = FALSE
   )
+  # increase by >= 0.3 mg/dl from t=24 to t=36
   test2 <- calc_aki_stage(
     scr = c(0.5, 0.7, 1.2, 1.6, 1.3),
     t = c(0, 24, 36, 48, 72),
     egfr = c(60, 40, 30, 36, 50),
     age = 17,
     verbose = FALSE
   )
+  # increase by >= 0.3 mg/dl from t=24 to t=36
   test2a <- calc_aki_stage(
     scr = c(0.5, 0.7, 1.2, 1.6, 1.3),
     t = c(0, 24, 36, 48, 72),
     egfr = c(60, 40, 30, 36, 50),
     age = 21,
     verbose = FALSE
   )
+  # increase by >= 0.3 mg/dl from t=24 to t=36
   test2b <- calc_aki_stage(
     scr = c(0.5, 0.7, 1.2, 1.6, 1.3),
     t = c(0, 24, 36, 48, 72),
@@ -36,6 +41,7 @@ test_that("AKI stage is calculated correctly", {
     force_numeric = TRUE,
     verbose = FALSE
   )
+  # increase to 2x baseline
   test3 <- calc_aki_stage(
     scr = 1.9,
     t = 72,
@@ -45,14 +51,48 @@ test_that("AKI stage is calculated correctly", {
     return_obj = FALSE,
     verbose = FALSE
   )
+  # increase to 1.5x baseline, even though absolute increase is <0.3 mg/dl
+  test4 <- calc_aki_stage(
+    scr = 0.45,
+    t = 72,
+    baseline_scr = 0.3,
+    egfr = 40,
+    age = 40,
+    return_obj = FALSE,
+    verbose = FALSE
+  )
+  # increase to 3x baseline
+  test5 <- calc_aki_stage(
+    scr = 6,
+    t = 48,
+    baseline_scr = 2,
+    egfr = 40,
+    age = 40,
+    return_obj = FALSE,
+    verbose = FALSE
+  )
+  # increase by >=0.3 mg/dl BUT we don't know how fast
+  test6 <- calc_aki_stage(
+    scr = 1.5,
+    t = 0,
+    baseline_scr = 1.1,
+    egfr = 40,
+    age = 40,
+    return_obj = FALSE,
+    verbose = FALSE
+  )
+
   expect_equal(test0$stage, "stage 3")
   expect_equal(test1$stage, "stage 1")
   expect_equal(test2$stage, "stage 3")
   expect_equal(test2$time_max_stage, 36)
   expect_equal(test2a$stage, "stage 1")
-  expect_equal(test2a$time_max_stage, 48)
+  expect_equal(test2a$time_max_stage, 36)
   expect_equal(test2b, 1)
   expect_equal(test3, "stage 2")
+  expect_equal(test4, "stage 1")
+  expect_equal(test5, "stage 3")
+  expect_true(is.na(test6))
 })
 
 
@@ -69,7 +109,7 @@ test_that("AKI stage is calculated correctly with other methods", {
     verbose = FALSE
   )
   test4 <- calc_aki_stage(
-    scr = c(.6, .7, .9, .7),
+    scr = c(.6, .7, .8, .7),
     times = 1:4,
     sex = "male",
     age = 50,
@@ -226,3 +266,27 @@ test_that("Times are sorted", {
   )
   expect_true(is.na(akis$stage))
 })
+
+test_that("age is not required if egfr is provided", {
+  res <- calc_aki_stage(
+    scr = 5,
+    times = 0,
+    egfr = 30,
+    baseline_egfr = 30,
+    method = "KDIGO",
+    verbose = FALSE
+  )
+  # Stage 3 because scr >= 4
+  expect_equal(res$stage, "stage 3")
+})
+
+test_that("kdigo_stage doesn't throw warning if no scr in last 48h", {
+  dat <- data.frame(
+    scr = c(1.5, 1.5, 1.9),
+    t = c(-1, 0, 55),
+    baseline_scr_diff = c(0, 0, 0.4),
+    egfr = c(100, 100, 60)
+  )
+
+  expect_warning(kdigo_stage(dat, 1.5, 50), NA)
+})

tests/testthat/test_utils.R

@@ -34,3 +34,24 @@ test_that("remove_lt_gt() returns original values if passed numeric vector", {
 test_that("remove_lt_gt() leaves negative numbers alone", {
   expect_equal(remove_lt_gt("-<0.6"),  -0.6)
 })
+
+test_that("%>=% operator works", {
+  expect_true((0.7 - 0.4) %>=% 0.3)
+})
+
+test_that("%>=% operator works on vectors", {
+  res <- c(1, 2, 3, 4) %>=% c(0, 3, 1, 5)
+  expect_equal(res, c(TRUE, FALSE, TRUE, FALSE))
+})
+
+test_that("%>=% operator handles NAs like >=", {
+  expect_true(is.na(5 %>=% NA))
+  expect_true(is.na(NA %>=% 6))
+  res <- c(1, NA) %>=% 0
+  expect_equal(res, c(TRUE, NA))
+})
+
+test_that("%>=% operator handles vectors of different lengths", {
+  expect_equal(2 %>=% c(1, 3), c(TRUE, FALSE))
+  expect_equal(c(1, 3) %>=% 2, c(FALSE, TRUE))
+})