# 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)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.