tests/testthat/test-utils.R

In epocakir: Clinical Coding of Patients with Kidney Disease

test_that("as_metric() conversions are correct", {
  kdigo_factors <- tibble::tribble(
    ~parameter, ~factor, ~si_units,
    # General
    "Age", 12, "months",
    "height", 100, "cm",
    # 2012 AKI Guideline
    "SAmk", 1.708, "umol/l",
    "BUN", 0.357, "mmol/l",
    "SiCa", 0.25, "mmol/l",
    "SCr", 88.4, "umol/l",
    "CLcr", 0.01667, "ml/s",
    "CGen", 2.09, "umol/l",
    "Glc", 0.0555, "mmol/l",
    "Lac", 0.111, "mmol/l",
    "STob", 2.139, "umol/l",
    "Urea", 0.167, "mmol/l",
    # 2012 CKD Guideline
    "SAlb", 10, "g/l",
    "Hb", 10, "g/l",
    # "SPhos", 0.323, "mmol/l",
    # "SPTH", 0.106, "pmol/l",
    "UA", 59.485, "umol/l",
    # "VitD", 2.496, "nmol/l"
    "GFR", 1, "mL/min",
    "eGFR", 1, "mL/min/1.73m2",
    "SCysC", 1, "mg/l",
    "AER", 1, "mg/day",
    "ACR", 1, "mg/g",
    "UO", 1, "ml/kg"
  ) %>%
    dplyr::left_join(conversion_factors, ., by = "parameter") %>%
    dplyr::filter(!is.na(factor))

  expect_identical(nrow(conversion_factors), nrow(kdigo_factors))

  for (i in seq_len(nrow(kdigo_factors))) {
    expect_lte(abs(
      as_metric(
        param = kdigo_factors[[i, "parameter"]],
        meas = units::set_units(
          kdigo_factors[[i, "factor"]], kdigo_factors[[i, "si_units"]],
          mode = "standard"
        )
      ) - units::set_units(1, kdigo_factors[[i, "metric_units"]], mode = "standard")
    ),
    expected = units::set_units(5e-3, kdigo_factors[[i, "metric_units"]], mode = "standard"),
    label = paste(kdigo_factors[[i, "description"]], "conversion of", kdigo_factors[[i, "factor"]]),
    expected.label = "allowable tolerance"
    )
  }
})

test_that("as_metric() on single value", {
  expect_lte(abs(
    as_metric(param = "scr", meas = units::set_units(88.4, "umol/l")) -
      units::set_units(1, "mg/dl")
  ),
  expected = units::set_units(5e-3, "mg/dl")
  )

  expect_lte(abs(
    as_metric("SCr", units::set_units(88.4, "umol/l")) -
      units::set_units(1, "mg/dl")
  ),
  expected = units::set_units(5e-3, "mg/dl")
  )

  expect_lte(abs(
    as_metric(SCr = units::set_units(88.4, "umol/l")) -
      units::set_units(1, "mg/dl")
  ),
  expected = units::set_units(5e-3, "mg/dl")
  )
})

test_that("as_metric() on vector", {
  values <- units::set_units(c(88.4, 88.4, 88.4), "umol/l")

  expect_lte(abs(sum(
    as_metric(SCr = values) -
      units::set_units(1, "mg/dl")
  )),
  expected = units::set_units(5e-3, "mg/dl")
  )

  expect_lte(abs(sum(
    data.frame(meas = values) %>%
      dplyr::mutate(meas = as_metric(SCr = meas)) %>%
      dplyr::pull(meas) -
      units::set_units(1, "mg/dl")
  )),
  expected = units::set_units(5e-3, "mg/dl")
  )
})

test_that("as_metric() on NULL", {
  expect_null(as_metric(NULL))
  expect_null(as_metric(1))
})

test_that("as_metric() error on unknown measurement", {
  expect_error(as_metric(unknown = 1))
  expect_error(as_metric(param = "unknown", meas = 1))
})

test_that("dob2age() between two dates is valid", {
  expect_identical(
    dob2age(
      dob = lubridate::as_date("1990-01-01"),
      age_on = lubridate::as_date("2002-01-01")
    ),
    lubridate::duration(years = 12)
  )
})

test_that("dob2age() for a vector is valid", {
  expect_identical(
    dob2age(
      dob = c(
        lubridate::as_date("1990-01-01"),
        lubridate::as_date("1994-01-01"),
        lubridate::as_date("1998-01-01")
      ),
      age_on = lubridate::as_date("2002-01-01")
    ),
    c(
      lubridate::duration(years = 12),
      lubridate::duration(years = 8),
      lubridate::duration(years = 4)
    )
  )
})

test_that("dob2age() with `floor` is valid", {
  expect_identical(
    dob2age(
      dob = c(
        lubridate::as_date("1990-01-01"),
        lubridate::as_date("1994-01-01"),
        lubridate::as_date("1998-01-01")
      ),
      age_on = lubridate::as_date("2002-12-31"),
      fun = floor
    ),
    c(
      lubridate::duration(years = 12),
      lubridate::duration(years = 8),
      lubridate::duration(years = 4)
    )
  )
})

test_that("dob2age() with `ceiling` is valid", {
  expect_identical(
    dob2age(
      dob = c(
        lubridate::as_date("1990-01-01"),
        lubridate::as_date("1994-01-01"),
        lubridate::as_date("1998-01-01")
      ),
      age_on = lubridate::as_date("2001-12-31"),
      fun = ceiling
    ),
    c(
      lubridate::duration(years = 12),
      lubridate::duration(years = 8),
      lubridate::duration(years = 4)
    )
  )
})

test_that("binary2factor() with multiple columns", {
  df <- data.frame(
    a = c(1, 0, NA, 1, 0),
    b = c("y", "n", NA, "Y", "n"),
    c = c("yes", "no", NA, "Yes", "No"),
    d = c(TRUE, FALSE, NA, TRUE, FALSE),
    e = c(1, 2, 3, 4, 5)
  )
  ep <- data.frame(
    a = factor(c(1, 0, NA, 1, 0), levels = c(0, 1), labels = c("Not_a", "a"), ordered = TRUE),
    b = factor(c(1, 0, NA, 1, 0), levels = c(0, 1), labels = c("Not_b", "b"), ordered = TRUE),
    c = factor(c(1, 0, NA, 1, 0), levels = c(0, 1), labels = c("Not_c", "c"), ordered = TRUE),
    d = factor(c(1, 0, NA, 1, 0), levels = c(0, 1), labels = c("Not_d", "d"), ordered = TRUE),
    e = c(1, 2, 3, 4, 5)
  )
  expect_identical(binary2factor(df, a, b:d), ep)
  expect_identical(df %>% binary2factor(-e), ep)
})

test_that("combine_date_time_cols() for multiple columns", {
  df1 <- data.frame(
    date_a = as.Date(c("2020-01-01", "2020-01-02")),
    date_b = as.POSIXct(c("2020-02-01", "2020-02-02")),
    time_a = as.POSIXct(c("1900-01-01 01:01:01", "1900-01-01 02:02:02")),
    time_b = as.POSIXct(c("1900-01-01 01:01:01", "1900-01-01 02:02:02"))
  )
  df2 <- data.frame(
    a = c(1, 2), date_a = df1$date_a, time_a = df1$time_a,
    b = c(3, 4), date_b = df1$date_b, time_b = df1$time_b
  )
  o1 <- tibble::tibble(
    DateTime_a = as.POSIXct(c("2020-01-01 01:01:01", "2020-01-02 02:02:02"), tz = "UTC"),
    DateTime_b = as.POSIXct(c("2020-02-01 01:01:01", "2020-02-02 02:02:02"), tz = "UTC")
  )
  o2 <- tibble::tibble(
    a = c(1, 2),
    DateTime_a = as.POSIXct(c("2020-01-01 01:01:01", "2020-01-02 02:02:02")),
    b = c(3, 4),
    DateTime_b = as.POSIXct(c("2020-02-01 01:01:01", "2020-02-02 02:02:02"))
  )

  expect_identical(combine_date_time_cols(df1, tz = "UTC"), o1)
  expect_identical(combine_date_time_cols(df2), o2)
})


changes_raw_df <- function(env = parent.frame()) {
  tibble::tibble(
    pt_id_ = c(rep("pt1", 3 + 3), rep("pt2", 3)),
    dttm_ = c(
      seq(
        lubridate::as_datetime("2020-10-18 09:00:00", tz = "Australia/Melbourne"),
        lubridate::as_datetime("2020-10-20 09:00:00", tz = "Australia/Melbourne"),
        length.out = 3
      ),
      seq(
        lubridate::as_datetime("2020-10-23 09:00:00", tz = "Australia/Melbourne"),
        lubridate::as_datetime("2020-10-25 21:00:00", tz = "Australia/Melbourne"),
        length.out = 3
      ),
      seq(
        lubridate::as_datetime("2020-10-18 10:00:00", tz = "Australia/Melbourne"),
        lubridate::as_datetime("2020-10-19 10:00:00", tz = "Australia/Melbourne"),
        length.out = 3
      )
    ),
    SCr_ = c(
      units::set_units(seq(2.0, 3.0, by = 0.5), "mg/dl"),
      units::set_units(seq(3.5, 4.0, by = 0.25), "mg/dl"),
      units::set_units(seq(3.3, 3.5, by = 0.10), "mg/dl")
    ),
    bCr_ = c(
      rep(units::set_units(1.8, "mg/dl"), 3 + 3),
      rep(units::set_units(3.0, "mg/dl"), 3)
    )
  )
}

changes_rand_df <- function(env = parent.frame()) {
  changes_raw_df()[c(4, 6, 3, 8, 1, 2, 7, 9, 5), ]
}

changes_exp_df <- function(env = parent.frame()) {
  cbind(
    changes_raw_df()[
      c(2, 3, 3, 5, 6, 8, 9, 9),
      c("pt_id_", "dttm_", "SCr_")
    ],
    tibble::tibble(
      D.SCr_ = units::set_units(c(0.5, 0.5, 1.0, 0.25, 0.25, 0.1, 0.1, 0.2), "mg/dl"),
      D.dttm_ = lubridate::make_difftime(hours = c(24, 24, 48, 30, 30, 12, 12, 24))
    )
  ) %>%
    tibble::remove_rownames() %>%
    tibble::tibble()
}

test_that("combn_changes for data.frame", {
  df <- combn_changes(changes_rand_df(), "dttm_", "SCr_", "pt_id_")
  expect_equal(df, changes_exp_df())

  df <- combn_changes(changes_rand_df(), dttm_, SCr_, pt_id_)
  expect_equal(df, changes_exp_df())

  df <- changes_rand_df() %>%
    combn_changes(dttm_, SCr_, pt_id_)
  expect_equal(df, changes_exp_df())
})

test_that("combn_changes for POSIXct", {
  df <- combn_changes(
    changes_rand_df()$dttm_,
    changes_rand_df()$SCr_,
    changes_rand_df()$pt_id_
  )
  colnames(df) <- c("pt_id_", "dttm_", "SCr_", "D.SCr_", "D.dttm_")
  expect_equal(df, changes_exp_df())
})

test_that("combn_changes with n < m", {
  df <- changes_raw_df()[1:7, ]
  ep <- changes_exp_df()[1:5, ]
  ep$D.dttm_ <- as.difftime(as.numeric(ep$D.dttm_, units = "days"), units = "days")
  expect_equal(combn_changes(df, "dttm_", "SCr_", "pt_id_"), ep)
})