data-raw/testdata-time_cohort_outcomes.R

# test data for time_cohort_outcomes

# Define function to add patient to test data ----
create_new_patient_record <- function(id, 
                                      starttre,
                                      date, 
                                      status) {
  # Check args ----
  assertthat::assert_that(is.numeric(id),
                          is.numeric(starttre),
                          is.numeric(date),
                          is.numeric(status),
                          all(status %in% 1:9))
  # Status change levels ----
  status_levels <- c(
    "HIV 1st line",
    "HIV 2nd line",
    "HIV 3rd line",
    "Not defined",
    "Death",
    "Transfer out",
    "Declared lost to follow-up",
    "Returned to care after previous exit",
    NA_character_
  )
  
  # Convert status to character ----
  status <- status_levels[status]
  
  # Convert date from numeric to dates ----
  date <- lubridate::dmy("1/1/2010") + date
  
  # Convert starttre from numeric to dates ----
  starttre <- lubridate::dmy("1/1/2010") + starttre
  
  data.frame(id = id,
             starttre = starttre,
             date = date,
             hiv_tx_status = status,
             stringsAsFactors = FALSE)
  
}


# Records for test data ----
records <- list(
  list(1, -700, c(-700, -300), c(1, 5)),
  list(2, 0, c(0, 65, 90), c(1, 2, 6)),
  list(3, -500, c(-500, 300), c(2, 7)),
  list(4, 0, c(0, 175, NA_integer_), c(3, 3, 5)),
  list(5, -190, c(-190, 201, 400), c(1, 4, 9)),
  list(6, 1, c(1, 95, 170, 450), c(1, 7, 2, 5)),
  list(7, 250, c(250), c(1)),
  list(8, -50, c(-50, 120, 300), c(1, 7, 5))
)

# Mwrge records into data frame ----
(test_data <- purrr::map(records, .f = ~ create_new_patient_record(.x[[1]], .x[[2]], .x[[3]], .x[[4]])) %>%
  purrr::reduce(dplyr::bind_rows)
)

# Save test data ----
saveRDS(test_data, "inst/testdata/testdata-time_cohort_outcomes.rds", version = 2)
JayAchar/hisreportr documentation built on March 18, 2020, 5:57 a.m.