Example Data Generation

library(dplyr)
library(formatters)

study_duration_secs <- lubridate::seconds(lubridate::years(2))

sample_fct <- function(x, N, ...) { # nolint
  checkmate::assert_number(N)
  factor(sample(x, N, replace = TRUE, ...), levels = if (is.factor(x)) levels(x) else x)
}

retain <- function(df, value_var, event, outside = NA) {
  indices <- c(1, which(event == TRUE), nrow(df) + 1)
  values <- c(outside, value_var[event == TRUE])
  rep(values, diff(indices))
}

relvar_init <- function(relvar1, relvar2) {
  if (length(relvar1) != length(relvar2)) {
    message(simpleError(
      "The argument value length of relvar1 and relvar2 differ. They must contain the same number of elements."
    ))
    return(NA)
  }
  return(list("relvar1" = relvar1, "relvar2" = relvar2))
}

rel_var <- function(df = NULL, var_name = NULL, var_values = NULL, related_var = NULL) {
  if (is.null(df)) {
    message("Missing data frame argument value.")
    return(NA)
  } else {
    n_relvar1 <- length(unique(df[, related_var, drop = TRUE]))
    n_relvar2 <- length(var_values)
    if (n_relvar1 != n_relvar2) {
      message(paste("Unequal vector lengths for", related_var, "and", var_name))
      return(NA)
    } else {
      relvar1 <- unique(df[, related_var, drop = TRUE])
      relvar2_values <- rep(NA, nrow(df))
      for (r in seq_len(length(relvar1))) {
        matched <- which(df[, related_var, drop = TRUE] == relvar1[r])
        relvar2_values[matched] <- var_values[r]
      }
      return(relvar2_values)
    }
  }
}

visit_schedule <- function(visit_format = "WEEK",
                           n_assessments = 10L,
                           n_days = 5L) {
  if (!(toupper(visit_format) %in% c("WEEK", "CYCLE"))) {
    message("Visit format value must either be: WEEK or CYCLE")
    return(NA)
  }
  if (toupper(visit_format) == "WEEK") {
    assessments <- 1:n_assessments
    assessments_ord <- -1:n_assessments
    visit_values <- c("SCREENING", "BASELINE", paste(toupper(visit_format), assessments, "DAY", (assessments * 7) + 1))
  } else if (toupper(visit_format) == "CYCLE") {
    cycles <- sort(rep(1:n_assessments, times = 1, each = n_days))
    days <- rep(seq(1:n_days), times = n_assessments, each = 1)
    assessments_ord <- 0:(n_assessments * n_days)
    visit_values <- c("SCREENING", paste(toupper(visit_format), cycles, "DAY", days))
  }
  visit_values <- stats::reorder(factor(visit_values), assessments_ord)
}

rtpois <- function(n, lambda) stats::qpois(stats::runif(n, stats::dpois(0, lambda), 1), lambda)

rtexp <- function(n, rate, l = NULL, r = NULL) {
  if (!is.null(l)) {
    l - log(1 - stats::runif(n)) / rate
  } else if (!is.null(r)) {
    -log(1 - stats::runif(n) * (1 - exp(-r * rate))) / rate
  } else {
    stats::rexp(n, rate)
  }
}

str_extract <- function(string, pattern) regmatches(string, gregexpr(pattern, string))

common_var_labels <- c(
  USUBJID = "Unique Subject Identifier",
  STUDYID = "Study Identifier",
  PARAM = "Parameter",
  PARAMCD = "Parameter Code",
  AVISIT = "Analysis Visit",
  AVISITN = "Analysis Visit (N)",
  AVAL = "Analysis Value",
  AVALU = "Analysis Value Unit",
  AVALC = "Character Result/Finding",
  BASE = "Baseline Value",
  BASE2 = "Screening Value",
  ABLFL = "Baseline Record Flag",
  ABLFL2 = "Screening Record Flag",
  CHG = "Absolute Change from Baseline",
  PCHG = "Percentage Change from Baseline",
  ANRIND = "Analysis Reference Range Indicator",
  BNRIND = "Baseline Reference Range Indicator",
  ANRLO = "Analysis Normal Range Lower Limit",
  ANRHI = "Analysis Normal Range Upper Limit",
  CNSR = "Censor",
  ADTM = "Analysis Datetime",
  ADY = "Analysis Relative Day",
  ASTDY = "Analysis Start Relative Day",
  AENDY = "Analysis End Relative Day",
  ASTDTM = "Analysis Start Datetime",
  AENDTM = "Analysis End Datetime",
  VISITDY = "Planned Study Day of Visit",
  EVNTDESC = "Event or Censoring Description",
  CNSDTDSC = "Censor Date Description",
  BASETYPE = "Baseline Type",
  DTYPE = "Derivation Type",
  ONTRTFL = "On Treatment Record Flag",
  WORS01FL = "Worst Observation in Window Flag 01",
  WORS02FL = "Worst Post-Baseline Observation"
)

generate_adsl <- function(N = 200) { # nolint
  set.seed(1)
  sys_dtm <- lubridate::fast_strptime("20/2/2019 11:16:16.683", "%d/%m/%Y %H:%M:%OS", tz = "UTC")
  country_site_prob <- c(.5, .121, .077, .077, .075, .052, .046, .025, .014, .003)

  adsl <- tibble::tibble(
    STUDYID = rep("AB12345", N) %>% with_label("Study Identifier"),
    COUNTRY = sample_fct(
      c("CHN", "USA", "BRA", "PAK", "NGA", "RUS", "JPN", "GBR", "CAN", "CHE"),
      N,
      prob = country_site_prob
    ) %>% with_label("Country"),
    SITEID = sample_fct(1:20, N, prob = rep(country_site_prob, times = 2)),
    SUBJID = paste("id", seq_len(N), sep = "-") %>% with_label("Subject Identifier for the Study"),
    AGE = (sapply(stats::rchisq(N, df = 5, ncp = 10), max, 0) + 20) %>% with_label("Age"),
    SEX = c("F", "M") %>% sample_fct(N, prob = c(.52, .48)) %>% with_label("Sex"),
    ARMCD = c("ARM A", "ARM B", "ARM C") %>% sample_fct(N) %>% with_label("Planned Arm Code"),
    ARM = dplyr::recode(
      .data$ARMCD,
      "ARM A" = "A: Drug X", "ARM B" = "B: Placebo", "ARM C" = "C: Combination"
    ) %>% with_label("Description of Planned Arm"),
    ACTARMCD = .data$ARMCD %>% with_label("Actual Arm Code"),
    ACTARM = .data$ARM %>% with_label("Description of Actual Arm"),
    RACE = c(
      "ASIAN", "BLACK OR AFRICAN AMERICAN", "WHITE", "AMERICAN INDIAN OR ALASKA NATIVE",
      "MULTIPLE", "NATIVE HAWAIIAN OR OTHER PACIFIC ISLANDER", "OTHER", "UNKNOWN"
    ) %>%
      sample_fct(N, prob = c(.55, .23, .16, .05, .004, .003, .002, .002)) %>%
      with_label("Race"),
    TRTSDTM = sys_dtm + sample(seq(0, study_duration_secs), size = N, replace = TRUE) %>%
      with_label("Datetime of First Exposure to Treatment"),
    TRTEDTM = c(TRTSDTM + study_duration_secs) %>%
      with_label("Datetime of Last Exposure to Treatment"),
    EOSDY = ceiling(as.numeric(difftime(TRTEDTM, TRTSDTM, units = "days"))) %>%
      with_label("End of Study Relative Day"),
    EOSDT = lubridate::date(TRTEDTM) %>% with_label("End of Study Date"),
    STRATA1 = c("A", "B", "C") %>% sample_fct(N) %>% with_label("Stratification Factor 1"),
    STRATA2 = c("S1", "S2") %>% sample_fct(N) %>% with_label("Stratification Factor 2"),
    BMRKR1 = stats::rchisq(N, 6) %>% with_label("Continuous Level Biomarker 1"),
    BMRKR2 = sample_fct(c("LOW", "MEDIUM", "HIGH"), N) %>% with_label("Continuous Level Biomarker 2")
  )

  # associate sites with countries and regions
  adsl <- adsl %>%
    dplyr::mutate(
      SITEID = paste0(.data$COUNTRY, "-", .data$SITEID) %>% with_label("Study Site Identifier"),
      REGION1 = factor(dplyr::case_when(
        COUNTRY %in% c("NGA") ~ "Africa",
        COUNTRY %in% c("CHN", "JPN", "PAK") ~ "Asia",
        COUNTRY %in% c("RUS") ~ "Eurasia",
        COUNTRY %in% c("GBR") ~ "Europe",
        COUNTRY %in% c("CAN", "USA") ~ "North America",
        COUNTRY %in% c("BRA") ~ "South America",
        TRUE ~ as.character(NA)
      )) %>% with_label("Geographic Region 1"),
      SAFFL = factor("Y") %>% with_label("Safety Population Flag")
    ) %>%
    dplyr::mutate(USUBJID = paste(.data$STUDYID, .data$SITEID, .data$SUBJID, sep = "-") %>%
      with_label("Unique Subject Identifier"))

  # disposition related variables
  # using probability of 1 for the "DEATH" level to ensure at least one death record exists
  l_dcsreas <- list(
    choices = c(
      "ADVERSE EVENT", "DEATH", "LACK OF EFFICACY", "PHYSICIAN DECISION",
      "PROTOCOL VIOLATION", "WITHDRAWAL BY PARENT/GUARDIAN", "WITHDRAWAL BY SUBJECT"
    ),
    prob = c(.2, 1, .1, .1, .2, .1, .1)
  )
  l_dthcat_other <- list(
    choices = c(
      "Post-study reporting of death", "LOST TO FOLLOW UP", "MISSING", "SUICIDE", "UNKNOWN"
    ),
    prob = c(.1, .3, .3, .2, .1)
  )

  adsl <- adsl %>%
    dplyr::mutate(
      EOSSTT = dplyr::case_when(
        EOSDY == max(EOSDY, na.rm = TRUE) ~ "COMPLETED",
        EOSDY < max(EOSDY, na.rm = TRUE) ~ "DISCONTINUED",
        is.na(TRTEDTM) ~ "ONGOING"
      ) %>% with_label("End of Study Status")
    ) %>%
    dplyr::mutate(
      EOTSTT = .data$EOSSTT %>% with_label("End of Treatment Status")
    ) %>%
    dplyr::mutate(
      DCSREAS = ifelse(
        .data$EOSSTT == "DISCONTINUED",
        sample(x = l_dcsreas$choices, size = N, replace = TRUE, prob = l_dcsreas$prob),
        as.character(NA)
      ) %>% with_label("Reason for Discontinuation from Study")
    )

  tmc_ex_adsl <- adsl %>%
    dplyr::mutate(DTHDT = dplyr::case_when(
      DCSREAS == "DEATH" ~ lubridate::date(TRTEDTM + lubridate::days(sample(0:50, size = N, replace = TRUE)))
    ) %>% with_label("Date of Death"))

  save(tmc_ex_adsl, file = "data/tmc_ex_adsl.rda", compress = "xz")
}

generate_adae <- function(adsl = tmc_ex_adsl,
                          max_n_aes = 5) {
  set.seed(1)
  lookup_ae <- tibble::tribble(
    ~AEBODSYS, ~AELLT, ~AEDECOD, ~AEHLT, ~AEHLGT, ~AETOXGR, ~AESOC, ~AESER, ~AEREL,
    "cl A.1", "llt A.1.1.1.1", "dcd A.1.1.1.1", "hlt A.1.1.1", "hlgt A.1.1", "1", "cl A", "N", "N",
    "cl A.1", "llt A.1.1.1.2", "dcd A.1.1.1.2", "hlt A.1.1.1", "hlgt A.1.1", "2", "cl A", "Y", "N",
    "cl B.1", "llt B.1.1.1.1", "dcd B.1.1.1.1", "hlt B.1.1.1", "hlgt B.1.1", "5", "cl B", "Y", "Y",
    "cl B.2", "llt B.2.1.2.1", "dcd B.2.1.2.1", "hlt B.2.1.2", "hlgt B.2.1", "3", "cl B", "N", "N",
    "cl B.2", "llt B.2.2.3.1", "dcd B.2.2.3.1", "hlt B.2.2.3", "hlgt B.2.2", "1", "cl B", "Y", "N",
    "cl C.1", "llt C.1.1.1.3", "dcd C.1.1.1.3", "hlt C.1.1.1", "hlgt C.1.1", "4", "cl C", "N", "Y",
    "cl C.2", "llt C.2.1.2.1", "dcd C.2.1.2.1", "hlt C.2.1.2", "hlgt C.2.1", "2", "cl C", "N", "Y",
    "cl D.1", "llt D.1.1.1.1", "dcd D.1.1.1.1", "hlt D.1.1.1", "hlgt D.1.1", "5", "cl D", "Y", "Y",
    "cl D.1", "llt D.1.1.4.2", "dcd D.1.1.4.2", "hlt D.1.1.4", "hlgt D.1.1", "3", "cl D", "N", "N",
    "cl D.2", "llt D.2.1.5.3", "dcd D.2.1.5.3", "hlt D.2.1.5", "hlgt D.2.1", "1", "cl D", "N", "Y"
  )

  aag <- utils::read.table(
    sep = ",", header = TRUE,
    text = paste(
      "NAMVAR,SRCVAR,GRPTYPE,REFNAME,REFTERM,SCOPE",
      "CQ01NAM,AEDECOD,CUSTOM,D.2.1.5.3/A.1.1.1.1 aesi,dcd D.2.1.5.3,",
      "CQ01NAM,AEDECOD,CUSTOM,D.2.1.5.3/A.1.1.1.1 aesi,dcd A.1.1.1.1,",
      "SMQ01NAM,AEDECOD,SMQ,C.1.1.1.3/B.2.2.3.1 aesi,dcd C.1.1.1.3,BROAD",
      "SMQ01NAM,AEDECOD,SMQ,C.1.1.1.3/B.2.2.3.1 aesi,dcd B.2.2.3.1,BROAD",
      "SMQ02NAM,AEDECOD,SMQ,Y.9.9.9.9/Z.9.9.9.9 aesi,dcd Y.9.9.9.9,NARROW",
      "SMQ02NAM,AEDECOD,SMQ,Y.9.9.9.9/Z.9.9.9.9 aesi,dcd Z.9.9.9.9,NARROW",
      sep = "\n"
    ), stringsAsFactors = FALSE
  )

  adae <- Map(
    function(id, sid) {
      n_aes <- sample(c(0, seq_len(max_n_aes)), 1)
      i <- sample(seq_len(nrow(lookup_ae)), n_aes, TRUE)
      dplyr::mutate(
        lookup_ae[i, ],
        USUBJID = id,
        STUDYID = sid
      )
    },
    adsl$USUBJID,
    adsl$STUDYID
  ) %>%
    Reduce(rbind, .) %>%
    `[`(c(10, 11, 1, 2, 3, 4, 5, 6, 7, 8, 9)) %>%
    dplyr::mutate(
      AETERM = gsub("dcd", "trm", .data$AEDECOD) %>% with_label("Reported Term for the Adverse Event"),
      AESEV = dplyr::case_when(
        AETOXGR == 1 ~ "MILD",
        AETOXGR %in% c(2, 3) ~ "MODERATE",
        AETOXGR %in% c(4, 5) ~ "SEVERE"
      ) %>% with_label("Severity/Intensity")
    )

  # merge adsl to be able to add AE date and study day variables
  adae <- dplyr::inner_join(adae, adsl, by = c("STUDYID", "USUBJID"), multiple = "all") %>%
    dplyr::rowwise() %>%
    dplyr::mutate(TRTENDT = lubridate::date(dplyr::case_when(
      is.na(TRTEDTM) ~ lubridate::floor_date(lubridate::date(TRTSDTM) + study_duration_secs, unit = "day"),
      TRUE ~ TRTEDTM
    ))) %>%
    dplyr::mutate(ASTDTM = sample(
      seq(lubridate::as_datetime(TRTSDTM), lubridate::as_datetime(TRTENDT), by = "day"),
      size = 1
    )) %>%
    dplyr::mutate(ASTDY = ceiling(difftime(ASTDTM, TRTSDTM, units = "days"))) %>%
    # add 1 to end of range incase both values passed to sample() are the same
    dplyr::mutate(AENDTM = sample(
      seq(lubridate::as_datetime(ASTDTM), lubridate::as_datetime(TRTENDT + 1), by = "day"),
      size = 1
    )) %>%
    dplyr::mutate(AENDY = ceiling(difftime(AENDTM, TRTSDTM, units = "days"))) %>%
    dplyr::mutate(LDOSEDTM = dplyr::case_when(
      TRTSDTM < ASTDTM ~ lubridate::as_datetime(stats::runif(1, TRTSDTM, ASTDTM)),
      TRUE ~ ASTDTM
    )) %>%
    dplyr::select(-TRTENDT) %>%
    dplyr::ungroup() %>%
    dplyr::arrange(.data$STUDYID, .data$USUBJID, .data$ASTDTM, .data$AETERM)

  adae <- adae %>%
    dplyr::group_by(.data$USUBJID) %>%
    dplyr::mutate(AESEQ = seq_len(dplyr::n())) %>%
    dplyr::ungroup() %>%
    dplyr::arrange(
      .data$STUDYID,
      .data$USUBJID,
      .data$ASTDTM,
      .data$AETERM,
      .data$AESEQ
    )

  outcomes <- c(
    "UNKNOWN",
    "NOT RECOVERED/NOT RESOLVED",
    "RECOVERED/RESOLVED WITH SEQUELAE",
    "RECOVERING/RESOLVING",
    "RECOVERED/RESOLVED"
  )

  adae <- adae %>%
    dplyr::mutate(
      AEOUT = factor(ifelse(
        .data$AETOXGR == "5",
        "FATAL",
        as.character(sample_fct(outcomes, nrow(adae), prob = c(0.1, 0.2, 0.1, 0.3, 0.3)))
      )) %>% with_label("Outcome of Adverse Event"),
      TRTEMFL = ifelse(.data$ASTDTM >= .data$TRTSDTM, "Y", "") %>%
        with_label("Treatment Emergent Analysis Flag")
    )

  l_aag <- split(aag, interaction(aag$NAMVAR, aag$SRCVAR, aag$GRPTYPE, drop = TRUE))

  # Create aesi flags
  l_aesi <- lapply(l_aag, function(d_adag, d_adae) {
    names(d_adag)[names(d_adag) == "REFTERM"] <- d_adag$SRCVAR[1]
    names(d_adag)[names(d_adag) == "REFNAME"] <- d_adag$NAMVAR[1]

    if (d_adag$GRPTYPE[1] == "CUSTOM") {
      d_adag <- d_adag[-which(names(d_adag) == "SCOPE")]
    } else if (d_adag$GRPTYPE[1] == "SMQ") {
      names(d_adag)[names(d_adag) == "SCOPE"] <- paste0(substr(d_adag$NAMVAR[1], 1, 5), "SC")
    }

    d_adag <- d_adag[-which(names(d_adag) %in% c("NAMVAR", "SRCVAR", "GRPTYPE"))]
    d_new <- dplyr::left_join(x = d_adae, y = d_adag, by = intersect(names(d_adae), names(d_adag)))
    d_new[, dplyr::setdiff(names(d_new), names(d_adae)), drop = FALSE]
  }, adae)
  adae <- dplyr::bind_cols(adae, l_aesi)

  actions <- c(
    "DOSE RATE REDUCED",
    "UNKNOWN",
    "NOT APPLICABLE",
    "DRUG INTERRUPTED",
    "DRUG WITHDRAWN",
    "DOSE INCREASED",
    "DOSE NOT CHANGED",
    "DOSE REDUCED",
    "NOT EVALUABLE"
  )

  tmc_ex_adae <- adae %>%
    dplyr::mutate(
      AEACN = factor(ifelse(
        .data$AETOXGR == "5",
        "NOT EVALUABLE",
        as.character(sample_fct(actions, nrow(adae), prob = c(0.05, 0.05, 0.05, 0.01, 0.05, 0.1, 0.45, 0.1, 0.05)))
      )) %>% with_label("Action Taken With Study Treatment")
    ) %>%
    var_relabel(
      AEBODSYS = "Body System or Organ Class",
      AELLT = "Lowest Level Term",
      AEDECOD = "Dictionary-Derived Term",
      AEHLT = "High Level Term",
      AEHLGT = "High Level Group Term",
      AETOXGR = "Analysis Toxicity Grade",
      AESOC = "Primary System Organ Class",
      AESER = "Serious Event",
      AEREL = "Analysis Causality",
      AESEQ = "Sponsor-Defined Identifier",
      LDOSEDTM = "End Time/Time of Last Dose",
      CQ01NAM = "CQ 01 Reference Name",
      SMQ01NAM = "SMQ 01 Reference Name",
      SMQ01SC = "SMQ 01 Scope",
      SMQ02NAM = "SMQ 02 Reference Name",
      SMQ02SC = "SMQ 02 Scope"
    )

  i_lbls <- sapply(
    names(var_labels(tmc_ex_adae)[is.na(var_labels(tmc_ex_adae))]), function(x) which(names(common_var_labels) == x)
  )
  var_labels(tmc_ex_adae[names(i_lbls)]) <- common_var_labels[i_lbls]

  save(tmc_ex_adae, file = "data/tmc_ex_adae.rda", compress = "xz")
}

generate_adaette <- function(adsl = tmc_ex_adsl) {
  set.seed(1)
  lookup_adaette <- tibble::tribble(
    ~ARM, ~CATCD, ~CAT, ~LAMBDA, ~CNSR_P,
    "ARM A", "1", "any adverse event", 1 / 80, 0.4,
    "ARM B", "1", "any adverse event", 1 / 100, 0.2,
    "ARM C", "1", "any adverse event", 1 / 60, 0.42,
    "ARM A", "2", "any serious adverse event", 1 / 100, 0.3,
    "ARM B", "2", "any serious adverse event", 1 / 150, 0.1,
    "ARM C", "2", "any serious adverse event", 1 / 80, 0.32,
    "ARM A", "3", "a grade 3-5 adverse event", 1 / 80, 0.2,
    "ARM B", "3", "a grade 3-5 adverse event", 1 / 100, 0.08,
    "ARM C", "3", "a grade 3-5 adverse event", 1 / 60, 0.23
  )
  evntdescr_sel <- "Preferred Term"
  cnsdtdscr_sel <- c(
    "Clinical Cut Off",
    "Completion or Discontinuation",
    "End of AE Reporting Period"
  )

  random_patient_data <- function(patient_info) {
    startdt <- lubridate::date(patient_info$TRTSDTM)
    trtedtm <- lubridate::floor_date(dplyr::case_when(
      is.na(patient_info$TRTEDTM) ~ lubridate::date(patient_info$TRTSDTM) + study_duration_secs,
      TRUE ~ lubridate::date(patient_info$TRTEDTM)
    ), unit = "day")
    enddts <- c(patient_info$EOSDT, lubridate::date(trtedtm))
    enddts_min_index <- which.min(enddts)
    adt <- enddts[enddts_min_index]
    adtm <- lubridate::as_datetime(adt)
    ady <- as.numeric(adt - startdt + 1)
    data.frame(
      ARM = patient_info$ARM,
      STUDYID = patient_info$STUDYID,
      SITEID = patient_info$SITEID,
      USUBJID = patient_info$USUBJID,
      PARAMCD = "AEREPTTE",
      PARAM = "Time to end of AE reporting period",
      CNSR = 0,
      AVAL = lubridate::days(ady) / lubridate::years(1),
      AVALU = "YEARS",
      EVNTDESC = ifelse(enddts_min_index == 1, "Completion or Discontinuation", "End of AE Reporting Period"),
      CNSDTDSC = NA,
      ADTM = adtm,
      ADY = ady,
      stringsAsFactors = FALSE
    )
  }

  paramcd_hy <- c("HYSTTEUL", "HYSTTEBL")
  param_hy <- c("Time to Hy's Law Elevation in relation to ULN", "Time to Hy's Law Elevation in relation to Baseline")
  param_init_list <- relvar_init(param_hy, paramcd_hy)
  adsl_hy <- dplyr::select(adsl, "STUDYID", "USUBJID", "TRTSDTM", "SITEID", "ARM")
  adaette_hy <- expand.grid(
    STUDYID = unique(adsl$STUDYID),
    USUBJID = adsl$USUBJID,
    PARAM = as.factor(param_init_list$relvar1),
    stringsAsFactors = FALSE
  )

  adaette_hy <- dplyr::left_join(adaette_hy, adsl_hy, by = c("STUDYID", "USUBJID"), multiple = "all") %>%
    dplyr::mutate(
      PARAMCD = factor(rel_var(
        df = as.data.frame(adaette_hy),
        var_values = param_init_list$relvar2,
        related_var = "PARAM"
      ))
    ) %>%
    dplyr::mutate(
      CNSR = sample(c(0, 1), prob = c(0.1, 0.9), size = dplyr::n(), replace = TRUE),
      EVNTDESC = dplyr::if_else(
        .data$CNSR == 0,
        "First Post-Baseline Raised ALT or AST Elevation Result",
        NA_character_
      ),
      CNSDTDSC = dplyr::if_else(.data$CNSR == 0, NA_character_,
        sample(c("Last Post-Baseline ALT or AST Result", "Treatment Start"),
          prob = c(0.9, 0.1),
          size = dplyr::n(), replace = TRUE
        )
      )
    ) %>%
    dplyr::rowwise() %>%
    dplyr::mutate(ADTM = dplyr::case_when(
      CNSDTDSC == "Treatment Start" ~ TRTSDTM,
      TRUE ~ TRTSDTM + sample(seq(0, study_duration_secs), size = dplyr::n(), replace = TRUE)
    )) %>%
    dplyr::mutate(
      ADY_int = lubridate::date(ADTM) - lubridate::date(TRTSDTM) + 1,
      ADY = as.numeric(ADY_int),
      AVAL = lubridate::days(ADY_int) / lubridate::weeks(1),
      AVALU = "WEEKS"
    ) %>%
    dplyr::select(-TRTSDTM, -ADY_int)

  random_ae_data <- function(lookup_info, patient_info, patient_data) {
    cnsr <- sample(c(0, 1), 1, prob = c(1 - lookup_info$CNSR_P, lookup_info$CNSR_P))
    ae_rep_tte <- patient_data$AVAL[patient_data$PARAMCD == "AEREPTTE"]
    data.frame(
      ARM = rep(patient_data$ARM, 2),
      STUDYID = rep(patient_data$STUDYID, 2),
      SITEID = rep(patient_data$SITEID, 2),
      USUBJID = rep(patient_data$USUBJID, 2),
      PARAMCD = c(
        paste0("AETTE", lookup_info$CATCD),
        paste0("AETOT", lookup_info$CATCD)
      ),
      PARAM = c(
        paste("Time to first occurrence of", lookup_info$CAT),
        paste("Number of occurrences of", lookup_info$CAT)
      ),
      CNSR = c(cnsr, NA),
      AVAL = c(
        ifelse(cnsr == 1, ae_rep_tte, rtexp(1, lookup_info$LAMBDA * 365.25, r = ae_rep_tte)),
        ifelse(cnsr == 1, 0, rtpois(1, lookup_info$LAMBDA * 365.25))
      ),
      AVALU = c("YEARS", NA),
      EVNTDESC = c(ifelse(cnsr == 0, sample(evntdescr_sel, 1), ""), NA),
      CNSDTDSC = c(ifelse(cnsr == 1, sample(cnsdtdscr_sel, 1), ""), NA),
      stringsAsFactors = FALSE
    ) %>% dplyr::mutate(
      ADY = dplyr::if_else(is.na(AVALU), NA_real_, ceiling(as.numeric(lubridate::dyears(AVAL), "days"))),
      ADTM = dplyr::if_else(
        is.na(AVALU),
        lubridate::as_datetime(NA),
        patient_info$TRTSDTM + lubridate::days(ADY)
      )
    )
  }

  adaette <- split(adsl, adsl$USUBJID) %>%
    lapply(function(patient_info) {
      patient_data <- random_patient_data(patient_info)
      lookup_arm <- lookup_adaette %>%
        dplyr::filter(.data$ARM == as.character(patient_info$ARMCD))
      ae_data <- split(lookup_arm, lookup_arm$CATCD) %>%
        lapply(random_ae_data, patient_data = patient_data, patient_info = patient_info) %>%
        Reduce(rbind, .)
      dplyr::bind_rows(patient_data, ae_data)
    }) %>%
    Reduce(rbind, .)
  adaette <- rbind(adaette, adaette_hy)

  tmc_ex_adaette <- adsl %>%
    dplyr::inner_join(
      dplyr::select(adaette, -"SITEID", -"ARM"),
      by = c("STUDYID", "USUBJID"),
      multiple = "all"
    ) %>%
    dplyr::group_by(.data$USUBJID) %>%
    dplyr::arrange(.data$ADTM) %>%
    dplyr::mutate(PARAM = as.factor(.data$PARAM)) %>%
    dplyr::mutate(PARAMCD = as.factor(.data$PARAMCD)) %>%
    dplyr::ungroup() %>%
    dplyr::arrange(
      .data$STUDYID,
      .data$USUBJID,
      .data$PARAMCD,
      .data$ADTM
    )

  i_lbls <- sapply(
    names(var_labels(tmc_ex_adaette)[is.na(var_labels(tmc_ex_adaette))]),
    function(x) which(names(common_var_labels) == x)
  )
  var_labels(tmc_ex_adaette[names(i_lbls)]) <- common_var_labels[i_lbls]

  save(tmc_ex_adaette, file = "data/tmc_ex_adaette.rda", compress = "xz")
}

generate_adcm <- function(adsl = tmc_ex_adsl,
                          max_n_cms = 5L) {
  set.seed(1)
  lookup_cm <- tibble::tribble(
    ~CMCLAS, ~CMDECOD, ~ATIREL,
    "medcl A", "medname A_1/3", "PRIOR",
    "medcl A", "medname A_2/3", "CONCOMITANT",
    "medcl A", "medname A_3/3", "CONCOMITANT",
    "medcl B", "medname B_1/4", "CONCOMITANT",
    "medcl B", "medname B_2/4", "PRIOR",
    "medcl B", "medname B_3/4", "PRIOR",
    "medcl B", "medname B_4/4", "CONCOMITANT",
    "medcl C", "medname C_1/2", "CONCOMITANT",
    "medcl C", "medname C_2/2", "CONCOMITANT"
  )

  adcm <- Map(function(id, sid) {
    n_cms <- sample(c(0, seq_len(max_n_cms)), 1)
    i <- sample(seq_len(nrow(lookup_cm)), n_cms, TRUE)
    dplyr::mutate(
      lookup_cm[i, ],
      USUBJID = id,
      STUDYID = sid
    )
  }, adsl$USUBJID, adsl$STUDYID) %>%
    Reduce(rbind, .) %>%
    `[`(c(4, 5, 1, 2, 3)) %>%
    dplyr::mutate(CMCAT = .data$CMCLAS %>% with_label("Category for Medication"))

  # merge adsl to be able to add CM date and study day variables
  adcm <- dplyr::inner_join(
    adcm,
    adsl,
    by = c("STUDYID", "USUBJID"),
    multiple = "all"
  ) %>%
    dplyr::rowwise() %>%
    dplyr::mutate(TRTENDT = lubridate::date(dplyr::case_when(
      is.na(TRTEDTM) ~ lubridate::floor_date(lubridate::date(TRTSDTM) + study_duration_secs, unit = "day"),
      TRUE ~ TRTEDTM
    ))) %>%
    dplyr::mutate(ASTDTM = sample(
      seq(lubridate::as_datetime(TRTSDTM), lubridate::as_datetime(TRTENDT), by = "day"),
      size = 1
    )) %>%
    dplyr::mutate(ASTDY = ceiling(difftime(ASTDTM, TRTSDTM, units = "days"))) %>%
    # add 1 to end of range incase both values passed to sample() are the same
    dplyr::mutate(AENDTM = sample(
      seq(lubridate::as_datetime(ASTDTM), lubridate::as_datetime(TRTENDT + 1), by = "day"),
      size = 1
    )) %>%
    dplyr::mutate(AENDY = ceiling(difftime(AENDTM, TRTSDTM, units = "days"))) %>%
    dplyr::select(-TRTENDT) %>%
    dplyr::ungroup() %>%
    dplyr::arrange(STUDYID, USUBJID, ASTDTM)

  tmc_ex_adcm <- adcm %>%
    dplyr::group_by(.data$USUBJID) %>%
    dplyr::mutate(CMSEQ = seq_len(dplyr::n())) %>%
    dplyr::ungroup() %>%
    dplyr::arrange(.data$STUDYID, .data$USUBJID, .data$ASTDTM, .data$CMSEQ) %>%
    dplyr::mutate(
      ATC1 = paste("ATCCLAS1", substr(.data$CMDECOD, 9, 9)) %>% with_label("ATC Level 1 Text"),
      ATC2 = paste("ATCCLAS2", substr(.data$CMDECOD, 9, 9)) %>% with_label("ATC Level 2 Text"),
      ATC3 = paste("ATCCLAS3", substr(.data$CMDECOD, 9, 9)) %>% with_label("ATC Level 3 Text"),
      ATC4 = paste("ATCCLAS4", substr(.data$CMDECOD, 9, 9)) %>% with_label("ATC Level 4 Text")
    ) %>%
    dplyr::mutate(
      CMINDC = sample(c(
        "Nausea", "Hypertension", "Urticaria", "Fever",
        "Asthma", "Infection", "Diabete", "Diarrhea", "Pneumonia"
      ), dplyr::n(), replace = TRUE) %>% with_label("Indication"),
      CMDOSE = sample(1:99, dplyr::n(), replace = TRUE) %>% with_label("Dose per Administration"),
      CMTRT = substr(.data$CMDECOD, 9, 13) %>% with_label("Reported Name of Drug, Med, or Therapy"),
      CMDOSU = sample(c(
        "ug/mL", "ug/kg/day", "%", "uL", "DROP",
        "umol/L", "mg", "mg/breath", "ug"
      ), dplyr::n(), replace = TRUE) %>% with_label("Dose Units")
    ) %>%
    dplyr::mutate(
      CMROUTE = sample(c(
        "INTRAVENOUS", "ORAL", "NASAL",
        "INTRAMUSCULAR", "SUBCUTANEOUS", "INHALED", "RECTAL", "UNKNOWN"
      ), dplyr::n(), replace = TRUE) %>% with_label("Route of Administration"),
      CMDOSFRQ = sample(c(
        "Q4W", "QN", "Q4H", "UNKNOWN", "TWICE",
        "Q4H", "QD", "TID", "4 TIMES PER MONTH"
      ), dplyr::n(), replace = TRUE) %>% with_label("Dosing Frequency per Interval")
    ) %>%
    var_relabel(
      CMCLAS = "Medication Class",
      CMDECOD = "Standardized Medication Name",
      ATIREL = "Time Relation of Medication",
      CMSEQ = "Sponsor-Defined Identifier"
    )

  i_lbls <- sapply(
    names(var_labels(tmc_ex_adcm)[is.na(var_labels(tmc_ex_adcm))]), function(x) which(names(common_var_labels) == x)
  )
  var_labels(tmc_ex_adcm[names(i_lbls)]) <- common_var_labels[i_lbls]

  save(tmc_ex_adcm, file = "data/tmc_ex_adcm.rda", compress = "xz")
}

generate_adeg <- function(adsl = tmc_ex_adsl,
                          n_assessments = 3L,
                          n_days = 3L,
                          max_n_eg = 3L) {
  set.seed(1)
  param <- c("QT Duration", "RR Duration", "Heart Rate", "ECG Interpretation")
  paramcd <- c("QT", "RR", "HR", "ECGINTP")
  paramu <- c("msec", "msec", "beats/min", "")
  visit_format <- "WEEK"

  param_init_list <- relvar_init(param, paramcd)
  unit_init_list <- relvar_init(param, paramu)

  adeg <- expand.grid(
    STUDYID = unique(adsl$STUDYID),
    USUBJID = adsl$USUBJID,
    PARAM = as.factor(param_init_list$relvar1),
    AVISIT = visit_schedule(visit_format = visit_format, n_assessments = n_assessments, n_days = n_days),
    stringsAsFactors = FALSE
  )

  adeg$PARAMCD <- as.factor(rel_var(
    df = adeg,
    var_name = "PARAMCD",
    var_values = param_init_list$relvar2,
    related_var = "PARAM"
  ))

  adeg <- adeg %>% dplyr::mutate(AVAL = dplyr::case_when(
    .data$PARAMCD == "QT" ~ stats::rnorm(nrow(adeg), mean = 350, sd = 100),
    .data$PARAMCD == "RR" ~ stats::rnorm(nrow(adeg), mean = 1050, sd = 300),
    .data$PARAMCD == "HR" ~ stats::rnorm(nrow(adeg), mean = 70, sd = 20),
    .data$PARAMCD == "ECGINTP" ~ NA_real_
  ))

  adeg <- adeg %>% dplyr::mutate(AVISITN = dplyr::case_when(
    AVISIT == "SCREENING" ~ -1,
    AVISIT == "BASELINE" ~ 0,
    (grepl("^WEEK", AVISIT) | grepl("^CYCLE", AVISIT)) ~ as.numeric(AVISIT) - 2,
    TRUE ~ NA_real_
  ))

  adeg$AVALU <- as.factor(rel_var(
    df = adeg,
    var_name = "AVALU",
    var_values = unit_init_list$relvar2,
    related_var = "PARAM"
  ))

  adeg <- adeg[order(adeg$STUDYID, adeg$USUBJID, adeg$PARAMCD, adeg$AVISITN), ]
  adeg <- Reduce(rbind, lapply(split(adeg, adeg$USUBJID), function(x) {
    x$STUDYID <- adsl$STUDYID[which(adsl$USUBJID == x$USUBJID[1])]
    x$ABLFL <- ifelse(toupper(visit_format) == "WEEK" & x$AVISIT == "BASELINE",
      "Y",
      ifelse(toupper(visit_format) == "CYCLE" & x$AVISIT == "CYCLE 1 DAY 1", "Y", "")
    )
    x
  }))

  adeg$BASE <- ifelse(adeg$AVISITN >= 0, retain(adeg, adeg$AVAL, adeg$ABLFL == "Y"), adeg$AVAL)
  adeg <- adeg %>%
    dplyr::mutate(ANRLO = dplyr::case_when(
      .data$PARAMCD == "QT" ~ 200,
      .data$PARAMCD == "RR" ~ 600,
      .data$PARAMCD == "HR" ~ 40,
      .data$PARAMCD == "ECGINTP" ~ NA_real_
    )) %>%
    dplyr::mutate(ANRHI = dplyr::case_when(
      .data$PARAMCD == "QT" ~ 500,
      .data$PARAMCD == "RR" ~ 1500,
      .data$PARAMCD == "HR" ~ 100,
      .data$PARAMCD == "ECGINTP" ~ NA_real_
    )) %>%
    dplyr::mutate(ANRIND = factor(dplyr::case_when(
      .data$AVAL < .data$ANRLO ~ "LOW",
      .data$AVAL >= .data$ANRLO & .data$AVAL <= .data$ANRHI ~ "NORMAL",
      .data$AVAL > .data$ANRHI ~ "HIGH"
    )))

  adeg <- adeg %>%
    dplyr::mutate(CHG = ifelse(.data$AVISITN > 0, .data$AVAL - .data$BASE, NA)) %>%
    dplyr::mutate(PCHG = ifelse(.data$AVISITN > 0, 100 * (.data$CHG / .data$BASE), NA)) %>%
    dplyr::mutate(BASETYPE = "LAST") %>%
    dplyr::group_by(.data$USUBJID, .data$PARAMCD, .data$BASETYPE) %>%
    dplyr::mutate(BNRIND = .data$ANRIND[.data$ABLFL == "Y"]) %>%
    dplyr::ungroup() %>%
    dplyr::mutate(DTYPE = NA)

  adeg$ANRIND <- factor(adeg$ANRIND, levels = c("LOW", "NORMAL", "HIGH"))
  adeg$BNRIND <- factor(adeg$BNRIND, levels = c("LOW", "NORMAL", "HIGH"))

  adeg <- dplyr::inner_join(
    adsl,
    adeg,
    by = c("STUDYID", "USUBJID"),
    multiple = "all"
  ) %>%
    dplyr::rowwise() %>%
    dplyr::mutate(TRTENDT = lubridate::date(dplyr::case_when(
      is.na(TRTEDTM) ~ lubridate::floor_date(lubridate::date(TRTSDTM) + study_duration_secs, unit = "day"),
      TRUE ~ TRTEDTM
    ))) %>%
    dplyr::ungroup() %>%
    dplyr::group_by(USUBJID) %>%
    dplyr::arrange(USUBJID, AVISITN) %>%
    dplyr::mutate(ADTM = rep(
      sort(sample(
        seq(lubridate::as_datetime(TRTSDTM[1]), lubridate::as_datetime(TRTENDT[1]), by = "day"),
        size = nlevels(AVISIT)
      )),
      each = n() / nlevels(AVISIT)
    )) %>%
    dplyr::ungroup() %>%
    dplyr::select(-TRTENDT) %>%
    dplyr::ungroup() %>%
    dplyr::arrange(.data$STUDYID, .data$USUBJID, .data$ADTM)

  adeg <- adeg %>%
    dplyr::group_by(.data$USUBJID) %>%
    dplyr::ungroup() %>%
    dplyr::arrange(
      .data$STUDYID,
      .data$USUBJID,
      .data$PARAMCD,
      .data$BASETYPE,
      .data$AVISITN,
      .data$DTYPE,
      .data$ADTM
    )

  adeg <- adeg %>%
    dplyr::mutate(ONTRTFL = factor(dplyr::case_when(
      is.na(.data$TRTSDTM) ~ "",
      is.na(.data$ADTM) ~ "Y",
      (.data$ADTM < .data$TRTSDTM) ~ "",
      (.data$ADTM > .data$TRTEDTM) ~ "",
      TRUE ~ "Y"
    ))) %>%
    dplyr::mutate(AVALC = ifelse(
      .data$PARAMCD == "ECGINTP",
      as.character(sample_fct(c("ABNORMAL", "NORMAL"), nrow(adeg), prob = c(0.25, 0.75))),
      as.character(.data$AVAL)
    ))

  adeg <- adeg %>% dplyr::mutate(row_check = seq_len(nrow(adeg)))
  get_groups <- function(data, minimum) {
    data <- data %>%
      dplyr::group_by(.data$USUBJID, .data$PARAMCD, .data$BASETYPE) %>%
      dplyr::arrange(.data$ADTM) %>%
      dplyr::filter(
        (.data$AVISIT != "BASELINE" & .data$AVISIT != "SCREENING") &
          (.data$ONTRTFL == "Y" | .data$ADTM <= .data$TRTSDTM)
      ) %>%
      {
        if (minimum == TRUE) {
          dplyr::filter(., .data$AVAL == min(.data$AVAL)) %>%
            dplyr::mutate(., DTYPE = "MINIMUM", AVISIT = "POST-BASELINE MINIMUM")
        } else {
          dplyr::filter(., .data$AVAL == max(.data$AVAL)) %>%
            dplyr::mutate(., DTYPE = "MAXIMUM", AVISIT = "POST-BASELINE MAXIMUM")
        }
      } %>%
      dplyr::slice(1) %>%
      dplyr::ungroup()
    return(data)
  }

  lbls <- var_labels(adeg)
  adeg <- rbind(adeg, get_groups(adeg, TRUE), get_groups(adeg, FALSE)) %>%
    dplyr::arrange(.data$row_check) %>%
    dplyr::group_by(.data$USUBJID, .data$PARAMCD, .data$BASETYPE) %>%
    dplyr::arrange(.data$AVISIT, .by_group = TRUE) %>%
    dplyr::ungroup()
  var_labels(adeg) <- lbls

  adeg <- adeg[, -which(names(adeg) %in% c("row_check"))]
  flag_variables <- function(data, worst_obs) {
    data_compare <- data %>%
      dplyr::mutate(row_check = seq_len(nrow(data)))
    data <- data_compare %>%
      {
        if (worst_obs == FALSE) {
          dplyr::group_by(., .data$USUBJID, .data$PARAMCD, .data$BASETYPE, .data$AVISIT) %>%
            dplyr::arrange(., .data$ADTM)
        } else {
          dplyr::group_by(., .data$USUBJID, .data$PARAMCD, .data$BASETYPE)
        }
      } %>%
      dplyr::filter(
        .data$AVISITN > 0 & (.data$ONTRTFL == "Y" | .data$ADTM <= .data$TRTSDTM) &
          is.na(.data$DTYPE)
      ) %>%
      {
        if (worst_obs == TRUE) {
          dplyr::arrange(., .data$AVALC) %>% dplyr::filter(., ifelse(
            .data$PARAMCD == "ECGINTP",
            ifelse(.data$AVALC == "ABNORMAL", .data$AVALC == "ABNORMAL", .data$AVALC == "NORMAL"),
            .data$AVAL == min(.data$AVAL)
          ))
        } else {
          dplyr::filter(., ifelse(
            .data$PARAMCD == "ECGINTP",
            .data$AVALC == "ABNORMAL" | .data$AVALC == "NORMAL",
            .data$AVAL == min(.data$AVAL)
          ))
        }
      } %>%
      dplyr::slice(1) %>%
      {
        if (worst_obs == TRUE) {
          dplyr::mutate(., new_var = dplyr::case_when(
            (.data$AVALC == "ABNORMAL" | .data$AVALC == "NORMAL") ~ "Y",
            (!is.na(.data$AVAL) & is.na(.data$DTYPE)) ~ "Y",
            TRUE ~ ""
          ))
        } else {
          dplyr::mutate(., new_var = dplyr::case_when(
            (.data$AVALC == "ABNORMAL" | .data$AVALC == "NORMAL") ~ "Y",
            (!is.na(.data$AVAL) & is.na(.data$DTYPE)) ~ "Y",
            TRUE ~ ""
          ))
        }
      } %>%
      dplyr::ungroup()

    data_compare$new_var <- ifelse(data_compare$row_check %in% data$row_check, "Y", "")
    data_compare <- data_compare[, -which(names(data_compare) %in% c("row_check"))]

    return(data_compare)
  }
  adeg <- flag_variables(adeg, FALSE) %>% dplyr::rename(WORS01FL = "new_var")
  adeg <- flag_variables(adeg, TRUE) %>% dplyr::rename(WORS02FL = "new_var")

  tmc_ex_adeg <- adeg %>%
    dplyr::group_by(.data$USUBJID, .data$PARAMCD, .data$BASETYPE) %>%
    dplyr::mutate(BASEC = ifelse(
      .data$PARAMCD == "ECGINTP",
      .data$AVALC[.data$AVISIT == "BASELINE"],
      as.character(.data$BASE)
    )) %>%
    dplyr::ungroup() %>%
    var_relabel(BASEC = "Baseline Character Value")

  i_lbls <- sapply(
    names(var_labels(tmc_ex_adeg)[is.na(var_labels(tmc_ex_adeg))]), function(x) which(names(common_var_labels) == x)
  )
  var_labels(tmc_ex_adeg[names(i_lbls)]) <- common_var_labels[i_lbls]

  save(tmc_ex_adeg, file = "data/tmc_ex_adeg.rda", compress = "xz")
}

generate_adex <- function(adsl = tmc_ex_adsl,
                          n_assessments = 3L,
                          n_days = 3L,
                          max_n_exs = 3L) {
  set.seed(1)
  param <- c(
    "Dose administered during constant dosing interval",
    "Number of doses administered during constant dosing interval",
    "Total dose administered",
    "Total number of doses administered"
  )
  paramcd <- c("DOSE", "NDOSE", "TDOSE", "TNDOSE")
  paramu <- c("mg", " ", "mg", " ")
  parcat1 <- c("INDIVIDUAL", "OVERALL")
  parcat2 <- c("Drug A", "Drug B")
  visit_format <- "WEEK"

  param_init_list <- relvar_init(param, paramcd)
  unit_init_list <- relvar_init(param, paramu)

  adex <- expand.grid(
    STUDYID = unique(adsl$STUDYID),
    USUBJID = adsl$USUBJID,
    PARAM = c(
      rep(
        param_init_list$relvar1[1],
        length(levels(visit_schedule(visit_format = visit_format, n_assessments = n_assessments, n_days = n_days)))
      ),
      rep(
        param_init_list$relvar1[2],
        length(levels(visit_schedule(visit_format = visit_format, n_assessments = n_assessments, n_days = n_days)))
      ),
      param_init_list$relvar1[3:4]
    ),
    stringsAsFactors = FALSE
  )

  adex$PARAMCD <- as.factor(rel_var(
    df = adex,
    var_name = "PARAMCD",
    var_values = param_init_list$relvar2,
    related_var = "PARAM"
  ))

  adex$AVALU <- as.factor(rel_var(
    df = adex,
    var_name = "AVALU",
    var_values = unit_init_list$relvar2,
    related_var = "PARAM"
  ))

  adex <- adex %>%
    dplyr::group_by(.data$USUBJID) %>%
    dplyr::mutate(PARCAT_ind = sample(c(1, 2), size = 1)) %>%
    dplyr::mutate(PARCAT2 = ifelse(.data$PARCAT_ind == 1, parcat2[1], parcat2[2])) %>%
    dplyr::select(-"PARCAT_ind")

  adex <- adex %>% dplyr::mutate(PARCAT1 = dplyr::case_when(
    (.data$PARAMCD == "TNDOSE" | .data$PARAMCD == "TDOSE") ~ "OVERALL",
    .data$PARAMCD == "DOSE" | .data$PARAMCD == "NDOSE" ~ "INDIVIDUAL"
  ))

  adex_visit <- adex %>%
    dplyr::filter(.data$PARAMCD == "DOSE" | .data$PARAMCD == "NDOSE") %>%
    dplyr::mutate(
      AVISIT = rep(visit_schedule(visit_format = visit_format, n_assessments = n_assessments, n_days = n_days), 2)
    )

  adex <- dplyr::left_join(
    adex %>%
      dplyr::group_by(
        .data$USUBJID,
        .data$STUDYID,
        .data$PARAM,
        .data$PARAMCD,
        .data$AVALU,
        .data$PARCAT1,
        .data$PARCAT2
      ) %>%
      dplyr::mutate(id = dplyr::row_number()),
    adex_visit %>%
      dplyr::group_by(
        .data$USUBJID,
        .data$STUDYID,
        .data$PARAM,
        .data$PARAMCD,
        .data$AVALU,
        .data$PARCAT1,
        .data$PARCAT2
      ) %>%
      dplyr::mutate(id = dplyr::row_number()),
    by = c("USUBJID", "STUDYID", "PARCAT1", "PARCAT2", "id", "PARAMCD", "PARAM", "AVALU")
  ) %>%
    dplyr::select(-"id")

  adex <- adex %>% dplyr::mutate(AVISITN = dplyr::case_when(
    AVISIT == "SCREENING" ~ -1,
    AVISIT == "BASELINE" ~ 0,
    (grepl("^WEEK", AVISIT) | grepl("^CYCLE", AVISIT)) ~ as.numeric(AVISIT) - 2,
    TRUE ~ 999000
  ))

  adex2 <- split(adex, adex$USUBJID) %>%
    lapply(function(pinfo) {
      pinfo %>%
        dplyr::filter(.data$PARAMCD == "DOSE") %>%
        dplyr::group_by(.data$USUBJID, .data$PARCAT2, .data$AVISIT) %>%
        dplyr::mutate(changeind = dplyr::case_when(
          .data$AVISIT == "SCREENING" ~ 0,
          .data$AVISIT != "SCREENING" ~ sample(c(-1, 0, 1),
            size = 1,
            prob = c(0.25, 0.5, 0.25),
            replace = TRUE
          )
        )) %>%
        dplyr::ungroup() %>%
        dplyr::group_by(.data$USUBJID, .data$PARCAT2) %>%
        dplyr::mutate(
          csum = cumsum(.data$changeind),
          changeind = dplyr::case_when(
            .data$csum <= -3 ~ sample(c(0, 1), size = 1, prob = c(0.5, 0.5)),
            .data$csum >= 3 ~ sample(c(0, -1), size = 1, prob = c(0.5, 0.5)),
            TRUE ~ .data$changeind
          )
        ) %>%
        dplyr::mutate(csum = cumsum(.data$changeind)) %>%
        dplyr::ungroup() %>%
        dplyr::group_by(.data$USUBJID, .data$PARCAT2, .data$AVISIT) %>%
        dplyr::mutate(AVAL = dplyr::case_when(
          .data$csum == -2 ~ 480,
          .data$csum == -1 ~ 720,
          .data$csum == 0 ~ 960,
          .data$csum == 1 ~ 1200,
          .data$csum == 2 ~ 1440
        )) %>%
        dplyr::select(-c("csum", "changeind")) %>%
        dplyr::ungroup()
    }) %>%
    Reduce(rbind, .)

  adextmp <- dplyr::full_join(adex2, adex, by = names(adex))
  adex <- adextmp %>%
    dplyr::group_by(.data$USUBJID) %>%
    dplyr::mutate(AVAL = ifelse(.data$PARAMCD == "NDOSE", 1, .data$AVAL)) %>%
    dplyr::mutate(AVAL = ifelse(
      .data$PARAMCD == "TNDOSE",
      sum(.data$AVAL[.data$PARAMCD == "NDOSE"]),
      .data$AVAL
    )) %>%
    dplyr::ungroup() %>%
    dplyr::group_by(.data$USUBJID, .data$STUDYID, .data$PARCAT2) %>%
    dplyr::mutate(AVAL = ifelse(
      .data$PARAMCD == "TDOSE",
      sum(.data$AVAL[.data$PARAMCD == "DOSE"]),
      .data$AVAL
    ))

  adex <- dplyr::inner_join(adsl, adex, by = c("STUDYID", "USUBJID"), multiple = "all") %>%
    dplyr::rowwise() %>%
    dplyr::mutate(TRTENDT = lubridate::date(dplyr::case_when(
      is.na(TRTEDTM) ~ lubridate::floor_date(lubridate::date(TRTSDTM) + study_duration_secs, unit = "day"),
      TRUE ~ TRTEDTM
    ))) %>%
    dplyr::mutate(ASTDTM = sample(
      seq(lubridate::as_datetime(TRTSDTM), lubridate::as_datetime(TRTENDT), by = "day"),
      size = 1
    )) %>%
    dplyr::select(-TRTENDT) %>%
    dplyr::ungroup() %>%
    dplyr::arrange(.data$STUDYID, .data$USUBJID, .data$ASTDTM)

  adex <- adex %>%
    dplyr::group_by(.data$USUBJID) %>%
    dplyr::mutate(EXSEQ = seq_len(dplyr::n())) %>%
    dplyr::ungroup() %>%
    dplyr::arrange(
      .data$STUDYID,
      .data$USUBJID,
      .data$PARAMCD,
      .data$ASTDTM,
      .data$AVISITN
    ) %>%
    var_relabel(
      PARCAT1 = "Parameter Category (Individual/Overall)",
      PARCAT2 = "Parameter Category (Drug A/Drug B)",
      EXSEQ = "Analysis Sequence Number"
    )

  visit_levels <- str_extract(levels(adex$AVISIT), pattern = "[0-9]+")
  vl_extracted <- vapply(visit_levels, function(x) as.numeric(x[2]), numeric(1))
  vl_extracted <- c(-1, 1, vl_extracted[!is.na(vl_extracted)])

  tmc_ex_adex <- adex %>%
    dplyr::mutate(VISITDY = as.numeric(as.character(factor(AVISIT, labels = vl_extracted)))) %>%
    dplyr::mutate(ASTDTM = lubridate::as_datetime(TRTSDTM) + lubridate::days(VISITDY)) %>%
    dplyr::distinct(USUBJID, .keep_all = TRUE)

  i_lbls <- sapply(
    names(var_labels(tmc_ex_adex)[is.na(var_labels(tmc_ex_adex))]), function(x) which(names(common_var_labels) == x)
  )
  var_labels(tmc_ex_adex[names(i_lbls)]) <- common_var_labels[i_lbls]

  save(tmc_ex_adex, file = "data/tmc_ex_adex.rda", compress = "xz")
}