tests/testthat/test-time_cohort_outcomes.R

In JayAchar/hisreportr: hisreportr: Automating MSF OCA EMR reporting

context("test-time_cohort_outcomes")

# Define recurring tests ----
output_structure_tests <- quote({
  expect_equal(length(unique(data$id)), nrow(out))
  expect_equal(length(unique(out$id)), nrow(out))
  expect_false(any(grepl(names(out), pattern = ".x")))
  expect_equal(ncol(out), length(time_months) + 1)
})

followup_6m <- quote({
  expect_true(out$fu_6_months[out$id == 1] == "On treatment")
  expect_true(out$fu_6_months[out$id == 2] == "Transfer out")
  expect_true(out$fu_6_months[out$id == 3] == "On treatment")
  expect_true(out$fu_6_months[out$id == 4] == "On treatment")
  expect_true(out$fu_6_months[out$id == 5] == "On treatment")
  expect_true(out$fu_6_months[out$id == 6] == "On treatment")
  expect_true(is.na(out$fu_6_months[out$id == 7]))
  expect_true(out$fu_6_months[out$id == 8] == "LTFU")
})

followup_12m <- quote({
  expect_true(out$fu_12_months[out$id == 1] == "On treatment")
  expect_true(out$fu_12_months[out$id == 2] == "Transfer out")
  expect_true(out$fu_12_months[out$id == 3] == "On treatment")
  expect_true(out$fu_12_months[out$id == 4] == "On treatment")
  expect_true(out$fu_12_months[out$id == 5] == "On treatment")
  expect_true(is.na(out$fu_12_months[out$id == 6]))
  expect_true(is.na(out$fu_12_months[out$id == 7]))
  expect_true(out$fu_12_months[out$id == 8] == "Death")
})

followup_48m <- quote({
  expect_true(all(is.na(out$fu_48_months)))
})


# Load test data ----
data <- readRDS(system.file("testdata", 
                    "testdata-time_cohort_outcomes.rds", 
                    package = "hisreportr"))

# * Clean data ----
df <- clean_hiv_status(data)


# Call with 6 and 12M follow-up ----
time_months <- c(6, 12)

out <- time_cohort_outcomes(df = df,
                            time_months = time_months,
                            status_var = "hiv_status",
                            date_var = "date",
                            id_var = "id",
                            start_var = "starttre",
                            reporting_date = as.Date("1/1/2011", format = "%d/%m/%Y"),
                            convert_to_df = TRUE)

#* Execute tests ----
test_that("output structure ok", eval(output_structure_tests))
test_that("6M follow-up ok", eval(followup_6m))
test_that("12M follow-up ok", eval(followup_12m))

# Call 6 and 48 months follow-up ----
time_months <- c(6, 48)

out <- time_cohort_outcomes(df = df,
                            time_months = time_months,
                            status_var = "hiv_status",
                            date_var = "date",
                            id_var = "id",
                            start_var = "starttre",
                            reporting_date = as.Date("1/1/2011", format = "%d/%m/%Y"),
                            convert_to_df = TRUE)

#* Execute tests ----
test_that("output structure ok", eval(output_structure_tests))
test_that("6M follow-up ok", eval(followup_6m))
test_that("48M follow-up ok", eval(followup_48m))

# New reporting date ----
time_months <- 6
out <- time_cohort_outcomes(df = df,
                            time_months = time_months,
                            status_var = "hiv_status",
                            date_var = "date",
                            id_var = "id",
                            start_var = "starttre",
                            reporting_date = as.Date("1/4/2011", format = "%d/%m/%Y"), 
                            convert_to_df = TRUE
)

#* Execute tests ----
test_that("output structure ok", eval(output_structure_tests))
test_that("later reporting date", {
  expect_true(out$fu_6_months[out$id == 7] == "On treatment")
})

# Test convert_to_df = FALSE ----
time_months <- c(6, 12)
out <- time_cohort_outcomes(
  df = df,
  time_months = time_months,
  status_var = "hiv_status",
  date_var = "date",
  id_var = "id",
  start_var = "starttre",
  reporting_date = as.Date("1/1/2011", format = "%d/%m/%Y"),
  convert_to_df = FALSE
)

test_that("output list works", {
  expect_true(class(out) == "list")
  expect_equal(length(time_months), length(out))
  expect_false(any(unlist(lapply(out, FUN = function(x) any(names(x) == "starttre")))))
})