| 1 |
- #' Tumor Response Analysis Dataset (ADRS)+ #' Laboratory Data Analysis Dataset (ADLB) |
||
| 5 |
- #' Function for generating a random Tumor Response Analysis Dataset for a given+ #' Function for generating a random Laboratory Data Analysis Dataset for a given |
||
| 8 |
- #' @details+ #' @details One record per subject per parameter per analysis visit per analysis date. |
||
| 9 |
- #' One record per subject per parameter per analysis visit per analysis date.+ #' |
||
| 10 |
- #' SDTM variables are populated on new records coming from other single records.+ #' Keys: `STUDYID`, `USUBJID`, `PARAMCD`, `BASETYPE`, `AVISITN`, `ATPTN`, `DTYPE`, `ADTM`, `LBSEQ`, `ASPID` |
||
| 11 |
- #' Otherwise, SDTM variables are left blank.+ # |
||
| 12 |
- #'+ #' @inheritParams argument_convention |
||
| 13 |
- #' Keys: `STUDYID`, `USUBJID`, `PARAMCD`, `AVISITN`, `ADT`, `RSSEQ`+ #' @param lbcat (`character vector`)\cr LB category values. |
||
| 14 |
- #'+ #' @param max_n_lbs (`integer`)\cr Maximum number of labs per patient. Defaults to 10. |
||
| 15 |
- #' @inheritParams argument_convention+ #' @template param_cached |
||
| 16 |
- #' @param avalc (`character vector`)\cr Analysis value categories.+ #' @templateVar data adlb |
||
| 17 |
- #' @template param_cached+ #' |
||
| 18 |
- #' @templateVar data adrs+ #' @return `data.frame` |
||
| 19 |
- #'+ #' @export |
||
| 20 |
- #' @return `data.frame`+ #' |
||
| 21 |
- #' @export+ #' @author tomlinsj, npaszty, Xuefeng Hou |
||
| 26 |
- #' adrs <- radrs(adsl, seed = 2)+ #' adlb <- radlb(adsl, visit_format = "WEEK", n_assessments = 7L, seed = 2) |
||
| 27 |
- #' adrs+ #' adlb |
||
| 28 |
- radrs <- function(adsl,+ #' |
||
| 29 |
- avalc = NULL,+ #' adlb <- radlb(adsl, visit_format = "CYCLE", n_assessments = 2L, seed = 2) |
||
| 30 |
- lookup = NULL,+ #' adlb |
||
| 31 |
- seed = NULL,+ radlb <- function(adsl, |
||
| 32 |
- na_percentage = 0,+ lbcat = c("CHEMISTRY", "CHEMISTRY", "IMMUNOLOGY"),
|
||
| 33 |
- na_vars = list(AVISIT = c(NA, 0.1), AVAL = c(1234, 0.1), AVALC = c(1234, 0.1)),+ param = c( |
||
| 34 |
- cached = FALSE) {
+ "Alanine Aminotransferase Measurement", |
||
| 35 | -7x | +
- checkmate::assert_flag(cached)+ "C-Reactive Protein Measurement", |
|
| 36 | -7x | +
- if (cached) {
+ "Immunoglobulin A Measurement" |
|
| 37 | -1x | +
- return(get_cached_data("cadrs"))
+ ), |
|
| 38 |
- }+ paramcd = c("ALT", "CRP", "IGA"),
|
||
| 39 |
-
+ paramu = c("U/L", "mg/L", "g/L"),
|
||
| 40 | -6x | +
- checkmate::assert_data_frame(adsl)+ aval_mean = c(18, 9, 2.9), |
|
| 41 | -6x | +
- checkmate::assert_vector(avalc, null.ok = TRUE)+ visit_format = "WEEK", |
|
| 42 | -6x | +
- checkmate::assert_number(seed, null.ok = TRUE)+ n_assessments = 5L, |
|
| 43 | -6x | +
- checkmate::assert_number(na_percentage, lower = 0, upper = 1)+ n_days = 5L, |
|
| 44 | -6x | +
- checkmate::assert_true(na_percentage < 1)+ max_n_lbs = 10L, |
|
| 45 |
-
+ lookup = NULL, |
||
| 46 | -6x | +
- param_codes <- if (!is.null(avalc)) {
+ seed = NULL, |
|
| 47 | -! | +
- avalc+ na_percentage = 0, |
|
| 48 |
- } else {
+ na_vars = list( |
||
| 49 | -6x | +
- stats::setNames(1:5, c("CR", "PR", "SD", "PD", "NE"))
+ LOQFL = c(NA, 0.1), ABLFL2 = c(1234, 0.1), ABLFL = c(1235, 0.1), |
|
| 50 |
- }+ BASE2 = c(NA, 0.1), BASE = c(NA, 0.1), |
||
| 51 |
-
+ CHG2 = c(1235, 0.1), PCHG2 = c(1235, 0.1), CHG = c(1234, 0.1), PCHG = c(1234, 0.1) |
||
| 52 | -6x | +
- checkmate::assert_data_frame(lookup, null.ok = TRUE)+ ), |
|
| 53 | -6x | +
- lookup_ars <- if (!is.null(lookup)) {
+ cached = FALSE) {
|
|
| 54 | -! | +4x |
- lookup+ checkmate::assert_flag(cached) |
| 55 | -+ | 4x |
- } else {
+ if (cached) {
|
| 56 | -6x | +1x |
- expand.grid(+ return(get_cached_data("cadlb"))
|
| 57 | -6x | +
- ARM = c("A: Drug X", "B: Placebo", "C: Combination"),
+ } |
|
| 58 | -6x | +
- AVALC = names(param_codes)+ |
|
| 59 | -6x | +3x |
- ) %>% dplyr::mutate(+ checkmate::assert_data_frame(adsl) |
| 60 | -6x | +3x |
- AVAL = param_codes[AVALC],+ checkmate::assert_character(param, min.len = 1, any.missing = FALSE) |
| 61 | -6x | +3x |
- p_scr = c(rep(0, 3), rep(0, 3), c(1, 1, 1), c(0, 0, 0), c(0, 0, 0)),+ checkmate::assert_character(paramcd, min.len = 1, any.missing = FALSE) |
| 62 | -6x | +3x |
- p_bsl = c(rep(0, 3), rep(0, 3), c(1, 1, 1), c(0, 0, 0), c(0, 0, 0)),+ checkmate::assert_character(paramu, min.len = 1, any.missing = FALSE) |
| 63 | -6x | +3x |
- p_cycle = c(c(.4, .3, .5), c(.35, .25, .25), c(.1, .2, .08), c(.14, 0.15, 0.15), c(.01, 0.1, 0.02)),+ checkmate::assert_character(lbcat, min.len = 1, any.missing = FALSE) |
| 64 | -6x | +3x |
- p_eoi = c(c(.4, .3, .5), c(.35, .25, .25), c(.1, .2, .08), c(.14, 0.15, 0.15), c(.01, 0.1, 0.02)),+ checkmate::assert_string(visit_format) |
| 65 | -6x | +3x |
- p_fu = c(c(.3, .2, .4), c(.2, .1, .3), c(.2, .2, .2), c(.3, .5, 0.1), rep(0, 3))+ checkmate::assert_integer(n_assessments, len = 1, any.missing = FALSE) |
| 66 | -+ | 3x |
- )+ checkmate::assert_integer(n_days, len = 1, any.missing = FALSE) |
| 67 | -+ | 3x |
- }+ checkmate::assert_integer(max_n_lbs, len = 1, any.missing = FALSE) |
| 68 | -+ | 3x |
-
+ checkmate::assert_data_frame(lookup, null.ok = TRUE) |
| 69 | -6x | +3x |
- if (!is.null(seed)) {
+ checkmate::assert_number(seed, null.ok = TRUE) |
| 70 | -6x | +3x |
- set.seed(seed)+ checkmate::assert_number(na_percentage, lower = 0, upper = 1) |
| 71 | -+ | 3x |
- }+ checkmate::assert_true(na_percentage < 1) |
| 72 | -6x | +
- study_duration_secs <- lubridate::seconds(attr(adsl, "study_duration_secs"))+ |
|
| 73 |
-
+ # validate and initialize related variables |
||
| 74 | -6x | +3x |
- adrs <- split(adsl, adsl$USUBJID) %>%+ lbcat_init_list <- relvar_init(param, lbcat) |
| 75 | -6x | +3x |
- lapply(function(pinfo) {
+ param_init_list <- relvar_init(param, paramcd) |
| 76 | -60x | +3x |
- probs <- dplyr::filter(lookup_ars, ARM == as.character(pinfo$ACTARM))+ unit_init_list <- relvar_init(param, paramu) |
| 78 | -+ | 3x |
- # screening+ if (!is.null(seed)) {
|
| 79 | -60x | +3x |
- rsp_screen <- sample(probs$AVALC, 1, prob = probs$p_scr) %>% as.character()+ set.seed(seed) |
| 80 |
-
+ } |
||
| 81 | -+ | 3x |
- # baseline+ study_duration_secs <- lubridate::seconds(attr(adsl, "study_duration_secs")) |
| 82 | -60x | +
- rsp_bsl <- sample(probs$AVALC, 1, prob = probs$p_bsl) %>% as.character()+ |
|
| 83 | -+ | 3x |
-
+ adlb <- expand.grid( |
| 84 | -+ | 3x |
- # cycle+ STUDYID = unique(adsl$STUDYID), |
| 85 | -60x | +3x |
- rsp_c2d1 <- sample(probs$AVALC, 1, prob = probs$p_cycle) %>% as.character()+ USUBJID = adsl$USUBJID, |
| 86 | -60x | +3x |
- rsp_c4d1 <- sample(probs$AVALC, 1, prob = probs$p_cycle) %>% as.character()+ PARAM = as.factor(param_init_list$relvar1), |
| 87 | -+ | 3x |
-
+ AVISIT = visit_schedule(visit_format = visit_format, n_assessments = n_assessments, n_days = n_days), |
| 88 | -+ | 3x |
- # end of induction+ stringsAsFactors = FALSE |
| 89 | -60x | +
- rsp_eoi <- sample(probs$AVALC, 1, prob = probs$p_eoi) %>% as.character()+ ) |
|
| 91 |
- # follow up+ # assign AVAL based on different tests |
||
| 92 | -60x | +3x |
- rsp_fu <- sample(probs$AVALC, 1, prob = probs$p_fu) %>% as.character()+ adlb <- adlb %>% mutate(AVAL = case_when( |
| 93 | -+ | 3x |
-
+ PARAM == param[1] ~ abs(stats::rnorm(nrow(adlb), mean = aval_mean[1], sd = 10)), |
| 94 | -60x | +3x |
- best_rsp <- min(param_codes[c(rsp_screen, rsp_bsl, rsp_eoi, rsp_fu, rsp_c2d1, rsp_c4d1)])+ PARAM == param[2] ~ abs(stats::rnorm(nrow(adlb), mean = aval_mean[2], sd = 1)), |
| 95 | -60x | +3x |
- best_rsp_i <- which.min(param_codes[c(rsp_screen, rsp_bsl, rsp_eoi, rsp_fu, rsp_c2d1, rsp_c4d1)])+ PARAM == param[3] ~ abs(stats::rnorm(nrow(adlb), mean = aval_mean[3], sd = 0.1)) |
| 96 |
-
+ )) |
||
| 97 | -60x | +
- avisit <- c("SCREENING", "BASELINE", "CYCLE 2 DAY 1", "CYCLE 4 DAY 1", "END OF INDUCTION", "FOLLOW UP")
+
|
|
| 98 |
-
+ # assign related variable values: PARAMxLBCAT are related |
||
| 99 | -+ | 3x |
- # meaningful date information+ adlb <- adlb %>% rel_var( |
| 100 | -60x | +3x |
- trtstdt <- lubridate::date(pinfo$TRTSDTM)+ var_name = "LBCAT", |
| 101 | -60x | +3x |
- trtendt <- lubridate::date(dplyr::if_else(+ related_var = "PARAM", |
| 102 | -60x | +3x |
- !is.na(pinfo$TRTEDTM), pinfo$TRTEDTM,+ var_values = lbcat_init_list$relvar2 |
| 103 | -60x | +
- lubridate::floor_date(trtstdt + study_duration_secs, unit = "day")+ ) |
|
| 104 |
- ))+ |
||
| 105 | -60x | +
- scr_date <- trtstdt - lubridate::days(100)+ # assign related variable values: PARAMxPARAMCD are related |
|
| 106 | -60x | +3x |
- bs_date <- trtstdt+ adlb <- adlb %>% rel_var( |
| 107 | -60x | +3x |
- flu_date <- sample(seq(lubridate::as_datetime(trtstdt), lubridate::as_datetime(trtendt), by = "day"), size = 1)+ var_name = "PARAMCD", |
| 108 | -60x | +3x |
- eoi_date <- sample(seq(lubridate::as_datetime(trtstdt), lubridate::as_datetime(trtendt), by = "day"), size = 1)+ related_var = "PARAM", |
| 109 | -60x | +3x |
- c2d1_date <- sample(seq(lubridate::as_datetime(trtstdt), lubridate::as_datetime(trtendt), by = "day"), size = 1)+ var_values = param_init_list$relvar2 |
| 110 | -60x | +
- c4d1_date <- min(lubridate::date(c2d1_date + lubridate::days(60)), trtendt)+ ) |
|
| 112 | -60x | +3x |
- tibble::tibble(+ adlb <- adlb %>% |
| 113 | -60x | +3x |
- STUDYID = pinfo$STUDYID,+ dplyr::mutate(LBTESTCD = PARAMCD) %>% |
| 114 | -60x | +3x |
- SITEID = pinfo$SITEID,+ dplyr::mutate(LBTEST = PARAM) |
| 115 | -60x | +
- USUBJID = pinfo$USUBJID,+ |
|
| 116 | -60x | +3x |
- PARAMCD = as.factor(c(rep("OVRINV", 6), "BESRSPI", "INVET")),
+ adlb <- adlb %>% dplyr::mutate(AVISITN = dplyr::case_when( |
| 117 | -60x | +3x |
- PARAM = as.factor(dplyr::recode(+ AVISIT == "SCREENING" ~ -1, |
| 118 | -60x | +3x |
- PARAMCD,+ AVISIT == "BASELINE" ~ 0, |
| 119 | -60x | +3x |
- OVRINV = "Overall Response by Investigator - by visit",+ (grepl("^WEEK", AVISIT) | grepl("^CYCLE", AVISIT)) ~ as.numeric(AVISIT) - 2,
|
| 120 | -60x | +3x |
- OVRSPI = "Best Overall Response by Investigator (no confirmation required)",+ TRUE ~ NA_real_ |
| 121 | -60x | +
- BESRSPI = "Best Confirmed Overall Response by Investigator",+ )) |
|
| 122 | -60x | +
- INVET = "Investigator End Of Induction Response"+ |
|
| 123 | -+ | 3x |
- )),+ adlb <- adlb %>% rel_var( |
| 124 | -60x | +3x |
- AVALC = c(+ var_name = "AVALU", |
| 125 | -60x | +3x |
- rsp_screen, rsp_bsl, rsp_c2d1, rsp_c4d1, rsp_eoi, rsp_fu,+ related_var = "PARAM", |
| 126 | -60x | +3x |
- names(param_codes)[best_rsp],+ var_values = unit_init_list$relvar2 |
| 127 | -60x | +
- rsp_eoi+ ) |
|
| 128 |
- ),+ |
||
| 129 | -60x | +3x |
- AVAL = param_codes[AVALC],+ adlb <- adlb %>% |
| 130 | -60x | +3x |
- AVISIT = factor(c(avisit, avisit[best_rsp_i], avisit[5]), levels = avisit)+ dplyr::mutate(AVISITN = dplyr::case_when( |
| 131 | -+ | 3x |
- ) %>%+ AVISIT == "SCREENING" ~ -1, |
| 132 | -60x | +3x |
- merge(+ AVISIT == "BASELINE" ~ 0, |
| 133 | -60x | +3x |
- tibble::tibble(+ (grepl("^WEEK", AVISIT) | grepl("^CYCLE", AVISIT)) ~ as.numeric(AVISIT) - 2,
|
| 134 | -60x | +3x |
- AVISIT = avisit,+ TRUE ~ NA_real_ |
| 135 | -60x | +
- ADTM = c(scr_date, bs_date, c2d1_date, c4d1_date, eoi_date, flu_date),+ )) |
|
| 136 | -60x | +
- AVISITN = c(-1, 0, 2, 4, 999, 999),+ |
|
| 137 | -60x | +
- TRTSDTM = pinfo$TRTSDTM+ # order to prepare for change from screening and baseline values |
|
| 138 | -+ | 3x |
- ) %>%+ adlb <- adlb[order(adlb$STUDYID, adlb$USUBJID, adlb$PARAMCD, adlb$AVISITN), ] |
| 139 | -60x | +
- dplyr::mutate(+ |
|
| 140 | -60x | +3x |
- ADY = ceiling(difftime(ADTM, TRTSDTM, units = "days"))+ adlb <- Reduce(rbind, lapply(split(adlb, adlb$USUBJID), function(x) {
|
| 141 | -+ | 30x |
- ) %>%+ x$STUDYID <- adsl$STUDYID[which(adsl$USUBJID == x$USUBJID[1])] |
| 142 | -60x | +30x |
- dplyr::select(-"TRTSDTM"),+ x$ABLFL2 <- ifelse(x$AVISIT == "SCREENING", "Y", "") |
| 143 | -60x | +30x |
- by = "AVISIT"+ x$ABLFL <- ifelse(toupper(visit_format) == "WEEK" & x$AVISIT == "BASELINE", |
| 144 | -+ | 30x |
- )+ "Y", |
| 145 | -+ | 30x |
- }) %>%+ ifelse(toupper(visit_format) == "CYCLE" & x$AVISIT == "CYCLE 1 DAY 1", "Y", "") |
| 146 | -6x | +
- Reduce(rbind, .) %>%+ ) |
|
| 147 | -6x | +30x |
- dplyr::mutate(AVALC = factor(AVALC, levels = names(param_codes))) %>%+ x |
| 148 | -6x | +
- var_relabel(+ })) |
|
| 149 | -6x | +
- STUDYID = "Study Identifier",+ |
|
| 150 | -6x | +3x |
- USUBJID = "Unique Subject Identifier"+ adlb$BASE2 <- retain(adlb, adlb$AVAL, adlb$ABLFL2 == "Y") |
| 151 | -+ | 3x |
- )+ adlb$BASE <- ifelse(adlb$ABLFL2 != "Y", retain(adlb, adlb$AVAL, adlb$ABLFL == "Y"), NA) |
| 153 | -6x | +3x |
- adrs <- var_relabel(+ adlb <- adlb %>% |
| 154 | -6x | +3x |
- adrs,+ dplyr::mutate(CHG2 = AVAL - BASE2) %>% |
| 155 | -6x | +3x |
- STUDYID = "Study Identifier",+ dplyr::mutate(PCHG2 = 100 * (CHG2 / BASE2)) %>% |
| 156 | -6x | +3x |
- USUBJID = "Unique Subject Identifier"+ dplyr::mutate(CHG = AVAL - BASE) %>% |
| 157 | -+ | 3x |
- )+ dplyr::mutate(PCHG = 100 * (CHG / BASE)) %>% |
| 158 | -+ | 3x |
-
+ dplyr::mutate(BASETYPE = "LAST") %>% |
| 159 | -+ | 3x |
- # merge ADSL to be able to add RS date and study day variables+ dplyr::mutate(ANRLO = dplyr::case_when( |
| 160 | -+ | 3x |
-
+ PARAMCD == "ALT" ~ 7, |
| 161 | -+ | 3x |
-
+ PARAMCD == "CRP" ~ 8, |
| 162 | -6x | +3x |
- adrs <- dplyr::inner_join(+ PARAMCD == "IGA" ~ 0.8 |
| 163 | -6x | +
- dplyr::select(adrs, -"SITEID"),+ )) %>% |
|
| 164 | -6x | +3x |
- adsl,+ dplyr::mutate(ANRHI = dplyr::case_when( |
| 165 | -6x | +3x |
- by = c("STUDYID", "USUBJID")
+ PARAMCD == "ALT" ~ 55, |
| 166 | -+ | 3x |
- )+ PARAMCD == "CRP" ~ 10, |
| 167 | -+ | 3x |
-
+ PARAMCD == "IGA" ~ 3 |
| 168 | -6x | +
- adrs <- adrs %>%+ )) %>% |
|
| 169 | -6x | +3x |
- dplyr::group_by(USUBJID) %>%+ dplyr::mutate(ANRIND = factor(dplyr::case_when( |
| 170 | -6x | +3x |
- dplyr::mutate(RSSEQ = seq_len(dplyr::n())) %>%+ AVAL < ANRLO ~ "LOW", |
| 171 | -6x | +3x |
- dplyr::mutate(ASEQ = RSSEQ) %>%+ AVAL > ANRHI ~ "HIGH", |
| 172 | -6x | +3x |
- dplyr::ungroup() %>%+ TRUE ~ "NORMAL" |
| 173 | -6x | +
- dplyr::arrange(+ ))) %>% |
|
| 174 | -6x | +3x |
- STUDYID,+ dplyr::mutate(LBSTRESC = factor(dplyr::case_when( |
| 175 | -6x | +3x |
- USUBJID,+ PARAMCD == "ALT" ~ "<7", |
| 176 | -6x | +3x |
- PARAMCD,+ PARAMCD == "CRP" ~ "<8", |
| 177 | -6x | +3x |
- AVISITN,+ PARAMCD == "IGA" ~ ">3" |
| 178 | -6x | +
- ADTM,+ ))) %>% |
|
| 179 | -6x | +3x |
- RSSEQ+ dplyr::rowwise() %>% |
| 180 | -+ | 3x |
- )+ dplyr::mutate(LOQFL = factor( |
| 181 | -+ | 3x |
-
+ ifelse(eval(parse(text = paste(AVAL, LBSTRESC))), "Y", "N") |
| 182 | -6x | +
- if (length(na_vars) > 0 && na_percentage > 0) {
+ )) %>% |
|
| 183 | -! | +3x |
- adrs <- mutate_na(ds = adrs, na_vars = na_vars, na_percentage = na_percentage)+ dplyr::ungroup() %>% |
| 184 | -+ | 3x |
- }+ dplyr::group_by(USUBJID, PARAMCD, BASETYPE) %>% |
| 185 | -+ | 3x |
-
+ dplyr::mutate(BNRIND = ANRIND[ABLFL == "Y"]) %>% |
| 186 | -+ | 3x |
- # apply metadata+ dplyr::ungroup() %>% |
| 187 | -6x | +3x |
- adrs <- apply_metadata(adrs, "metadata/ADRS.yml")+ dplyr::mutate(SHIFT1 = factor(ifelse( |
| 188 | -+ | 3x |
-
+ AVISITN > 0, |
| 189 | -6x | +3x |
- return(adrs)+ paste( |
| 190 | -+ | 3x |
- }+ retain( |
| 1 | -+ | |||
| 191 | +3x |
- #' Laboratory Data Analysis Dataset (ADLB)+ adlb, as.character(BNRIND), |
||
| 2 | -+ | |||
| 192 | +3x |
- #'+ AVISITN == 0 |
||
| 3 | +193 |
- #' @description `r lifecycle::badge("stable")`
+ ), |
||
| 4 | -+ | |||
| 194 | +3x |
- #'+ ANRIND, |
||
| 5 | -+ | |||
| 195 | +3x |
- #' Function for generating a random Laboratory Data Analysis Dataset for a given+ sep = " to " |
||
| 6 | +196 |
- #' Subject-Level Analysis Dataset.+ ), |
||
| 7 | +197 |
- #'+ "" |
||
| 8 | +198 |
- #' @details One record per subject per parameter per analysis visit per analysis date.+ ))) %>% |
||
| 9 | -+ | |||
| 199 | +3x |
- #'+ dplyr::mutate(ATOXGR = factor(dplyr::case_when( |
||
| 10 | -+ | |||
| 200 | +3x |
- #' Keys: `STUDYID`, `USUBJID`, `PARAMCD`, `BASETYPE`, `AVISITN`, `ATPTN`, `DTYPE`, `ADTM`, `LBSEQ`, `ASPID`+ ANRIND == "LOW" ~ sample( |
||
| 11 | -+ | |||
| 201 | +3x |
- #+ c("-1", "-2", "-3", "-4", "-5"),
|
||
| 12 | -+ | |||
| 202 | +3x |
- #' @inheritParams argument_convention+ nrow(adlb), |
||
| 13 | -+ | |||
| 203 | +3x |
- #' @param lbcat (`character vector`)\cr LB category values.+ replace = TRUE, |
||
| 14 | -+ | |||
| 204 | +3x |
- #' @param max_n_lbs (`integer`)\cr Maximum number of labs per patient. Defaults to 10.+ prob = c(0.30, 0.25, 0.20, 0.15, 0) |
||
| 15 | +205 |
- #' @template param_cached+ ), |
||
| 16 | -+ | |||
| 206 | +3x |
- #' @templateVar data adlb+ ANRIND == "HIGH" ~ sample( |
||
| 17 | -+ | |||
| 207 | +3x |
- #'+ c("1", "2", "3", "4", "5"),
|
||
| 18 | -+ | |||
| 208 | +3x |
- #' @return `data.frame`+ nrow(adlb), |
||
| 19 | -+ | |||
| 209 | +3x |
- #' @export+ replace = TRUE, |
||
| 20 | -+ | |||
| 210 | +3x |
- #'+ prob = c(0.30, 0.25, 0.20, 0.15, 0) |
||
| 21 | +211 |
- #' @author tomlinsj, npaszty, Xuefeng Hou+ ), |
||
| 22 | -+ | |||
| 212 | +3x |
- #'+ ANRIND == "NORMAL" ~ "0" |
||
| 23 | +213 |
- #' @examples+ ))) %>% |
||
| 24 | -+ | |||
| 214 | +3x |
- #' adsl <- radsl(N = 10, seed = 1, study_duration = 2)+ dplyr::group_by(USUBJID, PARAMCD, BASETYPE) %>% |
||
| 25 | -+ | |||
| 215 | +3x |
- #'+ dplyr::mutate(BTOXGR = ATOXGR[ABLFL == "Y"]) %>% |
||
| 26 | -+ | |||
| 216 | +3x |
- #' adlb <- radlb(adsl, visit_format = "WEEK", n_assessments = 7L, seed = 2)+ dplyr::ungroup() %>% |
||
| 27 | -+ | |||
| 217 | +3x |
- #' adlb+ dplyr::mutate(ATPTN = 1) %>% |
||
| 28 | -+ | |||
| 218 | +3x |
- #'+ dplyr::mutate(DTYPE = NA) %>% |
||
| 29 | -+ | |||
| 219 | +3x |
- #' adlb <- radlb(adsl, visit_format = "CYCLE", n_assessments = 2L, seed = 2)+ dplyr::mutate(BTOXGRL = factor(dplyr::case_when( |
||
| 30 | -+ | |||
| 220 | +3x |
- #' adlb+ BTOXGR == "0" ~ "0", |
||
| 31 | -+ | |||
| 221 | +3x |
- radlb <- function(adsl,+ BTOXGR == "-1" ~ "1", |
||
| 32 | -+ | |||
| 222 | +3x |
- lbcat = c("CHEMISTRY", "CHEMISTRY", "IMMUNOLOGY"),
+ BTOXGR == "-2" ~ "2", |
||
| 33 | -+ | |||
| 223 | +3x |
- param = c(+ BTOXGR == "-3" ~ "3", |
||
| 34 | -+ | |||
| 224 | +3x |
- "Alanine Aminotransferase Measurement",+ BTOXGR == "-4" ~ "4", |
||
| 35 | -+ | |||
| 225 | +3x |
- "C-Reactive Protein Measurement",+ BTOXGR == "1" ~ "<Missing>", |
||
| 36 | -+ | |||
| 226 | +3x |
- "Immunoglobulin A Measurement"+ BTOXGR == "2" ~ "<Missing>", |
||
| 37 | -+ | |||
| 227 | +3x |
- ),+ BTOXGR == "3" ~ "<Missing>", |
||
| 38 | -+ | |||
| 228 | +3x |
- paramcd = c("ALT", "CRP", "IGA"),
+ BTOXGR == "4" ~ "<Missing>" |
||
| 39 | +229 |
- paramu = c("U/L", "mg/L", "g/L"),
+ ))) %>% |
||
| 40 | -+ | |||
| 230 | +3x |
- aval_mean = c(18, 9, 2.9),+ dplyr::mutate(BTOXGRH = factor(dplyr::case_when( |
||
| 41 | -+ | |||
| 231 | +3x |
- visit_format = "WEEK",+ BTOXGR == "0" ~ "0", |
||
| 42 | -+ | |||
| 232 | +3x |
- n_assessments = 5L,+ BTOXGR == "1" ~ "1", |
||
| 43 | -+ | |||
| 233 | +3x |
- n_days = 5L,+ BTOXGR == "2" ~ "2", |
||
| 44 | -+ | |||
| 234 | +3x |
- max_n_lbs = 10L,+ BTOXGR == "3" ~ "3", |
||
| 45 | -+ | |||
| 235 | +3x |
- lookup = NULL,+ BTOXGR == "4" ~ "4", |
||
| 46 | -+ | |||
| 236 | +3x |
- seed = NULL,+ BTOXGR == "-1" ~ "<Missing>", |
||
| 47 | -+ | |||
| 237 | +3x |
- na_percentage = 0,+ BTOXGR == "-2" ~ "<Missing>", |
||
| 48 | -+ | |||
| 238 | +3x |
- na_vars = list(+ BTOXGR == "-3" ~ "<Missing>", |
||
| 49 | -+ | |||
| 239 | +3x |
- LOQFL = c(NA, 0.1), ABLFL2 = c(1234, 0.1), ABLFL = c(1235, 0.1),+ BTOXGR == "-4" ~ "<Missing>", |
||
| 50 | +240 |
- BASE2 = c(NA, 0.1), BASE = c(NA, 0.1),+ ))) %>% |
||
| 51 | -+ | |||
| 241 | +3x |
- CHG2 = c(1235, 0.1), PCHG2 = c(1235, 0.1), CHG = c(1234, 0.1), PCHG = c(1234, 0.1)+ dplyr::mutate(ATOXGRL = factor(dplyr::case_when( |
||
| 52 | -+ | |||
| 242 | +3x |
- ),+ ATOXGR == "0" ~ "0", |
||
| 53 | -+ | |||
| 243 | +3x |
- cached = FALSE) {
+ ATOXGR == "-1" ~ "1", |
||
| 54 | -4x | +244 | +3x |
- checkmate::assert_flag(cached)+ ATOXGR == "-2" ~ "2", |
| 55 | -4x | +245 | +3x |
- if (cached) {
+ ATOXGR == "-3" ~ "3", |
| 56 | -1x | +246 | +3x |
- return(get_cached_data("cadlb"))
+ ATOXGR == "-4" ~ "4", |
| 57 | -+ | |||
| 247 | +3x |
- }+ ATOXGR == "1" ~ "<Missing>",+ |
+ ||
| 248 | +3x | +
+ ATOXGR == "2" ~ "<Missing>",+ |
+ ||
| 249 | +3x | +
+ ATOXGR == "3" ~ "<Missing>",+ |
+ ||
| 250 | +3x | +
+ ATOXGR == "4" ~ "<Missing>", |
||
| 58 | +251 |
-
+ ))) %>% |
||
| 59 | +252 | 3x |
- checkmate::assert_data_frame(adsl)+ dplyr::mutate(ATOXGRH = factor(dplyr::case_when( |
|
| 60 | +253 | 3x |
- checkmate::assert_character(param, min.len = 1, any.missing = FALSE)+ ATOXGR == "0" ~ "0", |
|
| 61 | +254 | 3x |
- checkmate::assert_character(paramcd, min.len = 1, any.missing = FALSE)+ ATOXGR == "1" ~ "1", |
|
| 62 | +255 | 3x |
- checkmate::assert_character(paramu, min.len = 1, any.missing = FALSE)+ ATOXGR == "2" ~ "2", |
|
| 63 | +256 | 3x |
- checkmate::assert_character(lbcat, min.len = 1, any.missing = FALSE)+ ATOXGR == "3" ~ "3", |
|
| 64 | +257 | 3x |
- checkmate::assert_string(visit_format)+ ATOXGR == "4" ~ "4", |
|
| 65 | +258 | 3x |
- checkmate::assert_integer(n_assessments, len = 1, any.missing = FALSE)+ ATOXGR == "-1" ~ "<Missing>", |
|
| 66 | +259 | 3x |
- checkmate::assert_integer(n_days, len = 1, any.missing = FALSE)+ ATOXGR == "-2" ~ "<Missing>", |
|
| 67 | +260 | 3x |
- checkmate::assert_integer(max_n_lbs, len = 1, any.missing = FALSE)+ ATOXGR == "-3" ~ "<Missing>", |
|
| 68 | +261 | 3x |
- checkmate::assert_data_frame(lookup, null.ok = TRUE)+ ATOXGR == "-4" ~ "<Missing>",+ |
+ |
| 262 | ++ |
+ ))) %>% |
||
| 69 | +263 | 3x |
- checkmate::assert_number(seed, null.ok = TRUE)+ var_relabel( |
|
| 70 | +264 | 3x |
- checkmate::assert_number(na_percentage, lower = 0, upper = 1)+ STUDYID = attr(adsl$STUDYID, "label"), |
|
| 71 | +265 | 3x |
- checkmate::assert_true(na_percentage < 1)+ USUBJID = attr(adsl$USUBJID, "label") |
|
| 72 | +266 | ++ |
+ )+ |
+ |
| 267 | ||||
| 73 | +268 |
- # validate and initialize related variables+ # High and low descriptions of the different PARAMCD values+ |
+ ||
| 269 | ++ |
+ # This is currently hard coded as the GDSR does not have these descriptions yet |
||
| 74 | +270 | 3x |
- lbcat_init_list <- relvar_init(param, lbcat)+ grade_lookup <- tibble::tribble( |
|
| 75 | +271 | 3x |
- param_init_list <- relvar_init(param, paramcd)+ ~PARAMCD, ~ATOXDSCL, ~ATOXDSCH, |
|
| 76 | +272 | 3x |
- unit_init_list <- relvar_init(param, paramu)+ "ALB", "Hypoalbuminemia", NA_character_, |
|
| 77 | -+ | |||
| 273 | +3x |
-
+ "ALKPH", NA_character_, "Alkaline phosphatase increased", |
||
| 78 | +274 | 3x |
- if (!is.null(seed)) {
+ "ALT", NA_character_, "Alanine aminotransferase increased", |
|
| 79 | +275 | 3x |
- set.seed(seed)+ "AST", NA_character_, "Aspartate aminotransferase increased", |
|
| 80 | -+ | |||
| 276 | +3x |
- }+ "BILI", NA_character_, "Blood bilirubin increased", |
||
| 81 | +277 | 3x |
- study_duration_secs <- lubridate::seconds(attr(adsl, "study_duration_secs"))+ "CA", "Hypocalcemia", "Hypercalcemia", |
|
| 82 | -+ | |||
| 278 | +3x |
-
+ "CHOLES", NA_character_, "Cholesterol high", |
||
| 83 | +279 | 3x |
- adlb <- expand.grid(+ "CK", NA_character_, "CPK increased", |
|
| 84 | +280 | 3x |
- STUDYID = unique(adsl$STUDYID),+ "CREAT", NA_character_, "Creatinine increased", |
|
| 85 | +281 | 3x |
- USUBJID = adsl$USUBJID,+ "CRP", NA_character_, "C reactive protein increased", |
|
| 86 | +282 | 3x |
- PARAM = as.factor(param_init_list$relvar1),+ "GGT", NA_character_, "GGT increased", |
|
| 87 | +283 | 3x |
- AVISIT = visit_schedule(visit_format = visit_format, n_assessments = n_assessments, n_days = n_days),+ "GLUC", "Hypoglycemia", "Hyperglycemia", |
|
| 88 | +284 | 3x |
- stringsAsFactors = FALSE+ "HGB", "Anemia", "Hemoglobin increased", |
|
| 89 | -+ | |||
| 285 | +3x |
- )+ "IGA", NA_character_, "Immunoglobulin A increased", |
||
| 90 | -+ | |||
| 286 | +3x |
-
+ "POTAS", "Hypokalemia", "Hyperkalemia", |
||
| 91 | -+ | |||
| 287 | +3x |
- # assign AVAL based on different tests+ "LYMPH", "CD4 lymphocytes decreased", NA_character_, |
||
| 92 | +288 | 3x |
- adlb <- adlb %>% mutate(AVAL = case_when(+ "PHOS", "Hypophosphatemia", NA_character_, |
|
| 93 | +289 | 3x |
- PARAM == param[1] ~ abs(stats::rnorm(nrow(adlb), mean = aval_mean[1], sd = 10)),+ "PLAT", "Platelet count decreased", NA_character_, |
|
| 94 | +290 | 3x |
- PARAM == param[2] ~ abs(stats::rnorm(nrow(adlb), mean = aval_mean[2], sd = 1)),+ "SODIUM", "Hyponatremia", "Hypernatremia", |
|
| 95 | +291 | 3x |
- PARAM == param[3] ~ abs(stats::rnorm(nrow(adlb), mean = aval_mean[3], sd = 0.1))+ "WBC", "White blood cell decreased", "Leukocytosis", |
|
| 96 | +292 |
- ))+ ) |
||
| 97 | +293 | |||
| 98 | +294 |
- # assign related variable values: PARAMxLBCAT are related+ # merge grade_lookup onto adlb |
||
| 99 | +295 | 3x |
- adlb <- adlb %>% rel_var(+ adlb <- dplyr::left_join(adlb, grade_lookup, by = "PARAMCD")+ |
+ |
| 296 | ++ | + | ||
| 100 | +297 | 3x |
- var_name = "LBCAT",+ adlb <- var_relabel( |
|
| 101 | +298 | 3x |
- related_var = "PARAM",+ adlb, |
|
| 102 | +299 | 3x |
- var_values = lbcat_init_list$relvar2+ STUDYID = "Study Identifier",+ |
+ |
| 300 | +3x | +
+ USUBJID = "Unique Subject Identifier" |
||
| 103 | +301 |
) |
||
| 104 | +302 | |||
| 105 | +303 |
- # assign related variable values: PARAMxPARAMCD are related+ # merge ADSL to be able to add LB date and study day variables |
||
| 106 | +304 | 3x |
- adlb <- adlb %>% rel_var(+ adlb <- dplyr::inner_join( |
|
| 107 | +305 | 3x |
- var_name = "PARAMCD",+ adlb, |
|
| 108 | +306 | 3x |
- related_var = "PARAM",+ adsl, |
|
| 109 | +307 | 3x |
- var_values = param_init_list$relvar2+ by = c("STUDYID", "USUBJID")
|
|
| 110 | +308 |
- )+ ) %>% |
||
| 111 | -+ | |||
| 309 | +3x |
-
+ dplyr::rowwise() %>% |
||
| 112 | +310 | 3x |
- adlb <- adlb %>%+ dplyr::mutate(TRTENDT = lubridate::date(dplyr::case_when( |
|
| 113 | +311 | 3x |
- dplyr::mutate(LBTESTCD = PARAMCD) %>%+ is.na(TRTEDTM) ~ lubridate::floor_date(lubridate::date(TRTSDTM) + study_duration_secs, unit = "day"), |
|
| 114 | +312 | 3x |
- dplyr::mutate(LBTEST = PARAM)+ TRUE ~ TRTEDTM |
|
| 115 | +313 |
-
+ ))) %>% |
||
| 116 | +314 | 3x |
- adlb <- adlb %>% dplyr::mutate(AVISITN = dplyr::case_when(+ dplyr::ungroup() |
|
| 117 | -3x | +|||
| 315 | +
- AVISIT == "SCREENING" ~ -1,+ |
|||
| 118 | +316 | 3x |
- AVISIT == "BASELINE" ~ 0,+ adlb <- adlb %>% |
|
| 119 | +317 | 3x |
- (grepl("^WEEK", AVISIT) | grepl("^CYCLE", AVISIT)) ~ as.numeric(AVISIT) - 2,
+ dplyr::group_by(USUBJID) %>% |
|
| 120 | +318 | 3x |
- TRUE ~ NA_real_- |
- |
| 121 | -- |
- ))- |
- ||
| 122 | -- |
-
+ dplyr::arrange(USUBJID, AVISITN) %>% |
||
| 123 | +319 | 3x |
- adlb <- adlb %>% rel_var(+ dplyr::mutate(ADTM = rep( |
|
| 124 | +320 | 3x |
- var_name = "AVALU",+ sort(sample( |
|
| 125 | +321 | 3x |
- related_var = "PARAM",+ seq(lubridate::as_datetime(TRTSDTM[1]), lubridate::as_datetime(TRTENDT[1]), by = "day"), |
|
| 126 | +322 | 3x |
- var_values = unit_init_list$relvar2- |
- |
| 127 | -- |
- )+ size = nlevels(AVISIT) |
||
| 128 | +323 |
-
+ )), |
||
| 129 | +324 | 3x |
- adlb <- adlb %>%+ each = n() / nlevels(AVISIT) |
|
| 130 | -3x | +|||
| 325 | +
- dplyr::mutate(AVISITN = dplyr::case_when(+ )) %>% |
|||
| 131 | +326 | 3x |
- AVISIT == "SCREENING" ~ -1,+ dplyr::ungroup() %>% |
|
| 132 | +327 | 3x |
- AVISIT == "BASELINE" ~ 0,+ dplyr::mutate(ADY = ceiling(difftime(ADTM, TRTSDTM, units = "days"))) %>% |
|
| 133 | +328 | 3x |
- (grepl("^WEEK", AVISIT) | grepl("^CYCLE", AVISIT)) ~ as.numeric(AVISIT) - 2,
+ dplyr::select(-TRTENDT) %>% |
|
| 134 | +329 | 3x |
- TRUE ~ NA_real_- |
- |
| 135 | -- |
- ))+ dplyr::arrange(STUDYID, USUBJID, ADTM) |
||
| 136 | +330 | |||
| 137 | -- |
- # order to prepare for change from screening and baseline values- |
- ||
| 138 | +331 | 3x |
- adlb <- adlb[order(adlb$STUDYID, adlb$USUBJID, adlb$PARAMCD, adlb$AVISITN), ]- |
- |
| 139 | -- |
-
+ adlb <- adlb %>% |
||
| 140 | +332 | 3x |
- adlb <- Reduce(rbind, lapply(split(adlb, adlb$USUBJID), function(x) {
+ dplyr::mutate(ASPID = sample(seq_len(dplyr::n()))) %>% |
|
| 141 | -30x | +333 | +3x |
- x$STUDYID <- adsl$STUDYID[which(adsl$USUBJID == x$USUBJID[1])]+ dplyr::group_by(USUBJID) %>% |
| 142 | -30x | +334 | +3x |
- x$ABLFL2 <- ifelse(x$AVISIT == "SCREENING", "Y", "")+ dplyr::mutate(LBSEQ = seq_len(dplyr::n())) %>% |
| 143 | -30x | +335 | +3x |
- x$ABLFL <- ifelse(toupper(visit_format) == "WEEK" & x$AVISIT == "BASELINE",+ dplyr::mutate(ASEQ = LBSEQ) %>% |
| 144 | -30x | +336 | +3x |
- "Y",+ dplyr::ungroup() %>% |
| 145 | -30x | -
- ifelse(toupper(visit_format) == "CYCLE" & x$AVISIT == "CYCLE 1 DAY 1", "Y", "")- |
- ||
| 146 | -+ | 337 | +3x |
- )+ dplyr::arrange( |
| 147 | -30x | -
- x- |
- ||
| 148 | -+ | 338 | +3x |
- }))+ STUDYID, |
| 149 | -+ | |||
| 339 | +3x |
-
+ USUBJID, |
||
| 150 | +340 | 3x |
- adlb$BASE2 <- retain(adlb, adlb$AVAL, adlb$ABLFL2 == "Y")+ PARAMCD, |
|
| 151 | +341 | 3x |
- adlb$BASE <- ifelse(adlb$ABLFL2 != "Y", retain(adlb, adlb$AVAL, adlb$ABLFL == "Y"), NA)+ BASETYPE, |
|
| 152 | -+ | |||
| 342 | +3x |
-
+ AVISITN, |
||
| 153 | +343 | 3x |
- adlb <- adlb %>%+ ATPTN, |
|
| 154 | +344 | 3x |
- dplyr::mutate(CHG2 = AVAL - BASE2) %>%+ DTYPE, |
|
| 155 | +345 | 3x |
- dplyr::mutate(PCHG2 = 100 * (CHG2 / BASE2)) %>%+ ADTM, |
|
| 156 | +346 | 3x |
- dplyr::mutate(CHG = AVAL - BASE) %>%+ LBSEQ, |
|
| 157 | +347 | 3x |
- dplyr::mutate(PCHG = 100 * (CHG / BASE)) %>%+ ASPID |
|
| 158 | -3x | +|||
| 348 | +
- dplyr::mutate(BASETYPE = "LAST") %>%+ ) |
|||
| 159 | -3x | +|||
| 349 | +
- dplyr::mutate(ANRLO = dplyr::case_when(+ |
|||
| 160 | +350 | 3x |
- PARAMCD == "ALT" ~ 7,+ adlb <- adlb %>% dplyr::mutate(ONTRTFL = factor(dplyr::case_when( |
|
| 161 | +351 | 3x |
- PARAMCD == "CRP" ~ 8,+ !AVISIT %in% c("SCREENING", "BASELINE") ~ "Y",
|
|
| 162 | +352 | 3x |
- PARAMCD == "IGA" ~ 0.8+ TRUE ~ "" |
|
| 163 | +353 |
- )) %>%+ ))) |
||
| 164 | -3x | +|||
| 354 | +
- dplyr::mutate(ANRHI = dplyr::case_when(+ |
|||
| 165 | +355 | 3x |
- PARAMCD == "ALT" ~ 55,+ flag_variables <- function(data, |
|
| 166 | +356 | 3x |
- PARAMCD == "CRP" ~ 10,+ apply_grouping, |
|
| 167 | +357 | 3x |
- PARAMCD == "IGA" ~ 3+ apply_filter, |
|
| 168 | -+ | |||
| 358 | +3x |
- )) %>%+ apply_mutate) {
|
||
| 169 | -3x | +359 | +15x |
- dplyr::mutate(ANRIND = factor(dplyr::case_when(+ data_compare <- data %>% |
| 170 | -3x | +360 | +15x |
- AVAL < ANRLO ~ "LOW",+ dplyr::mutate(row_check = seq_len(nrow(data))) |
| 171 | -3x | +|||
| 361 | +
- AVAL > ANRHI ~ "HIGH",+ |
|||
| 172 | -3x | +362 | +15x |
- TRUE ~ "NORMAL"+ data <- data_compare %>% |
| 173 | +363 |
- ))) %>%+ {
|
||
| 174 | -3x | +364 | +15x |
- dplyr::mutate(LBSTRESC = factor(dplyr::case_when(+ if (apply_grouping == TRUE) {
|
| 175 | -3x | +365 | +9x |
- PARAMCD == "ALT" ~ "<7",+ dplyr::group_by(., USUBJID, PARAMCD, BASETYPE, AVISIT) |
| 176 | -3x | +|||
| 366 | +
- PARAMCD == "CRP" ~ "<8",+ } else {
|
|||
| 177 | -3x | +367 | +6x |
- PARAMCD == "IGA" ~ ">3"+ dplyr::group_by(., USUBJID, PARAMCD, BASETYPE) |
| 178 | +368 |
- ))) %>%- |
- ||
| 179 | -3x | -
- dplyr::rowwise() %>%+ } |
||
| 180 | -3x | +|||
| 369 | +
- dplyr::mutate(LOQFL = factor(+ } %>% |
|||
| 181 | -3x | +370 | +15x |
- ifelse(eval(parse(text = paste(AVAL, LBSTRESC))), "Y", "N")+ dplyr::arrange(ADTM, ASPID, LBSEQ) %>% |
| 182 | +371 |
- )) %>%- |
- ||
| 183 | -3x | -
- dplyr::ungroup() %>%+ {
|
||
| 184 | -3x | +372 | +15x |
- dplyr::group_by(USUBJID, PARAMCD, BASETYPE) %>%+ if (apply_filter == TRUE) {
|
| 185 | -3x | +373 | +6x |
- dplyr::mutate(BNRIND = ANRIND[ABLFL == "Y"]) %>%+ dplyr::filter( |
| 186 | -3x | +|||
| 374 | +
- dplyr::ungroup() %>%+ ., |
|||
| 187 | -3x | +375 | +6x |
- dplyr::mutate(SHIFT1 = factor(ifelse(+ (AVISIT != "BASELINE" & AVISIT != "SCREENING") & |
| 188 | -3x | +376 | +6x |
- AVISITN > 0,+ (ONTRTFL == "Y" | ADTM <= TRTSDTM) |
| 189 | -3x | +|||
| 377 | +
- paste(+ ) %>% |
|||
| 190 | -3x | +378 | +6x |
- retain(+ dplyr::filter(ATOXGR == max(as.numeric(as.character(ATOXGR)))) |
| 191 | -3x | +379 | +9x |
- adlb, as.character(BNRIND),+ } else if (apply_filter == FALSE) {
|
| 192 | -3x | +380 | +6x |
- AVISITN == 0+ dplyr::filter( |
| 193 | +381 |
- ),+ ., |
||
| 194 | -3x | +382 | +6x |
- ANRIND,+ (AVISIT != "BASELINE" & AVISIT != "SCREENING") & |
| 195 | -3x | +383 | +6x |
- sep = " to "+ (ONTRTFL == "Y" | ADTM <= TRTSDTM) |
| 196 | +384 |
- ),+ ) %>% |
||
| 197 | -+ | |||
| 385 | +6x |
- ""+ dplyr::filter(ATOXGR == min(as.numeric(as.character(ATOXGR)))) |
||
| 198 | +386 |
- ))) %>%+ } else {
|
||
| 199 | +387 | 3x |
- dplyr::mutate(ATOXGR = factor(dplyr::case_when(+ dplyr::filter( |
|
| 200 | -3x | +|||
| 388 | +
- ANRIND == "LOW" ~ sample(+ ., |
|||
| 201 | +389 | 3x |
- c("-1", "-2", "-3", "-4", "-5"),
+ AVAL == min(AVAL) & |
|
| 202 | +390 | 3x |
- nrow(adlb),+ (AVISIT != "BASELINE" & AVISIT != "SCREENING") & |
|
| 203 | +391 | 3x |
- replace = TRUE,+ (ONTRTFL == "Y" | ADTM <= TRTSDTM) |
|
| 204 | -3x | +|||
| 392 | +
- prob = c(0.30, 0.25, 0.20, 0.15, 0)+ ) |
|||
| 205 | +393 |
- ),+ } |
||
| 206 | -3x | +|||
| 394 | +
- ANRIND == "HIGH" ~ sample(+ } %>% |
|||
| 207 | -3x | +395 | +15x |
- c("1", "2", "3", "4", "5"),
+ dplyr::slice(1) %>% |
| 208 | -3x | +|||
| 396 | +
- nrow(adlb),+ {
|
|||
| 209 | -3x | +397 | +15x |
- replace = TRUE,+ if (apply_mutate == TRUE) {
|
| 210 | -3x | +398 | +12x |
- prob = c(0.30, 0.25, 0.20, 0.15, 0)+ dplyr::mutate(., new_var = ifelse(is.na(DTYPE), "Y", "")) |
| 211 | +399 |
- ),+ } else {
|
||
| 212 | +400 | 3x |
- ANRIND == "NORMAL" ~ "0"+ dplyr::mutate(., new_var = ifelse(is.na(AVAL) == FALSE & is.na(DTYPE), "Y", "")) |
|
| 213 | +401 |
- ))) %>%+ } |
||
| 214 | -3x | +|||
| 402 | +
- dplyr::group_by(USUBJID, PARAMCD, BASETYPE) %>%+ } %>% |
|||
| 215 | -3x | +403 | +15x |
- dplyr::mutate(BTOXGR = ATOXGR[ABLFL == "Y"]) %>%+ dplyr::ungroup() |
| 216 | -3x | +|||
| 404 | +
- dplyr::ungroup() %>%+ |
|||
| 217 | -3x | +405 | +15x |
- dplyr::mutate(ATPTN = 1) %>%+ data_compare$new_var <- ifelse(data_compare$row_check %in% data$row_check, "Y", "") |
| 218 | -3x | +|||
| 406 | +
- dplyr::mutate(DTYPE = NA) %>%+ |
|||
| 219 | -3x | +407 | +15x |
- dplyr::mutate(BTOXGRL = factor(dplyr::case_when(+ data_compare <- data_compare[, -which(names(data_compare) %in% c("row_check"))]
|
| 220 | -3x | +|||
| 408 | +
- BTOXGR == "0" ~ "0",+ |
|||
| 221 | -3x | +409 | +15x |
- BTOXGR == "-1" ~ "1",+ return(data_compare) |
| 222 | -3x | +|||
| 410 | +
- BTOXGR == "-2" ~ "2",+ } |
|||
| 223 | -3x | +|||
| 411 | +
- BTOXGR == "-3" ~ "3",+ |
|||
| 224 | +412 | 3x |
- BTOXGR == "-4" ~ "4",+ adlb <- flag_variables(adlb, TRUE, "ELSE", FALSE) %>% dplyr::rename(WORS01FL = "new_var") |
|
| 225 | +413 | 3x |
- BTOXGR == "1" ~ "<Missing>",+ adlb <- flag_variables(adlb, FALSE, TRUE, TRUE) %>% dplyr::rename(WGRHIFL = "new_var") |
|
| 226 | +414 | 3x |
- BTOXGR == "2" ~ "<Missing>",+ adlb <- flag_variables(adlb, FALSE, FALSE, TRUE) %>% dplyr::rename(WGRLOFL = "new_var") |
|
| 227 | +415 | 3x |
- BTOXGR == "3" ~ "<Missing>",+ adlb <- flag_variables(adlb, TRUE, TRUE, TRUE) %>% dplyr::rename(WGRHIVFL = "new_var") |
|
| 228 | +416 | 3x |
- BTOXGR == "4" ~ "<Missing>"+ adlb <- flag_variables(adlb, TRUE, FALSE, TRUE) %>% dplyr::rename(WGRLOVFL = "new_var") |
|
| 229 | +417 |
- ))) %>%+ |
||
| 230 | +418 | 3x |
- dplyr::mutate(BTOXGRH = factor(dplyr::case_when(+ adlb <- adlb %>% dplyr::mutate(ANL01FL = ifelse( |
|
| 231 | +419 | 3x |
- BTOXGR == "0" ~ "0",+ (ABLFL == "Y" | (WORS01FL == "Y" & is.na(DTYPE))) & |
|
| 232 | +420 | 3x |
- BTOXGR == "1" ~ "1",+ (AVISIT != "SCREENING"), |
|
| 233 | +421 | 3x |
- BTOXGR == "2" ~ "2",+ "Y", |
|
| 234 | -3x | +|||
| 422 | +
- BTOXGR == "3" ~ "3",+ "" |
|||
| 235 | -3x | +|||
| 423 | +
- BTOXGR == "4" ~ "4",+ )) |
|||
| 236 | -3x | +|||
| 424 | +
- BTOXGR == "-1" ~ "<Missing>",+ |
|||
| 237 | +425 | 3x |
- BTOXGR == "-2" ~ "<Missing>",+ if (length(na_vars) > 0 && na_percentage > 0) {
|
|
| 238 | -3x | +|||
| 426 | +! |
- BTOXGR == "-3" ~ "<Missing>",+ adlb <- mutate_na(ds = adlb, na_vars = na_vars, na_percentage = na_percentage) |
||
| 239 | -3x | +|||
| 427 | +
- BTOXGR == "-4" ~ "<Missing>",+ } |
|||
| 240 | +428 |
- ))) %>%+ |
||
| 241 | -3x | +|||
| 429 | +
- dplyr::mutate(ATOXGRL = factor(dplyr::case_when(+ # apply metadata |
|||
| 242 | -3x | +|||
| 430 | +
- ATOXGR == "0" ~ "0",+ |
|||
| 243 | +431 | 3x |
- ATOXGR == "-1" ~ "1",+ adlb <- apply_metadata(adlb, "metadata/ADLB.yml") |
|
| 244 | -3x | +|||
| 432 | +
- ATOXGR == "-2" ~ "2",+ |
|||
| 245 | +433 | 3x |
- ATOXGR == "-3" ~ "3",+ return(adlb) |
|
| 246 | -3x | +|||
| 434 | +
- ATOXGR == "-4" ~ "4",+ } |
|||
| 247 | -3x | +
| 1 | +
- ATOXGR == "1" ~ "<Missing>",+ #' EORTC QLQ-C30 V3 Analysis Dataset (ADQLQC) |
|||
| 248 | -3x | +|||
| 2 | +
- ATOXGR == "2" ~ "<Missing>",+ #' |
|||
| 249 | -3x | +|||
| 3 | +
- ATOXGR == "3" ~ "<Missing>",+ #' @description `r lifecycle::badge("stable")`
|
|||
| 250 | -3x | +|||
| 4 | +
- ATOXGR == "4" ~ "<Missing>",+ #' |
|||
| 251 | +5 |
- ))) %>%+ #' Function for generating a random EORTC QLQ-C30 V3 Analysis Dataset for a given |
||
| 252 | -3x | +|||
| 6 | +
- dplyr::mutate(ATOXGRH = factor(dplyr::case_when(+ #' Subject-Level Analysis Dataset. |
|||
| 253 | -3x | +|||
| 7 | +
- ATOXGR == "0" ~ "0",+ #' |
|||
| 254 | -3x | +|||
| 8 | +
- ATOXGR == "1" ~ "1",+ #' @details |
|||
| 255 | -3x | +|||
| 9 | +
- ATOXGR == "2" ~ "2",+ #' |
|||
| 256 | -3x | +|||
| 10 | +
- ATOXGR == "3" ~ "3",+ #' Keys: `STUDYID`, `USUBJID`, `PARCAT1N`, `PARAMCD`, `BASETYPE`, `AVISITN`, `ATPTN`, `ADTM`, `QSSEQ` |
|||
| 257 | -3x | +|||
| 11 | +
- ATOXGR == "4" ~ "4",+ #' |
|||
| 258 | -3x | +|||
| 12 | +
- ATOXGR == "-1" ~ "<Missing>",+ #' @inheritParams argument_convention |
|||
| 259 | -3x | +|||
| 13 | +
- ATOXGR == "-2" ~ "<Missing>",+ #' @param percent (`numeric`)\cr Completion - Completed at least y percent of questions, 1 record per visit |
|||
| 260 | -3x | +|||
| 14 | +
- ATOXGR == "-3" ~ "<Missing>",+ #' @param number (`numeric`)\cr Completion - Completed at least x question(s), 1 record per visit |
|||
| 261 | -3x | +|||
| 15 | +
- ATOXGR == "-4" ~ "<Missing>",+ #' @template param_cached |
|||
| 262 | +16 |
- ))) %>%+ #' @templateVar data adqlqc |
||
| 263 | -3x | +|||
| 17 | +
- var_relabel(+ #' |
|||
| 264 | -3x | +|||
| 18 | +
- STUDYID = attr(adsl$STUDYID, "label"),+ #' @return `data.frame` |
|||
| 265 | -3x | +|||
| 19 | +
- USUBJID = attr(adsl$USUBJID, "label")+ #' @export |
|||
| 266 | +20 |
- )+ #' |
||
| 267 | +21 |
-
+ #' @examples |
||
| 268 | +22 |
- # High and low descriptions of the different PARAMCD values+ #' adsl <- radsl(N = 10, study_duration = 2, seed = 1) |
||
| 269 | +23 |
- # This is currently hard coded as the GDSR does not have these descriptions yet+ #' |
||
| 270 | -3x | +|||
| 24 | +
- grade_lookup <- tibble::tribble(+ #' adqlqc <- radqlqc(adsl, seed = 1, percent = 80, number = 2) |
|||
| 271 | -3x | +|||
| 25 | +
- ~PARAMCD, ~ATOXDSCL, ~ATOXDSCH,+ #' adqlqc |
|||
| 272 | -3x | +|||
| 26 | +
- "ALB", "Hypoalbuminemia", NA_character_,+ radqlqc <- function(adsl, |
|||
| 273 | -3x | +|||
| 27 | +
- "ALKPH", NA_character_, "Alkaline phosphatase increased",+ percent, |
|||
| 274 | -3x | +|||
| 28 | +
- "ALT", NA_character_, "Alanine aminotransferase increased",+ number, |
|||
| 275 | -3x | +|||
| 29 | +
- "AST", NA_character_, "Aspartate aminotransferase increased",+ seed = NULL, |
|||
| 276 | -3x | +|||
| 30 | +
- "BILI", NA_character_, "Blood bilirubin increased",+ cached = FALSE) {
|
|||
| 277 | -3x | +31 | +4x |
- "CA", "Hypocalcemia", "Hypercalcemia",+ checkmate::assert_flag(cached) |
| 278 | -3x | +32 | +4x |
- "CHOLES", NA_character_, "Cholesterol high",+ if (cached) {
|
| 279 | -3x | +33 | +1x |
- "CK", NA_character_, "CPK increased",+ return(get_cached_data("cadqlqc"))
|
| 280 | -3x | +|||
| 34 | +
- "CREAT", NA_character_, "Creatinine increased",+ } |
|||
| 281 | -3x | +|||
| 35 | +
- "CRP", NA_character_, "C reactive protein increased",+ |
|||
| 282 | +36 | 3x |
- "GGT", NA_character_, "GGT increased",+ checkmate::assert_data_frame(adsl) |
|
| 283 | +37 | 3x |
- "GLUC", "Hypoglycemia", "Hyperglycemia",+ checkmate::assert_number(percent, lower = 1, upper = 100) |
|
| 284 | +38 | 3x |
- "HGB", "Anemia", "Hemoglobin increased",+ checkmate::assert_number(number, lower = 1) |
|
| 285 | -3x | +|||
| 39 | +
- "IGA", NA_character_, "Immunoglobulin A increased",+ |
|||
| 286 | +40 | 3x |
- "POTAS", "Hypokalemia", "Hyperkalemia",+ if (!is.null(seed)) {
|
|
| 287 | +41 | 3x |
- "LYMPH", "CD4 lymphocytes decreased", NA_character_,+ set.seed(seed) |
|
| 288 | -3x | +|||
| 42 | +
- "PHOS", "Hypophosphatemia", NA_character_,+ } |
|||
| 289 | -3x | +|||
| 43 | +
- "PLAT", "Platelet count decreased", NA_character_,+ |
|||
| 290 | -3x | +|||
| 44 | +
- "SODIUM", "Hyponatremia", "Hypernatremia",+ # ADQLQC data ------------------------------------------------------------- |
|||
| 291 | +45 | 3x |
- "WBC", "White blood cell decreased", "Leukocytosis",+ qs <- get_qs_data(adsl, n_assessments = 5L, seed = seed, na_percentage = 0.1) |
|
| 292 | +46 |
- )+ # prepare ADaM ADQLQC data |
||
| 293 | -+ | |||
| 47 | +3x |
-
+ adqlqc1 <- prep_adqlqc(df = qs) |
||
| 294 | +48 |
- # merge grade_lookup onto adlb+ # derive AVAL and AVALC |
||
| 295 | +49 | 3x |
- adlb <- dplyr::left_join(adlb, grade_lookup, by = "PARAMCD")+ adqlqc1 <- mutate( |
|
| 296 | -+ | |||
| 50 | +3x |
-
+ adqlqc1, |
||
| 297 | +51 | 3x |
- adlb <- var_relabel(+ AVAL = as.numeric(QSSTRESC), |
|
| 298 | +52 | 3x |
- adlb,+ AVALC = case_when( |
|
| 299 | +53 | 3x |
- STUDYID = "Study Identifier",+ QSTESTCD == "QSALL" ~ QSREASND, |
|
| 300 | +54 | 3x |
- USUBJID = "Unique Subject Identifier"+ TRUE ~ QSORRES |
|
| 301 | +55 |
- )+ ), |
||
| 302 | -+ | |||
| 56 | +3x |
-
+ AVISIT = VISIT, |
||
| 303 | -+ | |||
| 57 | +3x |
- # merge ADSL to be able to add LB date and study day variables+ AVISITN = VISITNUM, |
||
| 304 | +58 | 3x |
- adlb <- dplyr::inner_join(+ ADTM = QSDTC |
|
| 305 | -3x | +|||
| 59 | +
- adlb,+ )+ |
+ |||
| 60 | ++ |
+ # include scale calculation |
||
| 306 | +61 | 3x |
- adsl,+ adqlqc_tmp <- calc_scales(adqlqc1)+ |
+ |
| 62 | ++ |
+ # order to prepare for change from screening and baseline values |
||
| 307 | +63 | 3x |
- by = c("STUDYID", "USUBJID")
+ adqlqc_tmp <- adqlqc_tmp[order(adqlqc_tmp$STUDYID, adqlqc_tmp$USUBJID, adqlqc_tmp$PARAMCD, adqlqc_tmp$AVISITN), ] |
|
| 308 | +64 |
- ) %>%+ |
||
| 309 | +65 | 3x |
- dplyr::rowwise() %>%+ adqlqc_tmp <- Reduce( |
|
| 310 | +66 | 3x |
- dplyr::mutate(TRTENDT = lubridate::date(dplyr::case_when(+ rbind, |
|
| 311 | +67 | 3x |
- is.na(TRTEDTM) ~ lubridate::floor_date(lubridate::date(TRTSDTM) + study_duration_secs, unit = "day"),+ lapply( |
|
| 312 | +68 | 3x |
- TRUE ~ TRTEDTM+ split(adqlqc_tmp, adqlqc_tmp$USUBJID), |
|
| 313 | -+ | |||
| 69 | +3x |
- ))) %>%+ function(x) {
|
||
| 314 | -3x | +70 | +30x |
- dplyr::ungroup()+ x$STUDYID <- adsl$STUDYID[which(adsl$USUBJID == x$USUBJID[1])] |
| 315 | -+ | |||
| 71 | +30x |
-
+ x$ABLFL2 <- ifelse(x$AVISIT == "SCREENING", "Y", "") |
||
| 316 | -3x | +72 | +30x |
- adlb <- adlb %>%+ x$ABLFL <- ifelse( |
| 317 | -3x | +73 | +30x |
- dplyr::group_by(USUBJID) %>%+ x$AVISIT == "BASELINE" & |
| 318 | -3x | +74 | +30x |
- dplyr::arrange(USUBJID, AVISITN) %>%+ x$PARAMCD != "EX028", |
| 319 | -3x | +75 | +30x |
- dplyr::mutate(ADTM = rep(+ "Y", |
| 320 | -3x | +76 | +30x |
- sort(sample(+ ifelse( |
| 321 | -3x | +77 | +30x |
- seq(lubridate::as_datetime(TRTSDTM[1]), lubridate::as_datetime(TRTENDT[1]), by = "day"),+ x$AVISIT == "CYCLE 1 DAY 1" & |
| 322 | -3x | +78 | +30x |
- size = nlevels(AVISIT)+ x$PARAMCD != "EX028",+ |
+
| 79 | +30x | +
+ "Y", |
||
| 323 | +80 |
- )),+ "" |
||
| 324 | -3x | +|||
| 81 | +
- each = n() / nlevels(AVISIT)+ ) |
|||
| 325 | +82 |
- )) %>%+ ) |
||
| 326 | -3x | +83 | +30x |
- dplyr::ungroup() %>%+ x |
| 327 | -3x | +|||
| 84 | +
- dplyr::mutate(ADY = ceiling(difftime(ADTM, TRTSDTM, units = "days"))) %>%+ } |
|||
| 328 | -3x | +|||
| 85 | +
- dplyr::select(-TRTENDT) %>%+ ) |
|||
| 329 | -3x | +|||
| 86 | +
- dplyr::arrange(STUDYID, USUBJID, ADTM)+ ) |
|||
| 330 | +87 | |||
| 331 | +88 | 3x |
- adlb <- adlb %>%+ adqlqc_tmp$BASE2 <- ifelse( |
|
| 332 | +89 | 3x |
- dplyr::mutate(ASPID = sample(seq_len(dplyr::n()))) %>%+ str_detect(adqlqc_tmp$PARCAT2, "Completion", negate = TRUE), |
|
| 333 | +90 | 3x |
- dplyr::group_by(USUBJID) %>%+ retain( |
|
| 334 | +91 | 3x |
- dplyr::mutate(LBSEQ = seq_len(dplyr::n())) %>%+ df = adqlqc_tmp, |
|
| 335 | +92 | 3x |
- dplyr::mutate(ASEQ = LBSEQ) %>%+ value_var = adqlqc_tmp$AVAL, |
|
| 336 | +93 | 3x |
- dplyr::ungroup() %>%+ event = adqlqc_tmp$ABLFL2 == "Y" |
|
| 337 | -3x | +|||
| 94 | +
- dplyr::arrange(+ ), |
|||
| 338 | +95 | 3x |
- STUDYID,+ NA |
|
| 339 | -3x | +|||
| 96 | +
- USUBJID,+ )+ |
+ |||
| 97 | ++ | + | ||
| 340 | +98 | 3x |
- PARAMCD,+ adqlqc_tmp$BASE <- ifelse( |
|
| 341 | +99 | 3x |
- BASETYPE,+ adqlqc_tmp$ABLFL2 != "Y" & |
|
| 342 | +100 | 3x |
- AVISITN,+ str_detect(adqlqc_tmp$PARCAT2, "Completion", negate = TRUE), |
|
| 343 | +101 | 3x |
- ATPTN,+ retain( |
|
| 344 | +102 | 3x |
- DTYPE,+ adqlqc_tmp, |
|
| 345 | +103 | 3x |
- ADTM,+ adqlqc_tmp$AVAL, |
|
| 346 | +104 | 3x |
- LBSEQ,+ adqlqc_tmp$ABLFL == "Y"+ |
+ |
| 105 | ++ |
+ ), |
||
| 347 | +106 | 3x |
- ASPID+ NA |
|
| 348 | +107 |
- )+ ) |
||
| 349 | +108 | |||
| 350 | +109 | 3x |
- adlb <- adlb %>% dplyr::mutate(ONTRTFL = factor(dplyr::case_when(+ adqlqc_tmp <- adqlqc_tmp %>% |
|
| 351 | +110 | 3x |
- !AVISIT %in% c("SCREENING", "BASELINE") ~ "Y",
+ dplyr::mutate(CHG2 = AVAL - BASE2) %>% |
|
| 352 | +111 | 3x |
- TRUE ~ ""- |
- |
| 353 | -- |
- )))- |
- ||
| 354 | -- |
-
+ dplyr::mutate(PCHG2 = 100 * (CHG2 / BASE2)) %>% |
||
| 355 | +112 | 3x |
- flag_variables <- function(data,+ dplyr::mutate(CHG = AVAL - BASE) %>% |
|
| 356 | +113 | 3x |
- apply_grouping,+ dplyr::mutate(PCHG = 100 * (CHG / BASE)) %>% |
|
| 357 | +114 | 3x |
- apply_filter,+ var_relabel( |
|
| 358 | +115 | 3x |
- apply_mutate) {
+ STUDYID = attr(adsl$STUDYID, "label"), |
|
| 359 | -15x | +116 | +3x |
- data_compare <- data %>%+ USUBJID = attr(adsl$USUBJID, "label") |
| 360 | -15x | +|||
| 117 | +
- dplyr::mutate(row_check = seq_len(nrow(data)))+ ) |
|||
| 361 | +118 |
-
+ # derive CHGCAT1 ---------------------------------------------------------- |
||
| 362 | -15x | +119 | +3x |
- data <- data_compare %>%+ adqlqc_tmp <- derv_chgcat1(dataset = adqlqc_tmp) |
| 363 | +120 |
- {
+
|
||
| 364 | -15x | +121 | +3x |
- if (apply_grouping == TRUE) {
+ adqlqc_tmp <- var_relabel( |
| 365 | -9x | +122 | +3x |
- dplyr::group_by(., USUBJID, PARAMCD, BASETYPE, AVISIT)+ adqlqc_tmp, |
| 366 | -+ | |||
| 123 | +3x |
- } else {
+ STUDYID = "Study Identifier", |
||
| 367 | -6x | +124 | +3x |
- dplyr::group_by(., USUBJID, PARAMCD, BASETYPE)+ USUBJID = "Unique Subject Identifier" |
| 368 | +125 |
- }+ ) |
||
| 369 | +126 |
- } %>%+ |
||
| 370 | -15x | +127 | +3x |
- dplyr::arrange(ADTM, ASPID, LBSEQ) %>%+ adqlqc_tmp <- arrange( |
| 371 | -+ | |||
| 128 | +3x |
- {
+ adqlqc_tmp, |
||
| 372 | -15x | +129 | +3x |
- if (apply_filter == TRUE) {
+ USUBJID, |
| 373 | -6x | +130 | +3x |
- dplyr::filter(+ AVISITN |
| 374 | +131 |
- .,- |
- ||
| 375 | -6x | -
- (AVISIT != "BASELINE" & AVISIT != "SCREENING") &+ ) |
||
| 376 | -6x | +|||
| 132 | +
- (ONTRTFL == "Y" | ADTM <= TRTSDTM)+ # Merge ADSL -------------------------------------------------------------- |
|||
| 377 | +133 |
- ) %>%+ # ADSL variables needed for ADQLQC |
||
| 378 | -6x | +134 | +3x |
- dplyr::filter(ATOXGR == max(as.numeric(as.character(ATOXGR))))+ adsl_vars <- c( |
| 379 | -9x | +135 | +3x |
- } else if (apply_filter == FALSE) {
+ "STUDYID", "USUBJID", "SUBJID", "SITEID", "REGION1", "COUNTRY", "ETHNIC", "AGE", |
| 380 | -6x | +136 | +3x |
- dplyr::filter(- |
-
| 381 | -- |
- .,+ "AGEU", "AAGE", "AAGEU", "AGEGR1", "AGEGR2", "AGEGR3", "STRATwNM", "STRATw", "STRATwV", |
||
| 382 | -6x | +137 | +3x |
- (AVISIT != "BASELINE" & AVISIT != "SCREENING") &+ "SEX", "RACE", "ITTFL", "SAFFL", "PPROTFL", "TRT01P", "TRT01A", |
| 383 | -6x | +138 | +3x |
- (ONTRTFL == "Y" | ADTM <= TRTSDTM)+ "TRTSEQP", "TRTSEQA", "TRTSDTM", "TRTSDT", "TRTEDTM", "TRTEDT", "DCUTDT" |
| 384 | +139 |
- ) %>%+ ) |
||
| 385 | -6x | +140 | +3x |
- dplyr::filter(ATOXGR == min(as.numeric(as.character(ATOXGR))))+ adsl <- select( |
| 386 | -+ | |||
| 141 | +3x |
- } else {
+ adsl, |
||
| 387 | +142 | 3x |
- dplyr::filter(+ any_of(adsl_vars) |
|
| 388 | +143 |
- .,+ ) |
||
| 389 | +144 | 3x |
- AVAL == min(AVAL) &+ adqlqc <- dplyr::inner_join( |
|
| 390 | +145 | 3x |
- (AVISIT != "BASELINE" & AVISIT != "SCREENING") &+ adqlqc_tmp, |
|
| 391 | +146 | 3x |
- (ONTRTFL == "Y" | ADTM <= TRTSDTM)- |
- |
| 392 | -- |
- )+ adsl, |
||
| 393 | -+ | |||
| 147 | +3x |
- }+ by = c("STUDYID", "USUBJID")
|
||
| 394 | +148 |
- } %>%+ ) %>% |
||
| 395 | -15x | -
- dplyr::slice(1) %>%- |
- ||
| 396 | -+ | 149 | +3x |
- {
+ dplyr::mutate( |
| 397 | -15x | +150 | +3x |
- if (apply_mutate == TRUE) {
+ ADY_der = ceiling(difftime(ADTM, TRTSDTM, units = "days")), |
| 398 | -12x | +151 | +3x |
- dplyr::mutate(., new_var = ifelse(is.na(DTYPE), "Y", ""))+ ADY = case_when( |
| 399 | -+ | |||
| 152 | +3x |
- } else {
+ ADY_der >= 0 ~ ADY_der + 1, |
||
| 400 | +153 | 3x |
- dplyr::mutate(., new_var = ifelse(is.na(AVAL) == FALSE & is.na(DTYPE), "Y", ""))+ TRUE ~ ADY_der |
|
| 401 | +154 |
- }+ ) |
||
| 402 | +155 |
- } %>%+ ) %>% |
||
| 403 | -15x | +156 | +3x |
- dplyr::ungroup()+ select(-ADY_der) |
| 404 | +157 | |||
| 405 | -15x | -
- data_compare$new_var <- ifelse(data_compare$row_check %in% data$row_check, "Y", "")- |
- ||
| 406 | +158 |
-
+ # get compliance data --------------------------------------------------- |
||
| 407 | -15x | +159 | +3x |
- data_compare <- data_compare[, -which(names(data_compare) %in% c("row_check"))]
+ compliance_data <- comp_derv( |
| 408 | -+ | |||
| 160 | +3x |
-
+ dataset = adqlqc, |
||
| 409 | -15x | +161 | +3x |
- return(data_compare)+ percent = percent, |
| 410 | -+ | |||
| 162 | +3x |
- }+ number = number |
||
| 411 | +163 |
-
+ ) |
||
| 412 | -3x | +|||
| 164 | +
- adlb <- flag_variables(adlb, TRUE, "ELSE", FALSE) %>% dplyr::rename(WORS01FL = "new_var")+ # add ADSL variables |
|||
| 413 | +165 | 3x |
- adlb <- flag_variables(adlb, FALSE, TRUE, TRUE) %>% dplyr::rename(WGRHIFL = "new_var")+ compliance_data <- left_join( |
|
| 414 | +166 | 3x |
- adlb <- flag_variables(adlb, FALSE, FALSE, TRUE) %>% dplyr::rename(WGRLOFL = "new_var")+ compliance_data, |
|
| 415 | +167 | 3x |
- adlb <- flag_variables(adlb, TRUE, TRUE, TRUE) %>% dplyr::rename(WGRHIVFL = "new_var")+ adsl, |
|
| 416 | +168 | 3x |
- adlb <- flag_variables(adlb, TRUE, FALSE, TRUE) %>% dplyr::rename(WGRLOVFL = "new_var")+ by = c("STUDYID", "USUBJID")
|
|
| 417 | +169 |
-
+ ) |
||
| 418 | -3x | +|||
| 170 | +
- adlb <- adlb %>% dplyr::mutate(ANL01FL = ifelse(+ # add completion to ADQLQC |
|||
| 419 | +171 | 3x |
- (ABLFL == "Y" | (WORS01FL == "Y" & is.na(DTYPE))) &+ adqlqc <- bind_rows( |
|
| 420 | +172 | 3x |
- (AVISIT != "SCREENING"),+ adqlqc, |
|
| 421 | +173 | 3x |
- "Y",- |
- |
| 422 | -- |
- ""+ compliance_data |
||
| 423 | +174 |
- ))+ ) %>% |
||
| 424 | -+ | |||
| 175 | +3x |
-
+ arrange( |
||
| 425 | +176 | 3x |
- if (length(na_vars) > 0 && na_percentage > 0) {
+ USUBJID, |
|
| 426 | -! | +|||
| 177 | +3x |
- adlb <- mutate_na(ds = adlb, na_vars = na_vars, na_percentage = na_percentage)+ AVISITN, |
||
| 427 | -+ | |||
| 178 | +3x |
- }+ QSTESTCD |
||
| 428 | +179 |
-
+ ) |
||
| 429 | +180 |
- # apply metadata+ # find first set of questionnaire observations |
||
| 430 | -+ | |||
| 181 | +3x |
-
+ adqlqc_x <- arrange( |
||
| 431 | +182 | 3x |
- adlb <- apply_metadata(adlb, "metadata/ADLB.yml")+ adqlqc, |
|
| 432 | -+ | |||
| 183 | +3x |
-
+ USUBJID, |
||
| 433 | +184 | 3x |
- return(adlb)+ ADTM |
|
| 434 | +185 |
- }+ ) %>% |
| 1 | -+ | |||
| 186 | +3x |
- #' Vital Signs Analysis Dataset (ADVS)+ filter( |
||
| 2 | -+ | |||
| 187 | +3x |
- #'+ PARAMCD != "QSALL" & |
||
| 3 | -+ | |||
| 188 | +3x |
- #' @description `r lifecycle::badge("stable")`
+ !str_detect(AVISIT, "SCREENING|UNSCHEDULED") |
||
| 4 | +189 |
- #'+ ) %>% |
||
| 5 | -+ | |||
| 190 | +3x |
- #' Function for generating a random Vital Signs Analysis Dataset for a given+ group_by( |
||
| 6 | -+ | |||
| 191 | +3x |
- #' Subject-Level Analysis Dataset.+ USUBJID, |
||
| 7 | -+ | |||
| 192 | +3x |
- #'+ ADTM |
||
| 8 | +193 |
- #' @details One record per subject per parameter per analysis visit per analysis date.+ ) %>% |
||
| 9 | -+ | |||
| 194 | +3x |
- #'+ summarise(first_date = first(ADTM), .groups = "drop") |
||
| 10 | +195 |
- #' Keys: `STUDYID`, `USUBJID`, `PARAMCD`, `BASETYPE`, `AVISITN`, `ATPTN`, `DTYPE`, `ADTM`, `VSSEQ`, `ASPID`+ |
||
| 11 | -+ | |||
| 196 | +3x |
- #'+ adqlqc <- left_join( |
||
| 12 | -+ | |||
| 197 | +3x |
- #' @inheritParams argument_convention+ adqlqc, |
||
| 13 | -+ | |||
| 198 | +3x |
- #' @template param_cached+ adqlqc_x, |
||
| 14 | -+ | |||
| 199 | +3x |
- #' @templateVar data advs+ by = c("USUBJID", "ADTM")
|
||
| 15 | +200 |
- #'+ ) %>% |
||
| 16 | -+ | |||
| 201 | +3x |
- #' @return `data.frame`+ mutate( |
||
| 17 | -+ | |||
| 202 | +3x |
- #' @export+ ANL01FL = case_when( |
||
| 18 | -+ | |||
| 203 | +3x |
- #'+ PARAMCD != "QSALL" & ABLFL == "Y" ~ "Y", |
||
| 19 | -+ | |||
| 204 | +3x |
- #' @author npaszty+ PARAMCD != "QSALL" & |
||
| 20 | -+ | |||
| 205 | +3x |
- #'+ !str_detect(AVISIT, "UNSCHEDULED") & |
||
| 21 | -+ | |||
| 206 | +3x |
- #' @examples+ !is.na(first_date) ~ "Y" |
||
| 22 | +207 |
- #' adsl <- radsl(N = 10, seed = 1, study_duration = 2)+ ) |
||
| 23 | +208 |
- #'+ ) %>% |
||
| 24 | -+ | |||
| 209 | +3x |
- #' advs <- radvs(adsl, visit_format = "WEEK", n_assessments = 7L, seed = 2)+ select(-first_date) |
||
| 25 | +210 |
- #' advs+ |
||
| 26 | +211 |
- #'+ # final dataset ----------------------------------------------------------- |
||
| 27 | -+ | |||
| 212 | +3x |
- #' advs <- radvs(adsl, visit_format = "CYCLE", n_assessments = 3L, seed = 2)+ adqlqc_final <- adqlqc %>% |
||
| 28 | -+ | |||
| 213 | +3x |
- #' advs+ dplyr::group_by(USUBJID) %>% |
||
| 29 | -+ | |||
| 214 | +3x |
- radvs <- function(adsl,+ dplyr::mutate(ASEQ = row_number()) %>% |
||
| 30 | -+ | |||
| 215 | +3x |
- param = c(+ dplyr::ungroup() %>% |
||
| 31 | -+ | |||
| 216 | +3x |
- "Diastolic Blood Pressure",- |
- ||
| 32 | -- |
- "Pulse Rate",+ dplyr::arrange( |
||
| 33 | -+ | |||
| 217 | +3x |
- "Respiratory Rate",+ STUDYID, |
||
| 34 | -+ | |||
| 218 | +3x |
- "Systolic Blood Pressure",+ USUBJID, |
||
| 35 | -+ | |||
| 219 | +3x |
- "Temperature", "Weight"+ AVISITN |
||
| 36 | +220 |
- ),+ ) %>% |
||
| 37 | -+ | |||
| 221 | +3x |
- paramcd = c("DIABP", "PULSE", "RESP", "SYSBP", "TEMP", "WEIGHT"),
+ select( |
||
| 38 | -+ | |||
| 222 | +3x |
- paramu = c("Pa", "beats/min", "breaths/min", "Pa", "C", "Kg"),
+ -c("BASE2", "CHG2", "PCHG2", "ABLFL2")
|
||
| 39 | +223 |
- visit_format = "WEEK",+ ) %>% |
||
| 40 | -+ | |||
| 224 | +3x |
- n_assessments = 5L,+ ungroup() |
||
| 41 | +225 |
- n_days = 5L,+ |
||
| 42 | -+ | |||
| 226 | +3x |
- seed = NULL,+ adam_vars <- c( |
||
| 43 | -+ | |||
| 227 | +3x |
- na_percentage = 0,+ adsl_vars, "QSSEQ", "QSCAT", "QSSCAT", "QSDTC", "QSSPID", "QSSTAT", "QSSTRESN", |
||
| 44 | -+ | |||
| 228 | +3x |
- na_vars = list(+ "QSSTRESC", "QSSTRESU", "QSORRES", "QSORRESU", "QSTEST", "QSTESTCD", "QSTPT", |
||
| 45 | -+ | |||
| 229 | +3x |
- CHG2 = c(1235, 0.1), PCHG2 = c(1235, 0.1), CHG = c(1234, 0.1), PCHG = c(1234, 0.1),+ "QSTPTNUM", "QSTPTREF", "QSDY", "QSREASND", "QSTSTDTL", "QSEVAL", "VISIT", "VISITNUM", |
||
| 46 | -+ | |||
| 230 | +3x |
- AVAL = c(123, 0.1), AVALU = c(123, 0.1)+ "PARAM", "PARAMCD", "PARCAT1", "PARCAT1N", "PARCAT2", "AVAL", "AVALC", "AREASND", |
||
| 47 | -+ | |||
| 231 | +3x |
- ),+ "BASE", "BASETYPE", "ABLFL", "CHG", "PCHG", "CHGCAT1", "CRIT1", "CRIT1FL", "DTYPE", |
||
| 48 | -+ | |||
| 232 | +3x |
- cached = FALSE) {
+ "ADTM", "ADT", "ADY", "ADTF", "ATMF", "ATPT", "ATPTN", "AVISIT", "AVISITN", "APHASE", |
||
| 49 | -4x | +233 | +3x |
- checkmate::assert_flag(cached)+ "APHASEN", "APERIOD", "APERIODC", "APERIODC", "ASPER", "ASPERC", "PERADY", "TRTP", |
| 50 | -4x | +234 | +3x |
- if (cached) {
+ "TRTA", "ONTRTFL", "LAST02FL", "FIRS02FL", "ANL01FL", "ANL02FL", "ANL03FL", |
| 51 | -1x | +235 | +3x |
- return(get_cached_data("cadvs"))
+ "ANL04FL", "CGCAT1NX" |
| 52 | +236 |
- }+ ) |
||
| 53 | +237 |
-
+ # order variables in mapped qs by variables in adam_vars |
||
| 54 | +238 | 3x |
- checkmate::assert_data_frame(adsl)+ adqlqc_name_ordered <- names(adqlqc_final)[order(match(names(adqlqc_final), adam_vars))]+ |
+ |
| 239 | ++ |
+ # adqlqc with variables ordered per gdsr |
||
| 55 | +240 | 3x |
- checkmate::assert_character(param, min.len = 1, any.missing = FALSE)+ adqlqc_final <- adqlqc_final %>% |
|
| 56 | +241 | 3x |
- checkmate::assert_character(paramcd, min.len = 1, any.missing = FALSE)+ select( |
|
| 57 | +242 | 3x |
- checkmate::assert_character(paramu, min.len = 1, any.missing = FALSE)+ any_of(adqlqc_name_ordered)+ |
+ |
| 243 | ++ |
+ )+ |
+ ||
| 244 | ++ | + | ||
| 58 | +245 | 3x |
- checkmate::assert_string(visit_format)+ adqlqc_final <- relocate(adqlqc_final, "QSEVLINT", .after = "QSTESTCD") %>% |
|
| 59 | +246 | 3x |
- checkmate::assert_integer(n_assessments, len = 1, any.missing = FALSE)+ arrange( |
|
| 60 | +247 | 3x |
- checkmate::assert_integer(n_days, len = 1, any.missing = FALSE)+ USUBJID, |
|
| 61 | +248 | 3x |
- checkmate::assert_number(seed, null.ok = TRUE)+ AVISITN, |
|
| 62 | +249 | 3x |
- checkmate::assert_number(na_percentage, lower = 0, upper = 1)+ ASEQ, |
|
| 63 | +250 | 3x |
- checkmate::assert_true(na_percentage < 1)+ QSTESTCD |
|
| 64 | +251 |
-
+ ) |
||
| 65 | +252 |
- # validate and initialize param vectors+ # apply metadata |
||
| 66 | +253 | 3x |
- param_init_list <- relvar_init(param, paramcd)+ adqlqc_final <- apply_metadata(adqlqc_final, "metadata/ADQLQC.yml") |
|
| 67 | +254 | 3x |
- unit_init_list <- relvar_init(param, paramu)+ return(adqlqc_final) |
|
| 68 | +255 | - - | -||
| 69 | -3x | -
- if (!is.null(seed)) {
+ } |
||
| 70 | -3x | +|||
| 256 | +
- set.seed(seed)+ |
|||
| 71 | +257 |
- }+ #' Helper Functions for Constructing ADQLQC |
||
| 72 | -3x | +|||
| 258 | +
- study_duration_secs <- lubridate::seconds(attr(adsl, "study_duration_secs"))+ #' |
|||
| 73 | +259 |
-
+ #' Internal functions used by `radqlqc`. |
||
| 74 | -3x | +|||
| 260 | +
- advs <- expand.grid(+ #' |
|||
| 75 | -3x | +|||
| 261 | +
- STUDYID = unique(adsl$STUDYID),+ #' @inheritParams argument_convention |
|||
| 76 | -3x | +|||
| 262 | +
- USUBJID = adsl$USUBJID,+ #' @inheritParams radqlqc |
|||
| 77 | -3x | +|||
| 263 | +
- PARAM = as.factor(param_init_list$relvar1),+ #' |
|||
| 78 | -3x | +|||
| 264 | +
- AVISIT = visit_schedule(visit_format = visit_format, n_assessments = n_assessments),+ #' @examples |
|||
| 79 | -3x | +|||
| 265 | +
- stringsAsFactors = FALSE+ #' adsl <- radsl(N = 10, study_duration = 2, seed = 1) |
|||
| 80 | +266 |
- )+ #' adqlqc <- radqlqc(adsl, seed = 1, percent = 80, number = 2) |
||
| 81 | +267 |
-
+ #' |
||
| 82 | -3x | +|||
| 268 | +
- advs <- dplyr::mutate(+ #' @name h_adqlqc |
|||
| 83 | -3x | +|||
| 269 | +
- advs,+ NULL |
|||
| 84 | -3x | +|||
| 270 | +
- AVISITN = dplyr::case_when(+ |
|||
| 85 | -3x | +|||
| 271 | +
- AVISIT == "SCREENING" ~ -1,+ #' @describeIn h_adqlqc Questionnaires EORTC QLQ-C30 V3.0 SDTM (QS) |
|||
| 86 | -3x | +|||
| 272 | +
- AVISIT == "BASELINE" ~ 0,+ #' |
|||
| 87 | -3x | +|||
| 273 | +
- (grepl("^WEEK", AVISIT) | grepl("^CYCLE", AVISIT)) ~ as.numeric(AVISIT) - 2,
+ #' Function for generating random Questionnaires SDTM domain |
|||
| 88 | -3x | +|||
| 274 | +
- TRUE ~ NA_real_+ #' |
|||
| 89 | +275 |
- )+ #' @return a dataframe with SDTM questionnaire data |
||
| 90 | +276 |
- )+ #' @keywords internal |
||
| 91 | +277 |
-
+ get_qs_data <- function(adsl, |
||
| 92 | -3x | +|||
| 278 | +
- advs$VSCAT <- "VITAL SIGNS"+ visit_format = "CYCLE", |
|||
| 93 | +279 |
-
+ n_assessments = 5L, |
||
| 94 | +280 |
- # assign related variable values: PARAMxPARAMCD are related+ n_days = 1L, |
||
| 95 | -3x | +|||
| 281 | +
- advs <- advs %>% rel_var(+ lookup = NULL, |
|||
| 96 | -3x | +|||
| 282 | +
- var_name = "PARAMCD",+ seed = NULL, |
|||
| 97 | -3x | +|||
| 283 | +
- related_var = "PARAM",+ na_percentage = 0, |
|||
| 98 | -3x | +|||
| 284 | +
- var_values = param_init_list$relvar2+ na_vars = list( |
|||
| 99 | +285 |
- )+ QSORRES = c(1234, 0.2), |
||
| 100 | +286 |
-
+ QSSTRESC = c(1234, 0.2) |
||
| 101 | +287 |
- # assign related variable values: PARAMxAVALU are related+ )) {
|
||
| 102 | +288 | 3x |
- advs <- advs %>% rel_var(+ load(system.file("sysdata.rda", package = "random.cdisc.data"))
|
|
| 103 | +289 | 3x |
- var_name = "AVALU",+ checkmate::assert_string(visit_format) |
|
| 104 | +290 | 3x |
- related_var = "PARAM",+ checkmate::assert_integer(n_assessments, len = 1, any.missing = FALSE) |
|
| 105 | +291 | 3x |
- var_values = unit_init_list$relvar2- |
- |
| 106 | -- |
- )+ checkmate::assert_integer(n_days, len = 1, any.missing = FALSE) |
||
| 107 | -+ | |||
| 292 | +3x |
-
+ checkmate::assert_number(seed, null.ok = TRUE) |
||
| 108 | +293 | 3x |
- advs <- advs %>%+ checkmate::assert_number(na_percentage, lower = 0, upper = 1, na.ok = TRUE) |
|
| 109 | +294 | 3x |
- dplyr::mutate(VSTESTCD = PARAMCD) %>%+ checkmate::assert_number(na_percentage, lower = 0, upper = 1) |
|
| 110 | +295 | 3x |
- dplyr::mutate(VSTEST = PARAM)+ checkmate::assert_true(na_percentage < 1) |
|
| 111 | +296 | |||
| 112 | -3x | +|||
| 297 | +
- advs <- advs %>% dplyr::mutate(AVAL = dplyr::case_when(+ # get subjects for QS data from ADSL |
|||
| 113 | -3x | +|||
| 298 | +
- PARAMCD == paramcd[1] ~ stats::rnorm(nrow(advs), mean = 100, sd = 20),+ # get studyid, subject for QS generation |
|||
| 114 | +299 | 3x |
- PARAMCD == paramcd[2] ~ stats::rnorm(nrow(advs), mean = 80, sd = 15),+ qs <- select( |
|
| 115 | +300 | 3x |
- PARAMCD == paramcd[3] ~ stats::rnorm(nrow(advs), mean = 16, sd = 5),+ adsl, |
|
| 116 | +301 | 3x |
- PARAMCD == paramcd[4] ~ stats::rnorm(nrow(advs), mean = 150, sd = 30),+ STUDYID, |
|
| 117 | +302 | 3x |
- PARAMCD == paramcd[5] ~ stats::rnorm(nrow(advs), mean = 36.65, sd = 1),+ USUBJID+ |
+ |
| 303 | ++ |
+ ) %>% |
||
| 118 | +304 | 3x |
- PARAMCD == paramcd[6] ~ stats::rnorm(nrow(advs), mean = 70, sd = 20)+ mutate(+ |
+ |
| 305 | +3x | +
+ DOMAIN = "QS" |
||
| 119 | +306 |
- ))+ ) |
||
| 120 | +307 | |||
| 121 | +308 |
- # order to prepare for change from screening and baseline values+ # QS prep ----------------------------------------------------------------- |
||
| 122 | -3x | +|||
| 309 | +
- advs <- advs[order(advs$STUDYID, advs$USUBJID, advs$PARAMCD, advs$AVISITN), ]+ # get questionnaire function for QS |
|||
| 123 | +310 |
-
+ # QSTESTCD: EOR0101 to EOR0130 |
||
| 124 | +311 | 3x |
- advs <- Reduce(rbind, lapply(split(advs, advs$USUBJID), function(x) {
- |
- |
| 125 | -30x | -
- x$STUDYID <- adsl$STUDYID[which(adsl$USUBJID == x$USUBJID[1])]- |
- ||
| 126 | -30x | -
- x$ABLFL2 <- ifelse(x$AVISIT == "SCREENING", "Y", "")+ eortc_qlq_c30_sub <- filter( |
||
| 127 | -30x | +312 | +3x |
- x$ABLFL <- ifelse(+ eortc_qlq_c30, |
| 128 | -30x | +313 | +3x |
- toupper(visit_format) == "WEEK" & x$AVISIT == "BASELINE",+ as.numeric(str_extract(QSTESTCD, "\\d+$")) >= 101 & |
| 129 | -30x | +314 | +3x |
- "Y",+ as.numeric(str_extract(QSTESTCD, "\\d+$")) <= 130 |
| 130 | -30x | +|||
| 315 | +
- ifelse(+ ) %>% |
|||
| 131 | -30x | +316 | +3x |
- toupper(visit_format) == "CYCLE" & x$AVISIT == "CYCLE 1 DAY 1",+ select(-publication_name) |
| 132 | -30x | +|||
| 317 | +
- "Y",+ |
|||
| 133 | +318 |
- ""+ # validate and initialize QSTEST vectors |
||
| 134 | -+ | |||
| 319 | +3x |
- )+ qstest_init_list <- relvar_init( |
||
| 135 | -+ | |||
| 320 | +3x |
- )+ unique(eortc_qlq_c30_sub$QSTEST), |
||
| 136 | -30x | +321 | +3x |
- x+ unique(eortc_qlq_c30_sub$QSTESTCD) |
| 137 | +322 |
- }))+ ) |
||
| 138 | +323 | |||
| 139 | +324 | 3x |
- advs$BASE2 <- retain(advs, advs$AVAL, advs$ABLFL2 == "Y")+ if (!is.null(seed)) {
|
|
| 140 | +325 | 3x |
- advs$BASE <- ifelse(advs$ABLFL2 != "Y", retain(advs, advs$AVAL, advs$ABLFL == "Y"), NA)+ set.seed(seed) |
|
| 141 | +326 |
-
+ } |
||
| 142 | -3x | +|||
| 327 | +
- advs <- advs %>%+ |
|||
| 143 | +328 | 3x |
- dplyr::mutate(CHG2 = AVAL - BASE2) %>%+ checkmate::assert_data_frame(lookup, null.ok = TRUE) |
|
| 144 | -3x | +|||
| 329 | +
- dplyr::mutate(PCHG2 = 100 * (CHG2 / BASE2)) %>%+ |
|||
| 145 | +330 | 3x |
- dplyr::mutate(CHG = AVAL - BASE) %>%+ lookup_qs <- if (!is.null(lookup)) {
|
|
| 146 | -3x | +|||
| 331 | +! |
- dplyr::mutate(PCHG = 100 * (CHG / BASE)) %>%+ lookup |
||
| 147 | -3x | +|||
| 332 | +
- dplyr::mutate(ANRLO = dplyr::case_when(+ } else {
|
|||
| 148 | +333 | 3x |
- PARAMCD == "DIABP" ~ 80,+ expand.grid( |
|
| 149 | +334 | 3x |
- PARAMCD == "PULSE" ~ 60,+ STUDYID = unique(qs$STUDYID), |
|
| 150 | +335 | 3x |
- PARAMCD == "RESP" ~ 12,+ USUBJID = qs$USUBJID, |
|
| 151 | +336 | 3x |
- PARAMCD == "SYSBP" ~ 120,+ QSTEST = qstest_init_list$relvar1, |
|
| 152 | +337 | 3x |
- PARAMCD == "TEMP" ~ 36.1,+ VISIT = visit_schedule( |
|
| 153 | +338 | 3x |
- PARAMCD == "WEIGHT" ~ 40- |
- |
| 154 | -- |
- )) %>%+ visit_format = visit_format, |
||
| 155 | +339 | 3x |
- dplyr::mutate(ANRHI = dplyr::case_when(+ n_assessments = n_assessments, |
|
| 156 | +340 | 3x |
- PARAMCD == "DIABP" ~ 120,+ n_days = n_days |
|
| 157 | -3x | +|||
| 341 | +
- PARAMCD == "PULSE" ~ 100,+ ), |
|||
| 158 | +342 | 3x |
- PARAMCD == "RESP" ~ 20,+ stringsAsFactors = FALSE |
|
| 159 | -3x | +|||
| 343 | +
- PARAMCD == "SYSBP" ~ 180,+ ) |
|||
| 160 | -3x | +|||
| 344 | +
- PARAMCD == "TEMP" ~ 37.2,+ } |
|||
| 161 | -3x | +|||
| 345 | +
- PARAMCD == "WEIGHT" ~ 100+ |
|||
| 162 | +346 |
- )) %>%+ # assign related variable values: QSTESTxQSTESTCD are related |
||
| 163 | +347 | 3x |
- dplyr::mutate(ANRIND = factor(dplyr::case_when(+ lookup_qs <- lookup_qs %>% rel_var( |
|
| 164 | +348 | 3x |
- AVAL < ANRLO ~ "LOW",+ var_name = "QSTESTCD", |
|
| 165 | +349 | 3x |
- AVAL > ANRHI ~ "HIGH",+ related_var = "QSTEST", |
|
| 166 | +350 | 3x |
- TRUE ~ "NORMAL"+ var_values = qstest_init_list$relvar2 |
|
| 167 | +351 |
- ))) %>%+ ) |
||
| 168 | -3x | +|||
| 352 | +
- dplyr::mutate(VSSTRESC = dplyr::case_when(+ |
|||
| 169 | +353 | 3x |
- PARAMCD == "DIABP" ~ "<80",+ lookup_qs <- left_join( |
|
| 170 | +354 | 3x |
- PARAMCD == "PULSE" ~ "<60",+ lookup_qs, |
|
| 171 | +355 | 3x |
- PARAMCD == "RESP" ~ ">20",+ eortc_qlq_c30_sub, |
|
| 172 | +356 | 3x |
- PARAMCD == "SYSBP" ~ ">180",+ by = c( |
|
| 173 | +357 | 3x |
- PARAMCD == "TEMP" ~ "<36.1",+ "QSTEST", |
|
| 174 | +358 | 3x |
- PARAMCD == "WEIGHT" ~ "<40"+ "QSTESTCD" |
|
| 175 | +359 |
- )) %>%+ ), |
||
| 176 | +360 | 3x |
- dplyr::rowwise() %>%+ multiple = "all", |
|
| 177 | +361 | 3x |
- dplyr::mutate(LOQFL = factor(+ relationship = "many-to-many" |
|
| 178 | -3x | +|||
| 362 | +
- ifelse(eval(parse(text = paste(AVAL, VSSTRESC))), "Y", "N")+ ) |
|||
| 179 | +363 |
- )) %>%+ |
||
| 180 | +364 | 3x |
- dplyr::ungroup() %>%+ lookup_qs <- dplyr::mutate( |
|
| 181 | +365 | 3x |
- dplyr::mutate(BASETYPE = "LAST") %>%+ lookup_qs, |
|
| 182 | +366 | 3x |
- dplyr::group_by(USUBJID, PARAMCD, BASETYPE) %>%+ VISITNUM = dplyr::case_when( |
|
| 183 | +367 | 3x |
- dplyr::mutate(BNRIND = ANRIND[ABLFL == "Y"]) %>%+ VISIT == "SCREENING" ~ -1, |
|
| 184 | +368 | 3x |
- dplyr::ungroup() %>%+ VISIT == "BASELINE" ~ 0, |
|
| 185 | +369 | 3x |
- dplyr::mutate(ATPTN = 1) %>%+ (grepl("^WEEK", VISIT) | grepl("^CYCLE", VISIT)) ~ as.numeric(VISIT) - 2,
|
|
| 186 | +370 | 3x |
- dplyr::mutate(DTYPE = NA) %>%+ TRUE ~ NA_real_ |
|
| 187 | -3x | +|||
| 371 | +
- var_relabel(+ ) |
|||
| 188 | +372 | 3x |
- USUBJID = attr(adsl$USUBJID, "label"),+ ) %>% arrange(USUBJID) |
|
| 189 | -3x | +|||
| 373 | +
- STUDYID = attr(adsl$STUDYID, "label")+ |
|||
| 190 | +374 |
- )+ # # prep QSALL -------------------------------------------------------------- |
||
| 191 | +375 |
-
+ # get last subject and visit for QSALL |
||
| 192 | +376 | 3x |
- advs <- var_relabel(+ last_subj_vis <- select(lookup_qs, USUBJID, VISIT) %>% |
|
| 193 | +377 | 3x |
- advs,+ distinct() %>% |
|
| 194 | +378 | 3x |
- STUDYID = "Study Identifier",+ slice(n()) |
|
| 195 | +379 | 3x |
- USUBJID = "Unique Subject Identifier"+ last_subj_vis_full <- filter( |
|
| 196 | -+ | |||
| 380 | +3x |
- )+ lookup_qs,+ |
+ ||
| 381 | +3x | +
+ USUBJID == last_subj_vis$USUBJID,+ |
+ ||
| 382 | +3x | +
+ VISIT == last_subj_vis$VISIT |
||
| 197 | +383 |
-
+ ) |
||
| 198 | +384 |
- # merge ADSL to be able to add LB date and study day variables+ |
||
| 199 | +385 | 3x |
- advs <- dplyr::inner_join(+ qsall_data1 <- tibble::tibble( |
|
| 200 | +386 | 3x |
- advs,+ STUDYID = unique(last_subj_vis_full$STUDYID), |
|
| 201 | +387 | 3x |
- adsl,+ USUBJID = unique(last_subj_vis_full$USUBJID), |
|
| 202 | +388 | 3x |
- by = c("STUDYID", "USUBJID")
+ VISIT = unique(last_subj_vis_full$VISIT), |
|
| 203 | -+ | |||
| 389 | +3x |
- ) %>%+ VISITNUM = unique(last_subj_vis_full$VISITNUM), |
||
| 204 | +390 | 3x |
- dplyr::rowwise() %>%+ QSTESTCD = "QSALL", |
|
| 205 | +391 | 3x |
- dplyr::mutate(TRTENDT = lubridate::date(dplyr::case_when(+ QSTEST = "Questionnaires", |
|
| 206 | +392 | 3x |
- is.na(TRTEDTM) ~ lubridate::floor_date(lubridate::date(TRTSDTM) + study_duration_secs, unit = "day"),+ QSSTAT = "NOT DONE", |
|
| 207 | +393 | 3x |
- TRUE ~ TRTEDTM+ QSREASND = "SUBJECT REFUSED" |
|
| 208 | +394 |
- ))) %>%+ ) |
||
| 209 | -3x | +|||
| 395 | +
- dplyr::ungroup()+ |
|||
| 210 | +396 |
-
+ # remove last subject and visit from main data |
||
| 211 | +397 | 3x |
- advs <- advs %>%+ lookup_qs_sub <- anti_join( |
|
| 212 | +398 | 3x |
- dplyr::group_by(USUBJID) %>%+ lookup_qs, |
|
| 213 | +399 | 3x |
- dplyr::arrange(USUBJID, AVISITN) %>%+ last_subj_vis_full, |
|
| 214 | +400 | 3x |
- dplyr::mutate(ADTM = rep(+ by = c("USUBJID", "VISIT")
|
|
| 215 | -3x | +|||
| 401 | +
- sort(sample(+ )+ |
+ |||
| 402 | ++ | + | ||
| 216 | +403 | 3x |
- seq(lubridate::as_datetime(TRTSDTM[1]), lubridate::as_datetime(TRTENDT[1]), by = "day"),+ set.seed(seed) |
|
| 217 | +404 | 3x |
- size = nlevels(AVISIT)+ lookup_qs_sub_x <- lookup_qs_sub %>% |
|
| 218 | -+ | |||
| 405 | +3x |
- )),+ group_by( |
||
| 219 | +406 | 3x |
- each = n() / nlevels(AVISIT)+ USUBJID, |
|
| 220 | -+ | |||
| 407 | +3x |
- )) %>%+ QSTESTCD, |
||
| 221 | +408 | 3x |
- dplyr::ungroup() %>%+ VISIT+ |
+ |
| 409 | ++ |
+ ) %>% |
||
| 222 | +410 | 3x |
- dplyr::mutate(ADY = ceiling(difftime(ADTM, TRTSDTM, units = "days"))) %>%+ slice_sample(n = 1) %>% |
|
| 223 | +411 | 3x |
- dplyr::select(-TRTENDT) %>%+ ungroup() %>% |
|
| 224 | +412 | 3x |
- dplyr::arrange(STUDYID, USUBJID, ADTM)+ as.data.frame() |
|
| 225 | +413 | |||
| 226 | +414 | 3x |
- advs <- advs %>% dplyr::mutate(ONTRTFL = factor(dplyr::case_when(+ lookup_qs_sub_x <- arrange( |
|
| 227 | +415 | 3x |
- !AVISIT %in% c("SCREENING", "BASELINE") ~ "Y",
+ lookup_qs_sub_x, |
|
| 228 | +416 | 3x |
- TRUE ~ ""+ USUBJID,+ |
+ |
| 417 | +3x | +
+ VISITNUM |
||
| 229 | +418 |
- )))+ ) |
||
| 230 | +419 | |||
| 231 | -3x | +|||
| 420 | +
- advs <- advs %>%+ # add date: QSDTC --------------------------------------------------------- |
|||
| 232 | -3x | +|||
| 421 | +
- dplyr::mutate(ASPID = sample(seq_len(dplyr::n()))) %>%+ # get treatment dates from ADSL |
|||
| 233 | +422 | 3x |
- dplyr::group_by(USUBJID) %>%+ adsl_trt <- select( |
|
| 234 | +423 | 3x |
- dplyr::mutate(VSSEQ = seq_len(dplyr::n())) %>%+ adsl, |
|
| 235 | +424 | 3x |
- dplyr::mutate(ASEQ = VSSEQ) %>%+ USUBJID, |
|
| 236 | +425 | 3x |
- dplyr::ungroup() %>%+ TRTSDTM, |
|
| 237 | +426 | 3x |
- dplyr::arrange(+ TRTEDTM |
|
| 238 | -3x | +|||
| 427 | +
- STUDYID,+ ) |
|||
| 239 | -3x | +|||
| 428 | +
- USUBJID,+ # use to derive QSDTC |
|||
| 240 | -3x | +|||
| 429 | +
- PARAMCD,+ # if no treatment end date, create an arbituary one |
|||
| 241 | +430 | 3x |
- BASETYPE,+ trt_end_date <- max(adsl_trt$TRTEDTM, na.rm = TRUE) |
|
| 242 | -3x | +|||
| 431 | +
- AVISITN,+ |
|||
| 243 | +432 | 3x |
- ATPTN,+ lookup_qs_sub_x <- left_join( |
|
| 244 | +433 | 3x |
- DTYPE,+ lookup_qs_sub_x, |
|
| 245 | +434 | 3x |
- ADTM,+ adsl_trt, |
|
| 246 | +435 | 3x |
- VSSEQ,+ by = "USUBJID"+ |
+ |
| 436 | ++ |
+ ) %>% |
||
| 247 | +437 | 3x |
- ASPID+ group_by( |
|
| 248 | -+ | |||
| 438 | +3x |
- )+ USUBJID |
||
| 249 | +439 |
-
+ ) %>% |
||
| 250 | +440 | 3x |
- if (length(na_vars) > 0 && na_percentage > 0) {
+ mutate(QSDTC = get_random_dates_between( |
|
| 251 | -! | +|||
| 441 | +3x |
- advs <- mutate_na(ds = advs, na_vars = na_vars, na_percentage = na_percentage)+ from = TRTSDTM, |
||
| 252 | -+ | |||
| 442 | +3x |
- }+ to = ifelse( |
||
| 253 | -+ | |||
| 443 | +3x |
-
+ is.na(TRTEDTM), |
||
| 254 | -+ | |||
| 444 | +3x |
- # apply metadata+ trt_end_date, |
||
| 255 | +445 | 3x |
- advs <- apply_metadata(advs, "metadata/ADVS.yml")+ TRTEDTM |
|
| 256 | +446 |
-
+ ), |
||
| 257 | +447 | 3x |
- return(advs)+ visit_id = VISITNUM |
|
| 258 | +448 |
- }+ )) %>% |
| 1 | -+ | |||
| 449 | +3x |
- #' Exposure Analysis Dataset (ADEX)+ select(-c("TRTSDTM", "TRTEDTM"))
|
||
| 2 | +450 |
- #'+ |
||
| 3 | +451 |
- #' @description `r lifecycle::badge("stable")`
+ # filter out subjects with missing dates |
||
| 4 | -+ | |||
| 452 | +3x |
- #'+ lookup_qs_sub_x1 <- filter( |
||
| 5 | -+ | |||
| 453 | +3x |
- #' Function for generating random Exposure Analysis Dataset for a given+ lookup_qs_sub_x, |
||
| 6 | -+ | |||
| 454 | +3x |
- #' Subject-Level Analysis Dataset.+ !is.na(QSDTC) |
||
| 7 | +455 |
- #'+ ) |
||
| 8 | +456 |
- #' @details One record per each record in the corresponding SDTM domain.+ |
||
| 9 | +457 |
- #'+ # subjects with missing dates |
||
| 10 | -+ | |||
| 458 | +3x |
- #' Keys: `STUDYID`, `USUBJID`, `EXSEQ`, `PARAMCD`, `PARCAT1`, `ASTDTM`, `AENDTM`, `ASTDY`, `AENDY`,+ lookup_qs_sub_x2 <- filter( |
||
| 11 | -+ | |||
| 459 | +3x |
- #' `AVISITN`, `EXDOSFRQ`, `EXROUTE`, `VISIT`, `VISITDY`, `EXSTDTC`, `EXENDTC`, `EXSTDY`, `EXENDY`+ lookup_qs_sub_x, |
||
| 12 | -+ | |||
| 460 | +3x |
- #'+ is.na(QSDTC) |
||
| 13 | +461 |
- #' @inheritParams argument_convention+ ) %>% |
||
| 14 | -+ | |||
| 462 | +3x |
- #' @param parcat1 (`character vector`)\cr Dose amount categories. Defaults to "Individual" and "Overall".+ select( |
||
| 15 | -+ | |||
| 463 | +3x |
- #' @param parcat2 (`character vector`)\cr Types of drug received. Defaults to "Drug A" and "Drug B".+ STUDYID, |
||
| 16 | -+ | |||
| 464 | +3x |
- #' @param max_n_exs (`integer`)\cr Maximum number of exposures per patient. Defaults to 6.+ USUBJID, |
||
| 17 | -+ | |||
| 465 | +3x |
- #' @template param_cached+ VISIT, |
||
| 18 | -+ | |||
| 466 | +3x |
- #' @templateVar data adex+ VISITNUM |
||
| 19 | +467 |
- #'+ ) %>% |
||
| 20 | -+ | |||
| 468 | +3x |
- #' @return `data.frame`+ distinct() |
||
| 21 | +469 |
- #' @export+ |
||
| 22 | +470 |
- #'+ # generate QSALL for subjects with missing dates |
||
| 23 | -+ | |||
| 471 | +3x |
- #' @examples+ qsall_data2 <- mutate( |
||
| 24 | -+ | |||
| 472 | +3x |
- #' adsl <- radsl(N = 10, study_duration = 2, seed = 1)+ lookup_qs_sub_x2, |
||
| 25 | -+ | |||
| 473 | +3x |
- #'+ QSTESTCD = "QSALL", |
||
| 26 | -+ | |||
| 474 | +3x |
- #' adex <- radex(adsl, seed = 2)+ QSTEST = "Questionnaires", |
||
| 27 | -+ | |||
| 475 | +3x |
- #' adex+ QSSTAT = "NOT DONE", |
||
| 28 | -+ | |||
| 476 | +3x |
- radex <- function(adsl,+ QSREASND = "SUBJECT REFUSED" |
||
| 29 | +477 |
- param = c(+ ) |
||
| 30 | +478 |
- "Dose administered during constant dosing interval",+ |
||
| 31 | +479 |
- "Number of doses administered during constant dosing interval",+ # add qsall data to original item data |
||
| 32 | -+ | |||
| 480 | +3x |
- "Total dose administered",+ lookup_qs_sub_all <- bind_rows( |
||
| 33 | -+ | |||
| 481 | +3x |
- "Total number of doses administered"+ lookup_qs_sub_x1, |
||
| 34 | -+ | |||
| 482 | +3x |
- ),+ qsall_data1, |
||
| 35 | -+ | |||
| 483 | +3x |
- paramcd = c("DOSE", "NDOSE", "TDOSE", "TNDOSE"),
+ qsall_data2 |
||
| 36 | +484 |
- paramu = c("mg", " ", "mg", " "),
+ ) |
||
| 37 | +485 |
- parcat1 = c("INDIVIDUAL", "OVERALL"),
+
|
||
| 38 | -+ | |||
| 486 | +3x |
- parcat2 = c("Drug A", "Drug B"),
+ qs_all <- lookup_qs_sub_all %>% |
||
| 39 | -+ | |||
| 487 | +3x |
- visit_format = "WEEK",+ arrange( |
||
| 40 | -+ | |||
| 488 | +3x |
- n_assessments = 5L,+ STUDYID, |
||
| 41 | -+ | |||
| 489 | +3x |
- n_days = 5L,+ USUBJID, |
||
| 42 | -+ | |||
| 490 | +3x |
- max_n_exs = 6L,+ VISITNUM |
||
| 43 | +491 |
- lookup = NULL,+ ) %>% |
||
| 44 | -+ | |||
| 492 | +3x |
- seed = NULL,+ dplyr::group_by(USUBJID) %>% |
||
| 45 | -+ | |||
| 493 | +3x |
- na_percentage = 0,+ dplyr::ungroup() |
||
| 46 | +494 |
- na_vars = list(AVAL = c(NA, 0.1), AVALU = c(NA), 0.1),+ |
||
| 47 | +495 |
- cached = FALSE) {
+ # get first and second subject ids |
||
| 48 | -4x | +496 | +3x |
- checkmate::assert_flag(cached)+ first_second_subj <- select(qs_all, USUBJID) %>% |
| 49 | -4x | +497 | +3x |
- if (cached) {
+ distinct() %>% |
| 50 | -1x | -
- return(get_cached_data("cadex"))
- |
- ||
| 51 | -+ | 498 | +3x |
- }+ slice(1:2) |
| 52 | +499 | |||
| 53 | +500 | 3x |
- checkmate::assert_data_frame(adsl)+ qs1 <- filter( |
|
| 54 | +501 | 3x |
- checkmate::assert_character(param, min.len = 1, any.missing = FALSE)+ qs_all, |
|
| 55 | +502 | 3x |
- checkmate::assert_character(paramcd, min.len = 1, any.missing = FALSE)+ USUBJID %in% first_second_subj$USUBJID |
|
| 56 | -3x | +|||
| 503 | +
- checkmate::assert_character(parcat1, min.len = 1, any.missing = FALSE)+ ) |
|||
| 57 | -3x | +|||
| 504 | +
- checkmate::assert_character(parcat2, min.len = 1, any.missing = FALSE)+ |
|||
| 58 | +505 | 3x |
- checkmate::assert_string(visit_format)+ if (length(na_vars) > 0 && na_percentage > 0) {
|
|
| 59 | +506 | 3x |
- checkmate::assert_integer(n_assessments, len = 1, any.missing = FALSE)+ qs1 <- mutate_na(ds = qs1, na_vars = na_vars, na_percentage = na_percentage) |
|
| 60 | -3x | +|||
| 507 | +
- checkmate::assert_integer(n_days, len = 1, any.missing = FALSE)+ } |
|||
| 61 | -3x | +|||
| 508 | +
- checkmate::assert_integer(max_n_exs, len = 1, any.missing = FALSE)+ + |
+ |||
| 509 | ++ |
+ # QSSTAT = NOT DONE |
||
| 62 | +510 | 3x |
- checkmate::assert_data_frame(lookup, null.ok = TRUE)+ qs1 <- mutate( |
|
| 63 | +511 | 3x |
- checkmate::assert_number(seed, null.ok = TRUE)+ qs1, |
|
| 64 | +512 | 3x |
- checkmate::assert_number(na_percentage, lower = 0, upper = 1)+ QSSTAT = case_when( |
|
| 65 | +513 | 3x |
- checkmate::assert_true(na_percentage < 1)+ is.na(QSORRES) & is.na(QSSTRESC) ~ "NOT DONE" |
|
| 66 | +514 |
-
+ ) |
||
| 67 | +515 |
- # validate and initialize related variables- |
- ||
| 68 | -3x | -
- param_init_list <- relvar_init(param, paramcd)+ ) |
||
| 69 | -3x | +|||
| 516 | +
- unit_init_list <- relvar_init(param, paramu)+ |
|||
| 70 | +517 |
-
+ # remove first and second subjects from main data |
||
| 71 | +518 | 3x |
- if (!is.null(seed)) {
+ qs2 <- anti_join( |
|
| 72 | +519 | 3x |
- set.seed(seed)+ qs_all, |
|
| 73 | -+ | |||
| 520 | +3x |
- }+ qs1, |
||
| 74 | +521 | 3x |
- study_duration_secs <- lubridate::seconds(attr(adsl, "study_duration_secs"))+ by = c("USUBJID")
|
|
| 75 | +522 |
-
+ ) |
||
| 76 | -3x | +|||
| 523 | +
- adex <- expand.grid(+ |
|||
| 77 | +524 | 3x |
- STUDYID = unique(adsl$STUDYID),+ final_qs <- rbind( |
|
| 78 | +525 | 3x |
- USUBJID = adsl$USUBJID,+ qs1, |
|
| 79 | +526 | 3x |
- PARAM = c(+ qs2 |
|
| 80 | -3x | +|||
| 527 | +
- rep(+ ) %>% |
|||
| 81 | +528 | 3x |
- param_init_list$relvar1[1],+ group_by(USUBJID) %>% |
|
| 82 | +529 | 3x |
- length(levels(visit_schedule(visit_format = visit_format, n_assessments = n_assessments, n_days = n_days)))- |
- |
| 83 | -- |
- ),+ dplyr::mutate(QSSEQ = row_number()) %>% |
||
| 84 | +530 | 3x |
- rep(+ arrange( |
|
| 85 | +531 | 3x |
- param_init_list$relvar1[2],+ STUDYID, |
|
| 86 | +532 | 3x |
- length(levels(visit_schedule(visit_format = visit_format, n_assessments = n_assessments, n_days = n_days)))- |
- |
| 87 | -- |
- ),+ USUBJID, |
||
| 88 | +533 | 3x |
- param_init_list$relvar1[3:4]+ VISITNUM |
|
| 89 | +534 |
- ),+ ) %>% |
||
| 90 | +535 | 3x |
- stringsAsFactors = FALSE- |
- |
| 91 | -- |
- )+ ungroup() |
||
| 92 | +536 | |||
| 93 | +537 |
- # assign related variable values: PARAMxPARAMCD are related+ # ordered variables as per gdsr |
||
| 94 | +538 | 3x |
- adex <- adex %>% rel_var(+ final_qs <- select( |
|
| 95 | +539 | 3x |
- var_name = "PARAMCD",+ final_qs, |
|
| 96 | +540 | 3x |
- related_var = "PARAM",+ STUDYID, |
|
| 97 | +541 | 3x |
- var_values = param_init_list$relvar2+ USUBJID, |
|
| 98 | -+ | |||
| 542 | +3x |
- )+ QSSEQ, |
||
| 99 | -+ | |||
| 543 | +3x |
-
+ QSTESTCD, |
||
| 100 | -+ | |||
| 544 | +3x |
- # assign related variable values: AVALUxPARAM are related+ QSTEST, |
||
| 101 | +545 | 3x |
- adex <- adex %>% rel_var(+ QSCAT, |
|
| 102 | +546 | 3x |
- var_name = "AVALU",+ QSSCAT, |
|
| 103 | +547 | 3x |
- related_var = "PARAM",+ QSORRES, |
|
| 104 | +548 | 3x |
- var_values = unit_init_list$relvar2+ QSORRESU, |
|
| 105 | -+ | |||
| 549 | +3x |
- )+ QSSTRESC, |
||
| 106 | -+ | |||
| 550 | +3x |
-
+ QSSTRESU, |
||
| 107 | +551 | 3x |
- adex <- adex %>%+ QSSTAT, |
|
| 108 | +552 | 3x |
- dplyr::group_by(USUBJID) %>%+ QSREASND, |
|
| 109 | +553 | 3x |
- dplyr::mutate(PARCAT_ind = sample(c(1, 2), size = 1)) %>%+ VISITNUM, |
|
| 110 | +554 | 3x |
- dplyr::mutate(PARCAT2 = ifelse(PARCAT_ind == 1, parcat2[1], parcat2[2])) %>%+ VISIT, |
|
| 111 | +555 | 3x |
- dplyr::select(-"PARCAT_ind")+ QSDTC, |
|
| 112 | -+ | |||
| 556 | +3x |
-
+ QSEVLINT |
||
| 113 | +557 |
- # Add in PARCAT1+ ) |
||
| 114 | +558 | 3x |
- adex <- adex %>% dplyr::mutate(PARCAT1 = dplyr::case_when(+ return(final_qs) |
|
| 115 | -3x | +|||
| 559 | +
- (PARAMCD == "TNDOSE" | PARAMCD == "TDOSE") ~ "OVERALL",+ } |
|||
| 116 | -3x | +|||
| 560 | +
- PARAMCD == "DOSE" | PARAMCD == "NDOSE" ~ "INDIVIDUAL"+ |
|||
| 117 | +561 |
- ))+ #' @describeIn h_adqlqc Function for generating random dates between 2 dates |
||
| 118 | +562 |
-
+ #' |
||
| 119 | -3x | +|||
| 563 | +
- adex_visit <- adex %>%+ #' @param from (`datetime vector`)\cr Start date/times. |
|||
| 120 | -3x | +|||
| 564 | +
- dplyr::filter(PARAMCD == "DOSE" | PARAMCD == "NDOSE") %>%+ #' @param to (`datetime vector`)\cr End date/times. |
|||
| 121 | -3x | +|||
| 565 | +
- dplyr::mutate(+ #' @param visit_id (`vector`)\cr Visit identifiers. |
|||
| 122 | -3x | +|||
| 566 | +
- AVISIT = rep(visit_schedule(visit_format = visit_format, n_assessments = n_assessments, n_days = n_days), 2)+ #' |
|||
| 123 | +567 |
- )+ #' @return Data frame with new randomly generated dates variable. |
||
| 124 | +568 |
-
+ #' @keywords internal |
||
| 125 | -3x | +|||
| 569 | +
- adex <- dplyr::left_join(+ get_random_dates_between <- function(from, to, visit_id) {
|
|||
| 126 | -3x | +570 | +30x |
- adex %>%+ min_date <- min(lubridate::as_datetime(from), na.rm = TRUE) |
| 127 | -3x | +571 | +30x |
- dplyr::group_by(+ max_date <- max(lubridate::as_datetime(to), na.rm = TRUE) |
| 128 | -3x | +572 | +30x |
- USUBJID,+ date_seq <- seq(from = min_date + lubridate::days(1), to = max_date, by = "28 days") |
| 129 | -3x | +|||
| 573 | +
- STUDYID,- |
- |||
| 130 | -3x | -
- PARAM,- |
- ||
| 131 | -3x | -
- PARAMCD,+ |
||
| 132 | -3x | +574 | +30x |
- AVALU,+ visit_ids <- unique(visit_id) |
| 133 | -3x | +575 | +30x |
- PARCAT1,+ out <- sapply(visit_ids, simplify = TRUE, USE.NAMES = TRUE, FUN = function(x) {
|
| 134 | -3x | -
- PARCAT2- |
- ||
| 135 | -+ | 576 | +177x |
- ) %>%+ if (x == -1) {
|
| 136 | -3x | +577 | +30x |
- dplyr::mutate(id = dplyr::row_number()),+ random_days_to_subtract <- lubridate::days(sample(1:10, size = 1)) |
| 137 | -3x | +578 | +30x |
- adex_visit %>%+ min_date - random_days_to_subtract |
| 138 | -3x | +579 | +147x |
- dplyr::group_by(+ } else if (x == 0) {
|
| 139 | -3x | +580 | +30x |
- USUBJID,+ min_date |
| 140 | -3x | +581 | +117x |
- STUDYID,+ } else if (x > 0) {
|
| 141 | -3x | +582 | +117x |
- PARAM,+ if (x %in% seq_along(date_seq)) {
|
| 142 | -3x | +583 | +117x |
- PARAMCD,+ date_seq[[x]] |
| 143 | -3x | +|||
| 584 | +
- AVALU,+ } else {
|
|||
| 144 | -3x | +585 | +30x |
- PARCAT1,+ NA |
| 145 | -3x | +|||
| 586 | +
- PARCAT2+ } |
|||
| 146 | +587 |
- ) %>%+ } |
||
| 147 | -3x | +|||
| 588 | +
- dplyr::mutate(id = dplyr::row_number()),+ }) |
|||
| 148 | -3x | +589 | +30x |
- by = c("USUBJID", "STUDYID", "PARCAT1", "PARCAT2", "id", "PARAMCD", "PARAM", "AVALU")
+ lubridate::as_datetime(out[match(visit_id, visit_ids)]) |
| 149 | +590 |
- ) %>%- |
- ||
| 150 | -3x | -
- dplyr::select(-"id")+ } |
||
| 151 | +591 | |||
| 152 | +592 |
- # Visit numbers- |
- ||
| 153 | -3x | -
- adex <- adex %>% dplyr::mutate(AVISITN = dplyr::case_when(+ #' @describeIn h_adqlqc Prepare ADaM ADQLQC data, adding PARAMCD to SDTM QS data |
||
| 154 | -3x | +|||
| 593 | +
- AVISIT == "SCREENING" ~ -1,+ #' |
|||
| 155 | -3x | +|||
| 594 | +
- AVISIT == "BASELINE" ~ 0,+ #' @param df (`data.frame`)\cr SDTM QS dataset. |
|||
| 156 | -3x | +|||
| 595 | +
- (grepl("^WEEK", AVISIT) | grepl("^CYCLE", AVISIT)) ~ as.numeric(AVISIT) - 2,
+ #' |
|||
| 157 | -3x | +|||
| 596 | +
- TRUE ~ 999000+ #' @return `data.frame` |
|||
| 158 | +597 |
- ))+ #' @keywords internal |
||
| 159 | +598 |
-
+ prep_adqlqc <- function(df) {
|
||
| 160 | +599 |
-
+ # create PARAMCD from QSTESTCD |
||
| 161 | +600 | 3x |
- adex2 <- split(adex, adex$USUBJID) %>%+ adqlqc <- dplyr::mutate( |
|
| 162 | +601 | 3x |
- lapply(function(pinfo) {
+ df, |
|
| 163 | -30x | +602 | +3x |
- pinfo %>%+ PARAMCD = case_when( |
| 164 | -30x | +603 | +3x |
- dplyr::filter(PARAMCD == "DOSE") %>%+ QSTESTCD == "EOR0101" ~ "QS02801", |
| 165 | -30x | +604 | +3x |
- dplyr::group_by(USUBJID, PARCAT2, AVISIT) %>%+ QSTESTCD == "EOR0102" ~ "QS02802", |
| 166 | -30x | +605 | +3x |
- dplyr::mutate(changeind = dplyr::case_when(+ QSTESTCD == "EOR0103" ~ "QS02803", |
| 167 | -30x | +606 | +3x |
- AVISIT == "SCREENING" ~ 0,+ QSTESTCD == "EOR0104" ~ "QS02804", |
| 168 | -30x | +607 | +3x |
- AVISIT != "SCREENING" ~ sample(c(-1, 0, 1),+ QSTESTCD == "EOR0105" ~ "QS02805", |
| 169 | -30x | +608 | +3x |
- size = 1,+ QSTESTCD == "EOR0106" ~ "QS02806", |
| 170 | -30x | +609 | +3x |
- prob = c(0.25, 0.5, 0.25),+ QSTESTCD == "EOR0107" ~ "QS02807", |
| 171 | -30x | -
- replace = TRUE- |
- ||
| 172 | -- |
- )- |
- ||
| 173 | -+ | 610 | +3x |
- )) %>%+ QSTESTCD == "EOR0108" ~ "QS02808", |
| 174 | -30x | +611 | +3x |
- dplyr::ungroup() %>%+ QSTESTCD == "EOR0109" ~ "QS02809", |
| 175 | -30x | +612 | +3x |
- dplyr::group_by(USUBJID, PARCAT2) %>%+ QSTESTCD == "EOR0110" ~ "QS02810", |
| 176 | -30x | +613 | +3x |
- dplyr::mutate(+ QSTESTCD == "EOR0111" ~ "QS02811", |
| 177 | -30x | +614 | +3x |
- csum = cumsum(changeind),+ QSTESTCD == "EOR0112" ~ "QS02812", |
| 178 | -30x | +615 | +3x |
- changeind = dplyr::case_when(+ QSTESTCD == "EOR0113" ~ "QS02813", |
| 179 | -30x | +616 | +3x |
- csum <= -3 ~ sample(c(0, 1), size = 1, prob = c(0.5, 0.5)),+ QSTESTCD == "EOR0114" ~ "QS02814", |
| 180 | -30x | +617 | +3x |
- csum >= 3 ~ sample(c(0, -1), size = 1, prob = c(0.5, 0.5)),+ QSTESTCD == "EOR0115" ~ "QS02815", |
| 181 | -30x | -
- TRUE ~ changeind- |
- ||
| 182 | -+ | 618 | +3x |
- )+ QSTESTCD == "EOR0116" ~ "QS02816", |
| 183 | -+ | |||
| 619 | +3x |
- ) %>%+ QSTESTCD == "EOR0117" ~ "QS02817", |
||
| 184 | -30x | +620 | +3x |
- dplyr::mutate(csum = cumsum(changeind)) %>%+ QSTESTCD == "EOR0118" ~ "QS02818", |
| 185 | -30x | +621 | +3x |
- dplyr::ungroup() %>%+ QSTESTCD == "EOR0119" ~ "QS02819", |
| 186 | -30x | +622 | +3x |
- dplyr::group_by(USUBJID, PARCAT2, AVISIT) %>%+ QSTESTCD == "EOR0120" ~ "QS02820", |
| 187 | -30x | +623 | +3x |
- dplyr::mutate(AVAL = dplyr::case_when(+ QSTESTCD == "EOR0121" ~ "QS02821", |
| 188 | -30x | +624 | +3x |
- csum == -2 ~ 480,+ QSTESTCD == "EOR0122" ~ "QS02822", |
| 189 | -30x | +625 | +3x |
- csum == -1 ~ 720,+ QSTESTCD == "EOR0123" ~ "QS02823", |
| 190 | -30x | +626 | +3x |
- csum == 0 ~ 960,+ QSTESTCD == "EOR0124" ~ "QS02824", |
| 191 | -30x | +627 | +3x |
- csum == 1 ~ 1200,+ QSTESTCD == "EOR0125" ~ "QS02825", |
| 192 | -30x | +628 | +3x |
- csum == 2 ~ 1440+ QSTESTCD == "EOR0126" ~ "QS02826", |
| 193 | -+ | |||
| 629 | +3x |
- )) %>%+ QSTESTCD == "EOR0127" ~ "QS02827", |
||
| 194 | -30x | +630 | +3x |
- dplyr::select(-c("csum", "changeind")) %>%
+ QSTESTCD == "EOR0128" ~ "QS02828", |
| 195 | -30x | +631 | +3x |
- dplyr::ungroup()+ QSTESTCD == "EOR0129" ~ "QS02829", |
| 196 | -+ | |||
| 632 | +3x |
- }) %>%+ QSTESTCD == "EOR0130" ~ "QS02830", |
||
| 197 | +633 | 3x |
- Reduce(rbind, .)+ TRUE ~ QSTESTCD |
|
| 198 | +634 |
-
+ ) |
||
| 199 | -3x | +|||
| 635 | +
- adex_tmp <- dplyr::full_join(adex2, adex, by = names(adex))+ ) |
|||
| 200 | +636 | 3x |
- adex <- adex_tmp %>%+ load(system.file("sysdata.rda", package = "random.cdisc.data"))
|
|
| 201 | +637 | 3x |
- dplyr::group_by(USUBJID) %>%+ adqlqc1 <- dplyr::left_join( |
|
| 202 | +638 | 3x |
- dplyr::mutate(AVAL = ifelse(PARAMCD == "NDOSE", 1, AVAL)) %>%+ adqlqc, |
|
| 203 | +639 | 3x |
- dplyr::mutate(AVAL = ifelse(+ gdsr_param_adqlqc, |
|
| 204 | +640 | 3x |
- PARAMCD == "TNDOSE",+ by = "PARAMCD" |
|
| 205 | -3x | +|||
| 641 | +
- sum(AVAL[PARAMCD == "NDOSE"]),+ ) |
|||
| 206 | +642 | 3x |
- AVAL+ return(adqlqc1) |
|
| 207 | +643 |
- )) %>%+ } |
||
| 208 | -3x | +|||
| 644 | +
- dplyr::ungroup() %>%+ |
|||
| 209 | -3x | +|||
| 645 | +
- dplyr::group_by(USUBJID, STUDYID, PARCAT2) %>%+ #' @describeIn h_adqlqc Scale calculation for ADQLQC data |
|||
| 210 | -3x | +|||
| 646 | +
- dplyr::mutate(AVAL = ifelse(+ #' |
|||
| 211 | -3x | +|||
| 647 | +
- PARAMCD == "TDOSE",+ #' @param adqlqc1 (`data.frame`)\cr Prepared data generated from the [prep_adqlqc()] function. |
|||
| 212 | -3x | +|||
| 648 | +
- sum(AVAL[PARAMCD == "DOSE"]),+ #' |
|||
| 213 | -3x | +|||
| 649 | +
- AVAL+ #' @return `data.frame` |
|||
| 214 | +650 |
- ))+ #' @keywords internal |
||
| 215 | +651 | - - | -||
| 216 | -3x | -
- adex <- var_relabel(- |
- ||
| 217 | -3x | -
- adex,- |
- ||
| 218 | -3x | -
- STUDYID = "Study Identifier",- |
- ||
| 219 | -3x | -
- USUBJID = "Unique Subject Identifier"+ calc_scales <- function(adqlqc1) {
|
||
| 220 | +652 |
- )+ # Prep scale data --------------------------------------------------------- |
||
| 221 | +653 |
-
+ # parcat2 = scales or global health status |
||
| 222 | +654 |
- # merge ADSL to be able to add ADEX date and study day variables+ # global health status/scales data |
||
| 223 | -3x | +|||
| 655 | +
- adex <- dplyr::inner_join(adex, adsl, by = c("STUDYID", "USUBJID")) %>%
+ # QSTESTCD: EOR0131 to EOR0145 (global health status and scales) |
|||
| 224 | +656 | 3x |
- dplyr::rowwise() %>%+ load(system.file("sysdata.rda", package = "random.cdisc.data"))
|
|
| 225 | +657 | 3x |
- dplyr::mutate(TRTENDT = lubridate::date(dplyr::case_when(+ eortc_qlq_c30_sub <- filter( |
|
| 226 | +658 | 3x |
- is.na(TRTEDTM) ~ lubridate::floor_date(lubridate::date(TRTSDTM) + study_duration_secs, unit = "day"),+ eortc_qlq_c30, |
|
| 227 | +659 | 3x |
- TRUE ~ TRTEDTM+ !(as.numeric(str_extract(QSTESTCD, "\\d+$")) >= 101 & as.numeric(str_extract(QSTESTCD, "\\d+$")) <= 130) |
|
| 228 | +660 |
- ))) %>%+ ) %>% |
||
| 229 | +661 | 3x |
- dplyr::mutate(ASTDTM = sample(+ mutate( |
|
| 230 | +662 | 3x |
- seq(lubridate::as_datetime(TRTSDTM), lubridate::as_datetime(TRTENDT), by = "day"),+ PARAMCD = case_when( |
|
| 231 | +663 | 3x |
- size = 1+ QSTESTCD == "EOR0131" ~ "QS028QL2", |
|
| 232 | -+ | |||
| 664 | +3x |
- )) %>%+ QSTESTCD == "EOR0132" ~ "QS028PF2", |
||
| 233 | -+ | |||
| 665 | +3x |
- # add 1 to end of range incase both values passed to sample() are the same+ QSTESTCD == "EOR0133" ~ "QS028RF2", |
||
| 234 | +666 | 3x |
- dplyr::mutate(AENDTM = sample(+ QSTESTCD == "EOR0134" ~ "QS028EF", |
|
| 235 | +667 | 3x |
- seq(lubridate::as_datetime(ASTDTM), lubridate::as_datetime(TRTENDT + 1), by = "day"),+ QSTESTCD == "EOR0135" ~ "QS028CF", |
|
| 236 | +668 | 3x |
- size = 1+ QSTESTCD == "EOR0136" ~ "QS028SF", |
|
| 237 | -+ | |||
| 669 | +3x |
- )) %>%+ QSTESTCD == "EOR0137" ~ "QS028FA", |
||
| 238 | +670 | 3x |
- dplyr::select(-TRTENDT) %>%+ QSTESTCD == "EOR0138" ~ "QS028NV", |
|
| 239 | +671 | 3x |
- dplyr::ungroup() %>%+ QSTESTCD == "EOR0139" ~ "QS028PA", |
|
| 240 | +672 | 3x |
- dplyr::arrange(STUDYID, USUBJID, ASTDTM)+ QSTESTCD == "EOR0140" ~ "QS028DY", |
|
| 241 | -+ | |||
| 673 | +3x |
-
+ QSTESTCD == "EOR0141" ~ "QS028SL", |
||
| 242 | -+ | |||
| 674 | +3x |
-
+ QSTESTCD == "EOR0142" ~ "QS028AP", |
||
| 243 | +675 | 3x |
- adex <- adex %>%+ QSTESTCD == "EOR0143" ~ "QS028CO", |
|
| 244 | +676 | 3x |
- dplyr::group_by(USUBJID) %>%+ QSTESTCD == "EOR0144" ~ "QS028DI", |
|
| 245 | +677 | 3x |
- dplyr::mutate(EXSEQ = seq_len(dplyr::n())) %>%+ QSTESTCD == "EOR0145" ~ "QS028FI", |
|
| 246 | +678 | 3x |
- dplyr::mutate(ASEQ = EXSEQ) %>%+ TRUE ~ QSTESTCD |
|
| 247 | -3x | +|||
| 679 | +
- dplyr::ungroup() %>%+ ) |
|||
| 248 | -3x | +|||
| 680 | +
- dplyr::arrange(+ ) %>% |
|||
| 249 | +681 | 3x |
- STUDYID,+ select(-publication_name) |
|
| 250 | -3x | +|||
| 682 | +
- USUBJID,+ |
|||
| 251 | -3x | +|||
| 683 | +
- PARAMCD,+ # ADaM global health status and scales from gdsr |
|||
| 252 | +684 | 3x |
- ASTDTM,+ gdsr_param_adqlqc <- gdsr_param_adqlqc %>% |
|
| 253 | +685 | 3x |
- AVISITN,+ filter( |
|
| 254 | +686 | 3x |
- EXSEQ+ !str_detect(PARCAT2, "Original Items|Completion") |
|
| 255 | +687 |
) |
||
| 256 | +688 | |||
| 257 | -- |
- # Adding EXDOSFRQ- |
- ||
| 258 | +689 | 3x |
- adex <- adex %>%+ ghs_scales <- left_join( |
|
| 259 | +690 | 3x |
- dplyr::mutate(EXDOSFRQ = dplyr::case_when(+ eortc_qlq_c30_sub, |
|
| 260 | +691 | 3x |
- PARCAT1 == "INDIVIDUAL" ~ "ONCE",+ gdsr_param_adqlqc, |
|
| 261 | +692 | 3x |
- TRUE ~ ""- |
- |
| 262 | -- |
- ))+ by = "PARAMCD" |
||
| 263 | +693 |
-
+ ) |
||
| 264 | +694 |
- # Adding EXROUTE+ # scale data |
||
| 265 | +695 | 3x |
- adex <- adex %>%+ df <- data.frame(index = seq_len(nrow(ghs_scales))) |
|
| 266 | +696 | 3x |
- dplyr::mutate(EXROUTE = dplyr::case_when(+ df$previous <- list( |
|
| 267 | +697 | 3x |
- PARCAT1 == "INDIVIDUAL" ~ sample(c("INTRAVENOUS", "SUBCUTANEOUS"),
+ c("QS02826", "QS02827"),
|
|
| 268 | +698 | 3x |
- nrow(adex),+ c("QS02811"),
|
|
| 269 | +699 | 3x |
- replace = TRUE,+ c("QS02810", "QS02812", "QS02818"),
|
|
| 270 | +700 | 3x |
- prob = c(0.9, 0.1)- |
- |
| 271 | -- |
- ),+ c("QS02806", "QS02807"),
|
||
| 272 | +701 | 3x |
- TRUE ~ ""- |
- |
| 273 | -- |
- ))+ c("QS02814", "QS02815"),
|
||
| 274 | -+ | |||
| 702 | +3x |
-
+ c("QS02808"),
|
||
| 275 | -+ | |||
| 703 | +3x |
- # Fix VISIT according to AVISIT+ c("QS02817"),
|
||
| 276 | +704 | 3x |
- adex <- adex %>%+ c("QS02816"),
|
|
| 277 | +705 | 3x |
- dplyr::mutate(VISIT = AVISIT)+ c("QS02821", "QS02822", "QS02823", "QS02824"),
|
|
| 278 | -+ | |||
| 706 | +3x |
-
+ c("QS02829", "QS02830"),
|
||
| 279 | -+ | |||
| 707 | +3x |
- # Hack for VISITDY - to fix in ADSL+ c("QS02813"),
|
||
| 280 | +708 | 3x |
- visit_levels <- str_extract(levels(adex$VISIT), pattern = "[0-9]+")+ c("QS02801", "QS02802", "QS02803", "QS02804", "QS02805"),
|
|
| 281 | +709 | 3x |
- vl_extracted <- vapply(visit_levels, function(x) as.numeric(x[2]), numeric(1))+ c("QS02809", "QS02819"),
|
|
| 282 | +710 | 3x |
- vl_extracted <- c(-1, 1, vl_extracted[!is.na(vl_extracted)])+ c("QS02820", "QS02825"),
|
|
| 283 | -+ | |||
| 711 | +3x |
-
+ c("QS02828")
|
||
| 284 | +712 |
- # Adding VISITDY+ ) |
||
| 285 | +713 | 3x |
- adex <- adex %>%+ df$newName <- list( |
|
| 286 | +714 | 3x |
- dplyr::mutate(VISITDY = as.numeric(as.character(factor(VISIT, labels = vl_extracted))))- |
- |
| 287 | -- |
-
+ "QS028SF", |
||
| 288 | -+ | |||
| 715 | +3x |
- # Exposure time stamps+ "QS028SL", |
||
| 289 | +716 | 3x |
- adex <- adex %>%+ "QS028FA", |
|
| 290 | +717 | 3x |
- dplyr::mutate(+ "QS028RF2", |
|
| 291 | +718 | 3x |
- EXSTDTC = TRTSDTM + lubridate::days(VISITDY),+ "QS028NV", |
|
| 292 | +719 | 3x |
- EXENDTC = EXSTDTC + lubridate::hours(1),+ "QS028DY", |
|
| 293 | +720 | 3x |
- EXSTDY = VISITDY,+ "QS028DI", |
|
| 294 | +721 | 3x |
- EXENDY = VISITDY+ "QS028CO", |
|
| 295 | -+ | |||
| 722 | +3x |
- )+ "QS028EF", |
||
| 296 | -+ | |||
| 723 | +3x |
-
+ "QS028QL2", |
||
| 297 | -+ | |||
| 724 | +3x |
- # Correcting last exposure to treatment+ "QS028AP", |
||
| 298 | +725 | 3x |
- adex <- adex %>%+ "QS028PF2", |
|
| 299 | +726 | 3x |
- dplyr::group_by(SUBJID) %>%+ "QS028PA", |
|
| 300 | +727 | 3x |
- dplyr::mutate(TRTEDTM = lubridate::as_datetime(max(EXENDTC, na.rm = TRUE))) %>%+ "QS028CF", |
|
| 301 | +728 | 3x |
- dplyr::ungroup()+ "QS028FI" |
|
| 302 | +729 |
-
+ ) |
||
| 303 | -+ | |||
| 730 | +3x |
- # Fixing Date - to add into ADSL+ df$newNamelabel <- list( |
||
| 304 | +731 | 3x |
- adex <- adex %>%+ "EORTC QLQ-C30: Social functioning", |
|
| 305 | +732 | 3x |
- dplyr::mutate(+ "EORTC QLQ-C30: Insomnia", |
|
| 306 | +733 | 3x |
- TRTSDT = lubridate::date(TRTSDTM),+ "EORTC QLQ-C30: Fatigue", |
|
| 307 | +734 | 3x |
- TRTEDT = lubridate::date(TRTEDTM)+ "EORTC QLQ-C30: Role functioning (revised)", |
|
| 308 | -+ | |||
| 735 | +3x |
- )+ "EORTC QLQ-C30: Nausea and vomiting", |
||
| 309 | -+ | |||
| 736 | +3x |
-
+ "EORTC QLQ-C30: Dyspnoea", |
||
| 310 | -+ | |||
| 737 | +3x |
- # Fixing analysis time stamps+ "EORTC QLQ-C30: Diarrhoea", |
||
| 311 | +738 | 3x |
- adex <- adex %>%+ "EORTC QLQ-C30: Constipation", |
|
| 312 | +739 | 3x |
- dplyr::mutate(+ "EORTC QLQ-C30: Emotional functioning", |
|
| 313 | +740 | 3x |
- ASTDY = EXSTDY,+ "EORTC QLQ-C30: Global health status/QoL (revised)", |
|
| 314 | +741 | 3x |
- AENDY = EXENDY,+ "EORTC QLQ-C30: Appetite loss", |
|
| 315 | +742 | 3x |
- ASTDTM = EXSTDTC,+ "EORTC QLQ-C30: Physical functioning (revised)", |
|
| 316 | +743 | 3x |
- AENDTM = EXENDTC- |
- |
| 317 | -- |
- )- |
- ||
| 318 | -- |
-
+ "EORTC QLQ-C30: Pain", |
||
| 319 | +744 | 3x |
- if (length(na_vars) > 0 && na_percentage > 0) {
- |
- |
| 320 | -! | -
- adex <- mutate_na(ds = adex, na_vars = na_vars, na_percentage = na_percentage)- |
- ||
| 321 | -- |
- }- |
- ||
| 322 | -- | - - | -||
| 323 | -- |
- # apply metadata+ "EORTC QLQ-C30: Cognitive functioning", |
||
| 324 | +745 | 3x |
- adex <- apply_metadata(adex, "metadata/ADEX.yml")- |
- |
| 325 | -- |
- }- |
- ||
| 326 | -- |
-
+ "EORTC QLQ-C30: Financial difficulties" |
||
| 327 | +746 |
- # Equivalent of stringr::str_extract_all()+ ) |
||
| 328 | -+ | |||
| 747 | +3x |
- str_extract <- function(string, pattern) {
+ df$newNameCategory <- list( |
||
| 329 | -2850x | +748 | +3x |
- regmatches(string, gregexpr(pattern, string))+ "Functional Scales", |
| 330 | -+ | |||
| 749 | +3x |
- }+ "Symptom Scales", |
| 1 | -+ | |||
| 750 | +3x |
- #' Medical History Analysis Dataset (ADMH)+ "Symptom Scales", |
||
| 2 | -+ | |||
| 751 | +3x |
- #'+ "Functional Scales", |
||
| 3 | -+ | |||
| 752 | +3x |
- #' @description `r lifecycle::badge("stable")`
+ "Symptom Scales", |
||
| 4 | -+ | |||
| 753 | +3x |
- #'+ "Symptom Scales", |
||
| 5 | -+ | |||
| 754 | +3x |
- #' Function for generating a random Medical History Analysis Dataset for a given+ "Symptom Scales", |
||
| 6 | -+ | |||
| 755 | +3x |
- #' Subject-Level Analysis Dataset.+ "Symptom Scales", |
||
| 7 | -+ | |||
| 756 | +3x |
- #'+ "Functional Scales", |
||
| 8 | -+ | |||
| 757 | +3x |
- #' @details One record per each record in the corresponding SDTM domain.+ "Global Health Status", |
||
| 9 | -+ | |||
| 758 | +3x |
- #'+ "Symptom Scales", |
||
| 10 | -+ | |||
| 759 | +3x |
- #' Keys: `STUDYID`, `USUBJID`, `ASTDTM`, `MHSEQ`+ "Functional Scales", |
||
| 11 | -+ | |||
| 760 | +3x |
- #'+ "Symptom Scales", |
||
| 12 | -+ | |||
| 761 | +3x |
- #' @inheritParams argument_convention+ "Functional Scales", |
||
| 13 | -+ | |||
| 762 | +3x |
- #' @param max_n_mhs (`integer`)\cr Maximum number of MHs per patient. Defaults to 10.+ "Symptom Scales" |
||
| 14 | +763 |
- #' @template param_cached+ ) |
||
| 15 | -+ | |||
| 764 | +3x |
- #' @templateVar data admh+ df$num_param <- list( |
||
| 16 | -+ | |||
| 765 | +3x |
- #'+ "1", |
||
| 17 | -+ | |||
| 766 | +3x |
- #' @return `data.frame`+ "1", |
||
| 18 | -+ | |||
| 767 | +3x |
- #' @export+ "2", |
||
| 19 | -+ | |||
| 768 | +3x |
- #'+ "1", |
||
| 20 | -+ | |||
| 769 | +3x |
- #' @examples+ "1", |
||
| 21 | -+ | |||
| 770 | +3x |
- #' adsl <- radsl(N = 10, study_duration = 2, seed = 1)+ "1", |
||
| 22 | -+ | |||
| 771 | +3x |
- #'+ "1", |
||
| 23 | -+ | |||
| 772 | +3x |
- #' admh <- radmh(adsl, seed = 2)+ "1", |
||
| 24 | -+ | |||
| 773 | +3x |
- #' admh+ "2", |
||
| 25 | -+ | |||
| 774 | +3x |
- radmh <- function(adsl,+ "1", |
||
| 26 | -+ | |||
| 775 | +3x |
- max_n_mhs = 10L,+ "1", |
||
| 27 | -+ | |||
| 776 | +3x |
- lookup = NULL,+ "3", |
||
| 28 | -+ | |||
| 777 | +3x |
- seed = NULL,+ "1", |
||
| 29 | -+ | |||
| 778 | +3x |
- na_percentage = 0,+ "1", |
||
| 30 | -+ | |||
| 779 | +3x |
- na_vars = list(MHBODSYS = c(NA, 0.1), MHDECOD = c(1234, 0.1)),+ "1" |
||
| 31 | +780 |
- cached = FALSE) {
+ ) |
||
| 32 | -4x | +781 | +3x |
- checkmate::assert_flag(cached)+ df$equation <- list( |
| 33 | -4x | +782 | +3x |
- if (cached) {
+ "new_value = (1 - ((temp_val/var_length)-1)/3)*100.0", |
| 34 | -1x | +783 | +3x |
- return(get_cached_data("cadmh"))
+ "new_value = ((temp_val/var_length-1)/3)*100.0", |
| 35 | -+ | |||
| 784 | +3x |
- }+ "new_value = ((temp_val/var_length-1)/3)*100.0", |
||
| 36 | -+ | |||
| 785 | +3x |
-
+ "new_value = (1 - ((temp_val/var_length)-1)/3)*100.0", |
||
| 37 | +786 | 3x |
- checkmate::assert_data_frame(adsl)+ "new_value = ((temp_val/var_length-1)/3)*100.0", |
|
| 38 | +787 | 3x |
- checkmate::assert_integer(max_n_mhs, len = 1, any.missing = FALSE)+ "new_value = ((temp_val/var_length-1)/3)*100.0", |
|
| 39 | +788 | 3x |
- checkmate::assert_number(seed, null.ok = TRUE)+ "new_value = ((temp_val/var_length-1)/3)*100.0", |
|
| 40 | +789 | 3x |
- checkmate::assert_number(na_percentage, lower = 0, upper = 1)+ "new_value = ((temp_val/var_length-1)/3)*100.0", |
|
| 41 | +790 | 3x |
- checkmate::assert_true(na_percentage < 1)+ "new_value = (1 - ((temp_val/var_length)-1)/3)*100.0", |
|
| 42 | -+ | |||
| 791 | +3x |
-
+ "new_value = ((temp_val/var_length-1)/6)*100.0", |
||
| 43 | +792 | 3x |
- checkmate::assert_data_frame(lookup, null.ok = TRUE)+ "new_value = ((temp_val/var_length-1)/3)*100.0", |
|
| 44 | +793 | 3x |
- lookup_mh <- if (!is.null(lookup)) {
+ "new_value = (1 - ((temp_val/var_length)-1)/3)*100.0", |
|
| 45 | -! | +|||
| 794 | +3x |
- lookup+ "new_value = ((temp_val/var_length-1)/3)*100.0", |
||
| 46 | -+ | |||
| 795 | +3x |
- } else {
+ "new_value = (1 - ((temp_val/var_length)-1)/3)*100.0", |
||
| 47 | +796 | 3x |
- tibble::tribble(+ "new_value = ((temp_val/var_length-1)/3)*100.0" |
|
| 48 | -3x | +|||
| 797 | +
- ~MHBODSYS, ~MHDECOD, ~MHSOC,+ ) |
|||
| 49 | -3x | +|||
| 798 | +
- "cl A", "trm A_1/2", "cl A",+ |
|||
| 50 | +799 | 3x |
- "cl A", "trm A_2/2", "cl A",+ expect_data <- data.frame( |
|
| 51 | +800 | 3x |
- "cl B", "trm B_1/3", "cl B",+ PARAM = expect$PARAM, |
|
| 52 | +801 | 3x |
- "cl B", "trm B_2/3", "cl B",+ PARAMCD = expect$PARAMCD, |
|
| 53 | +802 | 3x |
- "cl B", "trm B_3/3", "cl B",+ PARCAT2 = expect$PARCAT2, |
|
| 54 | +803 | 3x |
- "cl C", "trm C_1/2", "cl C",+ PARCAT1N = expect$PARCAT1N, |
|
| 55 | +804 | 3x |
- "cl C", "trm C_2/2", "cl C",+ AVAL = c(0, 1), |
|
| 56 | +805 | 3x |
- "cl D", "trm D_1/3", "cl D",+ AVALC = c( |
|
| 57 | +806 | 3x |
- "cl D", "trm D_2/3", "cl D",+ "Not expected to complete questionnaire", |
|
| 58 | +807 | 3x |
- "cl D", "trm D_3/3", "cl D"+ "Expected to complete questionnaire" |
|
| 59 | +808 |
) |
||
| 60 | +809 |
- }+ ) |
||
| 61 | +810 | |||
| 62 | -3x | -
- if (!is.null(seed)) {
- |
- ||
| 63 | +811 | 3x |
- set.seed(seed)+ df_saved <- data.frame() |
|
| 64 | +812 |
- }+ |
||
| 65 | +813 | 3x |
- study_duration_secs <- lubridate::seconds(attr(adsl, "study_duration_secs"))+ unique_id <- unique(adqlqc1$USUBJID) |
|
| 66 | +814 | |||
| 67 | +815 | 3x |
- admh <- Map(+ for (id in unique_id) {
|
|
| 68 | -3x | +816 | +30x |
- function(id, sid) {
+ id_data <- adqlqc1[adqlqc1$USUBJID == id, ] |
| 69 | +817 | 30x |
- n_mhs <- sample(0:max_n_mhs, 1)+ unique_avisit <- unique(id_data$AVISIT) |
|
| 70 | +818 | 30x |
- i <- sample(seq_len(nrow(lookup_mh)), n_mhs, TRUE)+ for (visit in unique_avisit) {
|
|
| 71 | -30x | +819 | +180x |
- dplyr::mutate(+ if (is.na(visit)) {
|
| 72 | -30x | +|||
| 820 | +! |
- lookup_mh[i, ],+ next |
||
| 73 | -30x | +|||
| 821 | +
- USUBJID = id,+ } |
|||
| 74 | -30x | +822 | +180x |
- STUDYID = sid+ id_data_at_visit <- id_data[id_data$AVISIT == visit, ] |
| 75 | +823 |
- )+ |
||
| 76 | -+ | |||
| 824 | +180x |
- },+ if (any(id_data_at_visit$PARAMCD != "QSALL")) {
|
||
| 77 | -3x | +825 | +177x |
- adsl$USUBJID,+ for (idx in seq_along(df$index)) {
|
| 78 | -3x | +826 | +2655x |
- adsl$STUDYID+ previous_names <- df$previous[idx] |
| 79 | -+ | |||
| 827 | +2655x |
- ) %>%+ current_name <- df$newName[idx] |
||
| 80 | -3x | +828 | +2655x |
- Reduce(rbind, .) %>%+ current_name_label <- df$newNamelabel[idx] |
| 81 | -3x | +829 | +2655x |
- `[`(c(4, 5, 1, 2, 3)) %>%+ current_name_category <- df$newNameCategory[idx] |
| 82 | -3x | +830 | +2655x |
- dplyr::mutate(MHTERM = MHDECOD)+ eqn <- df$equation[idx] |
| 83 | -+ | |||
| 831 | +2655x |
-
+ temp_val <- 0 |
||
| 84 | -3x | +832 | +2655x |
- admh <- var_relabel(+ var_length <- 0 |
| 85 | -3x | +833 | +2655x |
- admh,+ for (param_name in previous_names[[1]]) {
|
| 86 | -3x | +834 | +5310x |
- STUDYID = "Study Identifier",+ if (param_name %in% id_data_at_visit$PARAMCD) { ####
|
| 87 | -3x | +835 | +5310x |
- USUBJID = "Unique Subject Identifier"+ current_val <- as.numeric(as.character(id_data_at_visit$AVAL[id_data_at_visit$PARAMCD == param_name])) |
| 88 | -+ | |||
| 836 | +5310x |
- )+ if (!is.na(current_val)) {
+ |
+ ||
| 837 | +5094x | +
+ temp_val <- temp_val + current_val ###+ |
+ ||
| 838 | +5094x | +
+ var_length <- var_length + 1 |
||
| 89 | +839 |
-
+ } |
||
| 90 | +840 |
- # merge ADSL to be able to add MH date and study day variables+ } # if |
||
| 91 | -3x | +|||
| 841 | +
- admh <- dplyr::inner_join(+ } # param_name |
|||
| 92 | -3x | +|||
| 842 | +
- admh,+ # eval |
|||
| 93 | -3x | +843 | +2655x |
- adsl,+ if (var_length >= as.numeric(df$num_param[idx])) {
|
| 94 | -3x | +844 | +2604x |
- by = c("STUDYID", "USUBJID")
+ eval(parse(text = eqn)) ##### |
| 95 | +845 |
- ) %>%+ } else {
|
||
| 96 | -3x | +846 | +51x |
- dplyr::rowwise() %>%+ new_value <- NA |
| 97 | -3x | +|||
| 847 | +
- dplyr::mutate(TRTENDT = lubridate::date(dplyr::case_when(+ }+ |
+ |||
| 848 | ++ | + | ||
| 98 | -3x | +849 | +2655x |
- is.na(TRTEDTM) ~ lubridate::floor_date(lubridate::date(TRTSDTM) + study_duration_secs, unit = "day"),+ new_data_row <- data.frame( |
| 99 | -3x | +850 | +2655x |
- TRUE ~ TRTEDTM+ study = str_extract(id, "[A-Z]+[0-9]+"), |
| 100 | -+ | |||
| 851 | +2655x |
- ))) %>%+ id, |
||
| 101 | -3x | +852 | +2655x |
- dplyr::mutate(ASTDTM = sample(+ visit, |
| 102 | -3x | +853 | +2655x |
- seq(lubridate::as_datetime(TRTSDTM), lubridate::as_datetime(TRTENDT), by = "day"),+ id_data_at_visit$AVISITN[1], |
| 103 | -3x | +854 | +2655x |
- size = 1+ id_data_at_visit$QSDTC[1], |
| 104 | -+ | |||
| 855 | +2655x |
- )) %>%+ current_name_category, |
||
| 105 | -3x | +856 | +2655x |
- dplyr::mutate(ASTDY = ceiling(difftime(ASTDTM, TRTSDTM, units = "days"))) %>%+ current_name_label, |
| 106 | -+ | |||
| 857 | +2655x |
- # add 1 to end of range incase both values passed to sample() are the same+ current_name, |
||
| 107 | -3x | +858 | +2655x |
- dplyr::mutate(AENDTM = sample(+ new_value, |
| 108 | -3x | +859 | +2655x |
- seq(lubridate::as_datetime(ASTDTM), lubridate::as_datetime(TRTENDT + 1), by = "day"),+ NA, |
| 109 | -3x | +860 | +2655x |
- size = 1+ stringsAsFactors = FALSE |
| 110 | +861 |
- )) %>%+ ) |
||
| 111 | -3x | +862 | +2655x |
- dplyr::mutate(AENDY = ceiling(difftime(AENDTM, TRTSDTM, units = "days"))) %>%+ colnames(new_data_row) <- c( |
| 112 | -3x | +863 | +2655x |
- select(-TRTENDT) %>%+ "STUDYID", "USUBJID", "AVISIT", "AVISITN", |
| 113 | -3x | +864 | +2655x |
- dplyr::ungroup() %>%+ "ADTM", "PARCAT2", "PARAM", "PARAMCD", |
| 114 | -3x | +865 | +2655x |
- dplyr::arrange(STUDYID, USUBJID, ASTDTM, MHTERM) %>%+ "AVAL", "AVALC" |
| 115 | -3x | +|||
| 866 | +
- dplyr::mutate(MHDISTAT = sample(+ ) ### |
|||
| 116 | -3x | +867 | +2655x |
- x = c("Resolved", "Ongoing with treatment", "Ongoing without treatment"),
+ df_saved <- rbind(df_saved, new_data_row) ##### |
| 117 | -3x | +|||
| 868 | +
- prob = c(0.6, 0.2, 0.2),+ } # idx+ |
+ |||
| 869 | ++ |
+ }+ |
+ ||
| 870 | ++ |
+ # add expect data |
||
| 118 | -3x | +871 | +180x |
- size = dplyr::n(),+ expect_value <- sample(expect_data$AVAL, 1, prob = c(0.10, 0.90)) |
| 119 | -3x | +872 | +180x |
- replace = TRUE+ expect_valuec <- expect_data$AVALC[expect_data$AVAL == expect_value] |
| 120 | +873 |
- )) %>%+ |
||
| 121 | -3x | +874 | +180x |
- dplyr::mutate(ATIREL = dplyr::case_when(+ new_data_row <- data.frame( |
| 122 | -3x | +875 | +180x |
- (AENDTM < TRTSDTM | (is.na(AENDTM) & MHDISTAT == "Resolved")) ~ "PRIOR",+ study = str_extract(id, "[A-Z]+[0-9]+"), |
| 123 | -3x | +876 | +180x |
- (AENDTM >= TRTSDTM | (is.na(AENDTM) & grepl("Ongoing", MHDISTAT))) ~ "PRIOR_CONCOMITANT"
+ id, |
| 124 | -+ | |||
| 877 | +180x |
- ))+ visit, |
||
| 125 | -+ | |||
| 878 | +180x |
-
+ id_data_at_visit$AVISITN[1], |
||
| 126 | -3x | +879 | +180x |
- admh <- admh %>%+ datetime = NA, |
| 127 | -3x | +880 | +180x |
- dplyr::group_by(USUBJID) %>%+ expect_data$PARCAT2[1], |
| 128 | -3x | +881 | +180x |
- dplyr::mutate(MHSEQ = seq_len(dplyr::n())) %>%+ expect_data$PARAM[1], |
| 129 | -3x | +882 | +180x |
- dplyr::mutate(ASEQ = MHSEQ) %>%+ expect_data$PARAMCD[1], |
| 130 | -3x | +883 | +180x |
- dplyr::ungroup() %>%+ expect_value, |
| 131 | -3x | +884 | +180x |
- dplyr::arrange(STUDYID, USUBJID, ASTDTM, MHSEQ)+ expect_valuec,+ |
+
| 885 | +180x | +
+ stringsAsFactors = FALSE |
||
| 132 | +886 |
-
+ ) |
||
| 133 | -3x | +887 | +180x |
- if (length(na_vars) > 0 && na_percentage > 0 && na_percentage <= 1) {
+ colnames(new_data_row) <- c( |
| 134 | -! | +|||
| 888 | +180x |
- admh <- mutate_na(ds = admh, na_vars = na_vars, na_percentage = na_percentage)+ "STUDYID", "USUBJID", "AVISIT", "AVISITN", |
||
| 135 | -+ | |||
| 889 | +180x |
- }+ "ADTM", "PARCAT2", "PARAM", "PARAMCD", "AVAL", |
||
| 136 | -+ | |||
| 890 | +180x |
-
+ "AVALC" |
||
| 137 | +891 |
- # apply metadata+ ) ### |
||
| 138 | -3x | +892 | +180x |
- admh <- apply_metadata(admh, "metadata/ADMH.yml")+ df_saved <- rbind(df_saved, new_data_row) |
| 139 | +893 |
-
+ } # visit |
||
| 140 | -3x | +|||
| 894 | +
- return(admh)+ } # id |
|||
| 141 | +895 |
- }+ |
| 1 | -+ | |||
| 896 | +3x |
- #' Adverse Event Analysis Dataset (ADAE)+ df_saved1 <- left_join( |
||
| 2 | -+ | |||
| 897 | +3x |
- #'+ df_saved, |
||
| 3 | -+ | |||
| 898 | +3x |
- #' @description `r lifecycle::badge("stable")`
+ ghs_scales, |
||
| 4 | -+ | |||
| 899 | +3x |
- #'+ by = c( |
||
| 5 | -+ | |||
| 900 | +3x |
- #' Function for generating random Adverse Event Analysis Dataset for a given+ "PARAM", |
||
| 6 | -+ | |||
| 901 | +3x |
- #' Subject-Level Analysis Dataset.+ "PARAMCD", |
||
| 7 | -+ | |||
| 902 | +3x |
- #'+ "PARCAT2" |
||
| 8 | +903 |
- #' @details One record per each record in the corresponding SDTM domain.+ ) |
||
| 9 | +904 |
- #'+ ) %>% |
||
| 10 | -+ | |||
| 905 | +3x |
- #' Keys: `STUDYID`, `USUBJID`, `ASTDTM`, `AETERM`, `AESEQ`+ mutate( |
||
| 11 | -+ | |||
| 906 | +3x |
- #'+ AVALC = ifelse(is.na(AVALC), as.character(AVAL), AVALC), |
||
| 12 | -+ | |||
| 907 | +3x |
- #' @inheritParams argument_convention+ PARCAT1 = ifelse(PARAMCD == "EX028", expect$PARCAT1, PARCAT1), |
||
| 13 | -+ | |||
| 908 | +3x |
- #' @param max_n_aes (`integer`)\cr Maximum number of AEs per patient. Defaults to 10.+ PARCAT1N = ifelse(PARAMCD == "EX028", expect$PARCAT1N, PARCAT1N) |
||
| 14 | +909 |
- #' @template param_cached+ ) |
||
| 15 | +910 |
- #' @templateVar data adae+ |
||
| 16 | -+ | |||
| 911 | +3x |
- #'+ adqlqc_tmp <- bind_rows(adqlqc1, df_saved1) %>% |
||
| 17 | -+ | |||
| 912 | +3x |
- #' @return `data.frame`+ arrange( |
||
| 18 | -+ | |||
| 913 | +3x |
- #' @export+ USUBJID, |
||
| 19 | -+ | |||
| 914 | +3x |
- #'+ AVISITN, |
||
| 20 | -+ | |||
| 915 | +3x |
- #' @examples+ QSTESTCD |
||
| 21 | +916 |
- #' adsl <- radsl(N = 10, study_duration = 2, seed = 1)+ )+ |
+ ||
| 917 | +3x | +
+ return(adqlqc_tmp) |
||
| 22 | +918 |
- #'+ } |
||
| 23 | +919 |
- #' adae <- radae(adsl, seed = 2)+ |
||
| 24 | +920 |
- #' adae+ #' @describeIn h_adqlqc Calculate Change from Baseline Category 1 |
||
| 25 | +921 |
#' |
||
| 26 | +922 |
- #' # Add metadata.+ #' @param dataset (`data.frame`)\cr ADaM dataset. |
||
| 27 | +923 |
- #' aag <- utils::read.table(+ #' |
||
| 28 | +924 |
- #' sep = ",", header = TRUE,+ #' @return `data.frame` |
||
| 29 | +925 |
- #' text = paste(+ #' @keywords internal |
||
| 30 | +926 |
- #' "NAMVAR,SRCVAR,GRPTYPE,REFNAME,REFTERM,SCOPE",+ derv_chgcat1 <- function(dataset) {
|
||
| 31 | +927 |
- #' "CQ01NAM,AEDECOD,CUSTOM,D.2.1.5.3/A.1.1.1.1 AESI,dcd D.2.1.5.3,",+ # derivation of CHGCAT1 |
||
| 32 | -+ | |||
| 928 | +3x |
- #' "CQ01NAM,AEDECOD,CUSTOM,D.2.1.5.3/A.1.1.1.1 AESI,dcd A.1.1.1.1,",+ check_vars <- c("PARCAT2", "CHG")
|
||
| 33 | +929 |
- #' "SMQ01NAM,AEDECOD,SMQ,C.1.1.1.3/B.2.2.3.1 AESI,dcd C.1.1.1.3,BROAD",+ |
||
| 34 | -+ | |||
| 930 | +3x |
- #' "SMQ01NAM,AEDECOD,SMQ,C.1.1.1.3/B.2.2.3.1 AESI,dcd B.2.2.3.1,BROAD",+ if (all(check_vars %in% names(dataset))) {
|
||
| 35 | -+ | |||
| 931 | +3x |
- #' "SMQ02NAM,AEDECOD,SMQ,Y.9.9.9.9/Z.9.9.9.9 AESI,dcd Y.9.9.9.9,NARROW",+ dataset$CHGCAT1 <- ifelse( |
||
| 36 | -+ | |||
| 932 | +3x |
- #' "SMQ02NAM,AEDECOD,SMQ,Y.9.9.9.9/Z.9.9.9.9 AESI,dcd Z.9.9.9.9,NARROW",+ dataset$PARCAT2 == "Symptom Scales" & !is.na(dataset$CHG) & dataset$CHG <= -10, |
||
| 37 | -+ | |||
| 933 | +3x |
- #' sep = "\n"+ "Improved", "" |
||
| 38 | +934 |
- #' ), stringsAsFactors = FALSE+ ) |
||
| 39 | -+ | |||
| 935 | +3x |
- #' )+ dataset$CHGCAT1 <- ifelse( |
||
| 40 | -+ | |||
| 936 | +3x |
- #'+ dataset$PARCAT2 == "Symptom Scales" & !is.na(dataset$CHG) & dataset$CHG >= 10, |
||
| 41 | -+ | |||
| 937 | +3x |
- #' adae <- radae(adsl, lookup_aag = aag)+ "Worsened", dataset$CHGCAT1 |
||
| 42 | +938 |
- #'+ ) |
||
| 43 | -+ | |||
| 939 | +3x |
- #' with(+ dataset$CHGCAT1 <- ifelse( |
||
| 44 | -+ | |||
| 940 | +3x |
- #' adae,+ dataset$PARCAT2 == "Symptom Scales" & |
||
| 45 | -+ | |||
| 941 | +3x |
- #' cbind(+ !is.na(dataset$CHG) & dataset$CHG > -10 & |
||
| 46 | -+ | |||
| 942 | +3x |
- #' table(AEDECOD, SMQ01NAM),+ dataset$CHG < 10, |
||
| 47 | -+ | |||
| 943 | +3x |
- #' table(AEDECOD, CQ01NAM)+ "No change", dataset$CHGCAT1 |
||
| 48 | +944 |
- #' )+ ) |
||
| 49 | +945 |
- #' )+ |
||
| 50 | -+ | |||
| 946 | +3x |
- radae <- function(adsl,+ dataset$CHGCAT1 <- ifelse( |
||
| 51 | -+ | |||
| 947 | +3x |
- max_n_aes = 10L,+ dataset$PARCAT2 %in% c("Functional Scales", "Global Health Status") &
|
||
| 52 | -+ | |||
| 948 | +3x |
- lookup = NULL,+ !is.na(dataset$CHG) & dataset$CHG >= 10, |
||
| 53 | -+ | |||
| 949 | +3x |
- lookup_aag = NULL,+ "Improved", dataset$CHGCAT1 |
||
| 54 | +950 |
- seed = NULL,+ ) |
||
| 55 | -+ | |||
| 951 | +3x |
- na_percentage = 0,+ dataset$CHGCAT1 <- ifelse( |
||
| 56 | -+ | |||
| 952 | +3x |
- na_vars = list(+ dataset$PARCAT2 %in% c("Functional Scales", "Global Health Status") &
|
||
| 57 | -+ | |||
| 953 | +3x |
- AEBODSYS = c(NA, 0.1),+ !is.na(dataset$CHG) & dataset$CHG <= -10, |
||
| 58 | -+ | |||
| 954 | +3x |
- AEDECOD = c(1234, 0.1),+ "Worsened", dataset$CHGCAT1 |
||
| 59 | +955 |
- AETOXGR = c(1234, 0.1)+ ) |
||
| 60 | -+ | |||
| 956 | +3x |
- ),+ dataset$CHGCAT1 <- ifelse( |
||
| 61 | -+ | |||
| 957 | +3x |
- cached = FALSE) {
+ dataset$PARCAT2 %in% c("Functional Scales", "Global Health Status") &
|
||
| 62 | -4x | +958 | +3x |
- checkmate::assert_flag(cached)+ !is.na(dataset$CHG) & |
| 63 | -4x | +959 | +3x |
- if (cached) {
+ dataset$CHG > -10 & dataset$CHG < 10, |
| 64 | -1x | +960 | +3x |
- return(get_cached_data("cadae"))
+ "No change", dataset$CHGCAT1 |
| 65 | +961 |
- }+ ) |
||
| 66 | +962 | |||
| 67 | +963 | 3x |
- checkmate::assert_data_frame(adsl)+ dataset$CHGCAT1 <- ifelse( |
|
| 68 | +964 | 3x |
- checkmate::assert_integer(max_n_aes, len = 1, any.missing = FALSE)+ dataset$PARAMCD %in% c("QS02829", "QS02830") & dataset$CHG == 6,
|
|
| 69 | +965 | 3x |
- checkmate::assert_number(seed, null.ok = TRUE)+ "Improved by six levels", dataset$CHGCAT1+ |
+ |
| 966 | ++ |
+ ) |
||
| 70 | +967 | 3x |
- checkmate::assert_number(na_percentage, lower = 0, upper = 1)+ dataset$CHGCAT1 <- ifelse( |
|
| 71 | +968 | 3x |
- checkmate::assert_true(na_percentage < 1)+ dataset$PARAMCD %in% c("QS02829", "QS02830") & dataset$CHG == 5,
|
|
| 72 | -+ | |||
| 969 | +3x |
-
+ "Improved by five levels", dataset$CHGCAT1 |
||
| 73 | +970 |
- # check lookup parameters+ ) |
||
| 74 | +971 | 3x |
- checkmate::assert_data_frame(lookup, null.ok = TRUE)+ dataset$CHGCAT1 <- ifelse( |
|
| 75 | +972 | 3x |
- lookup_ae <- if (!is.null(lookup)) {
+ dataset$PARAMCD %in% c("QS02829", "QS02830") & dataset$CHG == 4,
|
|
| 76 | -! | +|||
| 973 | +3x |
- lookup+ "Improved by four levels", dataset$CHGCAT1 |
||
| 77 | +974 |
- } else {
+ ) |
||
| 78 | +975 | 3x |
- tibble::tribble(+ dataset$CHGCAT1 <- ifelse( |
|
| 79 | +976 | 3x |
- ~AEBODSYS, ~AELLT, ~AEDECOD, ~AEHLT, ~AEHLGT, ~AETOXGR, ~AESOC, ~AESER, ~AEREL,+ dataset$PARAMCD %in% c("QS02829", "QS02830") & dataset$CHG == 3,
|
|
| 80 | +977 | 3x |
- "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",+ "Improved by three levels", dataset$CHGCAT1 |
|
| 81 | -3x | -
- "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",- |
- ||
| 82 | -3x | +|||
| 978 | +
- "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",+ ) |
|||
| 83 | +979 | 3x |
- "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",+ dataset$CHGCAT1 <- ifelse( |
|
| 84 | +980 | 3x |
- "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",+ dataset$PARAMCD %in% c("QS02829", "QS02830") & dataset$CHG == 2,
|
|
| 85 | +981 | 3x |
- "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",+ "Improved by two levels", dataset$CHGCAT1 |
|
| 86 | -3x | +|||
| 982 | +
- "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",+ ) |
|||
| 87 | +983 | 3x |
- "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",+ dataset$CHGCAT1 <- ifelse( |
|
| 88 | +984 | 3x |
- "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",+ dataset$PARAMCD %in% c("QS02829", "QS02830") & dataset$CHG == 1,
|
|
| 89 | +985 | 3x |
- "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"+ "Improved by one level", dataset$CHGCAT1 |
|
| 90 | +986 |
) |
||
| 91 | -- |
- }- |
- ||
| 92 | -- | - - | -||
| 93 | +987 | 3x |
- checkmate::assert_data_frame(lookup_aag, null.ok = TRUE)+ dataset$CHGCAT1 <- ifelse( |
|
| 94 | +988 | 3x |
- aag <- if (!is.null(lookup_aag)) {
+ dataset$PARAMCD %in% c("QS02829", "QS02830") & dataset$CHG == 0,
|
|
| 95 | -! | +|||
| 989 | +3x |
- lookup_aag+ "No change", dataset$CHGCAT1 |
||
| 96 | +990 |
- } else {
- |
- ||
| 97 | -3x | -
- aag <- utils::read.table(+ ) |
||
| 98 | +991 | 3x |
- sep = ",", header = TRUE,+ dataset$CHGCAT1 <- ifelse( |
|
| 99 | +992 | 3x |
- text = paste(+ dataset$PARAMCD %in% c("QS02829", "QS02830") & dataset$CHG == -1,
|
|
| 100 | +993 | 3x |
- "NAMVAR,SRCVAR,GRPTYPE,REFNAME,REFTERM,SCOPE",+ "Worsened by one level", dataset$CHGCAT1 |
|
| 101 | -3x | +|||
| 994 | +
- "CQ01NAM,AEDECOD,CUSTOM,D.2.1.5.3/A.1.1.1.1 AESI,dcd D.2.1.5.3,",+ ) |
|||
| 102 | +995 | 3x |
- "CQ01NAM,AEDECOD,CUSTOM,D.2.1.5.3/A.1.1.1.1 AESI,dcd A.1.1.1.1,",+ dataset$CHGCAT1 <- ifelse( |
|
| 103 | +996 | 3x |
- "SMQ01NAM,AEDECOD,SMQ,C.1.1.1.3/B.2.2.3.1 AESI,dcd C.1.1.1.3,BROAD",+ dataset$PARAMCD %in% c("QS02829", "QS02830") & dataset$CHG == -2,
|
|
| 104 | +997 | 3x |
- "SMQ01NAM,AEDECOD,SMQ,C.1.1.1.3/B.2.2.3.1 AESI,dcd B.2.2.3.1,BROAD",+ "Worsened by two levels", dataset$CHGCAT1 |
|
| 105 | -3x | +|||
| 998 | +
- "SMQ02NAM,AEDECOD,SMQ,Y.9.9.9.9/Z.9.9.9.9 AESI,dcd Y.9.9.9.9,NARROW",+ ) |
|||
| 106 | +999 | 3x |
- "SMQ02NAM,AEDECOD,SMQ,Y.9.9.9.9/Z.9.9.9.9 AESI,dcd Z.9.9.9.9,NARROW",+ dataset$CHGCAT1 <- ifelse( |
|
| 107 | +1000 | 3x |
- sep = "\n"+ dataset$PARAMCD %in% c("QS02829", "QS02830") & dataset$CHG == -3,
|
|
| 108 | +1001 | 3x |
- ), stringsAsFactors = FALSE+ "Worsened by three levels", dataset$CHGCAT1 |
|
| 109 | +1002 |
) |
||
| 110 | -- |
- }- |
- ||
| 111 | -+ | |||
| 1003 | +3x |
-
+ dataset$CHGCAT1 <- ifelse( |
||
| 112 | +1004 | 3x |
- if (!is.null(seed)) set.seed(seed)+ dataset$PARAMCD %in% c("QS02829", "QS02830") & dataset$CHG == -4,
|
|
| 113 | +1005 | 3x |
- study_duration_secs <- lubridate::seconds(attr(adsl, "study_duration_secs"))+ "Worsened by four levels", dataset$CHGCAT1 |
|
| 114 | +1006 |
-
+ ) |
||
| 115 | +1007 | 3x |
- adae <- Map(+ dataset$CHGCAT1 <- ifelse( |
|
| 116 | +1008 | 3x |
- function(id, sid) {
+ dataset$PARAMCD %in% c("QS02829", "QS02830") & dataset$CHG == -5,
|
|
| 117 | -30x | +1009 | +3x |
- n_aes <- sample(c(0, seq_len(max_n_aes)), 1)+ "Worsened by five levels", dataset$CHGCAT1 |
| 118 | -30x | +|||
| 1010 | +
- i <- sample(seq_len(nrow(lookup_ae)), n_aes, TRUE)+ ) |
|||
| 119 | -30x | +1011 | +3x |
- dplyr::mutate(+ dataset$CHGCAT1 <- ifelse( |
| 120 | -30x | +1012 | +3x |
- lookup_ae[i, ],+ dataset$PARAMCD %in% c("QS02829", "QS02830") & dataset$CHG == -6,
|
| 121 | -30x | +1013 | +3x |
- USUBJID = id,+ "Worsened by six levels", dataset$CHGCAT1 |
| 122 | -30x | +|||
| 1014 | +
- STUDYID = sid+ ) |
|||
| 123 | +1015 |
- )+ |
||
| 124 | -+ | |||
| 1016 | +3x |
- },+ dataset$CHGCAT1 <- ifelse( |
||
| 125 | +1017 | 3x |
- adsl$USUBJID,+ dataset$PARAMCD %in% c("QS02802", "QS02806") & dataset$CHG == -3,
|
|
| 126 | +1018 | 3x |
- adsl$STUDYID+ "Improved by three levels", dataset$CHGCAT1 |
|
| 127 | +1019 |
- ) %>%+ ) |
||
| 128 | +1020 | 3x |
- Reduce(rbind, .) %>%+ dataset$CHGCAT1 <- ifelse( |
|
| 129 | +1021 | 3x |
- `[`(c(10, 11, 1, 2, 3, 4, 5, 6, 7, 8, 9)) %>%+ dataset$PARAMCD %in% c("QS02802", "QS02806") & dataset$CHG == -2,
|
|
| 130 | +1022 | 3x |
- dplyr::mutate(AETERM = gsub("dcd", "trm", AEDECOD)) %>%
+ "Improved by two levels", dataset$CHGCAT1 |
|
| 131 | -3x | +|||
| 1023 | +
- dplyr::mutate(AESEV = dplyr::case_when(+ ) |
|||
| 132 | +1024 | 3x |
- AETOXGR == 1 ~ "MILD",+ dataset$CHGCAT1 <- ifelse( |
|
| 133 | +1025 | 3x |
- AETOXGR %in% c(2, 3) ~ "MODERATE",+ dataset$PARAMCD %in% c("QS02802", "QS02806") & dataset$CHG == -1,
|
|
| 134 | +1026 | 3x |
- AETOXGR %in% c(4, 5) ~ "SEVERE"- |
- |
| 135 | -- |
- ))+ "Improved by one level", dataset$CHGCAT1 |
||
| 136 | +1027 | - - | -||
| 137 | -3x | -
- adae <- var_relabel(+ ) |
||
| 138 | +1028 | 3x |
- adae,+ dataset$CHGCAT1 <- ifelse( |
|
| 139 | +1029 | 3x |
- STUDYID = "Study Identifier",+ dataset$PARAMCD %in% c("QS02802", "QS02806") & dataset$CHG == 0,
|
|
| 140 | +1030 | 3x |
- USUBJID = "Unique Subject Identifier"+ "No change", dataset$CHGCAT1 |
|
| 141 | +1031 |
- )+ ) |
||
| 142 | -+ | |||
| 1032 | +3x |
-
+ dataset$CHGCAT1 <- ifelse( |
||
| 143 | -+ | |||
| 1033 | +3x |
- # merge adsl to be able to add AE date and study day variables+ dataset$PARAMCD %in% c("QS02802", "QS02806") & dataset$CHG == 1,
|
||
| 144 | +1034 | 3x |
- adae <- dplyr::inner_join(adae, adsl, by = c("STUDYID", "USUBJID")) %>%
+ "Worsened by one level", dataset$CHGCAT1 |
|
| 145 | -3x | +|||
| 1035 | +
- dplyr::rowwise() %>%+ ) |
|||
| 146 | +1036 | 3x |
- dplyr::mutate(TRTENDT = lubridate::date(dplyr::case_when(+ dataset$CHGCAT1 <- ifelse( |
|
| 147 | +1037 | 3x |
- is.na(TRTEDTM) ~ lubridate::floor_date(lubridate::date(TRTSDTM) + study_duration_secs, unit = "day"),+ dataset$PARAMCD %in% c("QS02802", "QS02806") & dataset$CHG == 2,
|
|
| 148 | +1038 | 3x |
- TRUE ~ TRTEDTM+ "Worsened by two levels", dataset$CHGCAT1 |
|
| 149 | +1039 |
- ))) %>%+ ) |
||
| 150 | +1040 | 3x |
- dplyr::mutate(ASTDTM = sample(+ dataset$CHGCAT1 <- ifelse( |
|
| 151 | +1041 | 3x |
- seq(lubridate::as_datetime(TRTSDTM), lubridate::as_datetime(TRTENDT), by = "day"),+ dataset$PARAMCD %in% c("QS02802", "QS02806") & dataset$CHG == 3,
|
|
| 152 | +1042 | 3x |
- size = 1+ "Worsened by three levels", dataset$CHGCAT1 |
|
| 153 | +1043 |
- )) %>%- |
- ||
| 154 | -3x | -
- dplyr::mutate(ASTDY = ceiling(difftime(ASTDTM, TRTSDTM, units = "days"))) %>%+ ) |
||
| 155 | +1044 |
- # add 1 to end of range incase both values passed to sample() are the same+ |
||
| 156 | +1045 | 3x |
- dplyr::mutate(AENDTM = sample(+ dataset$CHGCAT1 <- ifelse( |
|
| 157 | +1046 | 3x |
- seq(lubridate::as_datetime(ASTDTM), lubridate::as_datetime(TRTENDT + 1), by = "day"),+ dataset$PARAMCD == "QS02801" & dataset$CHG == -3, |
|
| 158 | +1047 | 3x |
- size = 1+ "Improved by three levels", dataset$CHGCAT1 |
|
| 159 | +1048 |
- )) %>%+ ) |
||
| 160 | +1049 | 3x |
- dplyr::mutate(AENDY = ceiling(difftime(AENDTM, TRTSDTM, units = "days"))) %>%+ dataset$CHGCAT1 <- ifelse( |
|
| 161 | +1050 | 3x |
- dplyr::mutate(LDOSEDTM = dplyr::case_when(+ dataset$PARAMCD == "QS02801" & dataset$CHG == -2, |
|
| 162 | +1051 | 3x |
- TRTSDTM < ASTDTM ~ lubridate::as_datetime(stats::runif(1, TRTSDTM, ASTDTM)),+ "Improved by two levels", dataset$CHGCAT1+ |
+ |
| 1052 | ++ |
+ ) |
||
| 163 | +1053 | 3x |
- TRUE ~ ASTDTM+ dataset$CHGCAT1 <- ifelse( |
|
| 164 | -+ | |||
| 1054 | +3x |
- )) %>%+ dataset$PARAMCD == "QS02801" & dataset$CHG == -1, |
||
| 165 | +1055 | 3x |
- dplyr::mutate(LDRELTM = as.numeric(difftime(ASTDTM, LDOSEDTM, units = "mins"))) %>%+ "Improved by one level", dataset$CHGCAT1+ |
+ |
| 1056 | ++ |
+ ) |
||
| 166 | +1057 | 3x |
- dplyr::select(-TRTENDT) %>%+ dataset$CHGCAT1 <- ifelse( |
|
| 167 | +1058 | 3x |
- dplyr::ungroup() %>%+ dataset$PARAMCD == "QS02801" & dataset$CHG == 0, |
|
| 168 | +1059 | 3x |
- dplyr::arrange(STUDYID, USUBJID, ASTDTM, AETERM)+ "No changed", dataset$CHGCAT1 |
|
| 169 | +1060 |
-
+ ) |
||
| 170 | +1061 | 3x |
- adae <- adae %>%+ dataset$CHGCAT1 <- ifelse( |
|
| 171 | +1062 | 3x |
- dplyr::group_by(USUBJID) %>%+ dataset$PARAMCD == "QS02801" & dataset$CHG == 1, |
|
| 172 | +1063 | 3x |
- dplyr::mutate(AESEQ = seq_len(dplyr::n())) %>%+ "Worsened by one level", dataset$CHGCAT1 |
|
| 173 | -3x | +|||
| 1064 | +
- dplyr::mutate(ASEQ = AESEQ) %>%+ ) |
|||
| 174 | +1065 | 3x |
- dplyr::ungroup() %>%+ dataset$CHGCAT1 <- ifelse( |
|
| 175 | +1066 | 3x |
- dplyr::arrange(+ dataset$PARAMCD == "QS02801" & dataset$CHG == 2, |
|
| 176 | +1067 | 3x |
- STUDYID,+ "Worsened by two levels", dataset$CHGCAT1 |
|
| 177 | -3x | +|||
| 1068 | +
- USUBJID,+ ) |
|||
| 178 | +1069 | 3x |
- ASTDTM,+ dataset$CHGCAT1 <- ifelse( |
|
| 179 | +1070 | 3x |
- AETERM,+ dataset$PARAMCD == "QS02801" & dataset$CHG == 3, |
|
| 180 | +1071 | 3x |
- AESEQ+ "Worsened by three levels", dataset$CHGCAT1 |
|
| 181 | +1072 |
) |
||
| 182 | +1073 | |||
| 183 | +1074 | 3x |
- outcomes <- c(+ paramcd_vec <- c( |
|
| 184 | -3x | -
- "UNKNOWN",- |
- ||
| 185 | +1075 | 3x |
- "NOT RECOVERED/NOT RESOLVED",+ "QS02803", "QS02804", "QS02805", "QS02807", "QS02808", "QS02809", "QS02810", |
|
| 186 | +1076 | 3x |
- "RECOVERED/RESOLVED WITH SEQUELAE",+ "QS02811", "QS02812", "QS02813", "QS02814", "QS02815", "QS02816", "QS02817", |
|
| 187 | +1077 | 3x |
- "RECOVERING/RESOLVING",+ "QS02818", "QS02819", "QS02820", "QS02821", "QS02822", "QS02823", "QS02824", |
|
| 188 | +1078 | 3x |
- "RECOVERED/RESOLVED"+ "QS02825", "QS02826", "QS02827", "QS02828" |
|
| 189 | +1079 |
- )+ ) |
||
| 190 | +1080 | |||
| 191 | +1081 | 3x |
- actions <- c(+ dataset$CHGCAT1 <- ifelse( |
|
| 192 | +1082 | 3x |
- "DOSE RATE REDUCED",+ dataset$PARAMCD %in% paramcd_vec & dataset$CHG == -3, |
|
| 193 | +1083 | 3x |
- "UNKNOWN",+ "Improved by three levels", dataset$CHGCAT1 |
|
| 194 | -3x | +|||
| 1084 | +
- "NOT APPLICABLE",+ ) |
|||
| 195 | +1085 | 3x |
- "DRUG INTERRUPTED",+ dataset$CHGCAT1 <- ifelse( |
|
| 196 | +1086 | 3x |
- "DRUG WITHDRAWN",+ dataset$PARAMCD %in% paramcd_vec & dataset$CHG == -2, |
|
| 197 | +1087 | 3x |
- "DOSE INCREASED",+ "Improved by two levels", dataset$CHGCAT1 |
|
| 198 | -3x | +|||
| 1088 | +
- "DOSE NOT CHANGED",+ ) |
|||
| 199 | +1089 | 3x |
- "DOSE REDUCED",+ dataset$CHGCAT1 <- ifelse( |
|
| 200 | +1090 | 3x |
- "NOT EVALUABLE"- |
- |
| 201 | -- |
- )- |
- ||
| 202 | -- |
-
+ dataset$PARAMCD %in% paramcd_vec & dataset$CHG == -1, |
||
| 203 | +1091 | 3x |
- adae <- adae %>%+ "Improved by one level", dataset$CHGCAT1 |
|
| 204 | -3x | +|||
| 1092 | +
- dplyr::mutate(AEOUT = factor(ifelse(+ ) |
|||
| 205 | +1093 | 3x |
- AETOXGR == "5",+ dataset$CHGCAT1 <- ifelse( |
|
| 206 | +1094 | 3x |
- "FATAL",+ dataset$PARAMCD %in% paramcd_vec & dataset$CHG == 0, |
|
| 207 | +1095 | 3x |
- as.character(sample_fct(outcomes, nrow(adae), prob = c(0.1, 0.2, 0.1, 0.3, 0.3)))+ "No change", dataset$CHGCAT1 |
|
| 208 | +1096 |
- ))) %>%- |
- ||
| 209 | -3x | -
- dplyr::mutate(AEACN = factor(ifelse(+ ) |
||
| 210 | +1097 | 3x |
- AETOXGR == "5",+ dataset$CHGCAT1 <- ifelse( |
|
| 211 | +1098 | 3x |
- "NOT EVALUABLE",+ dataset$PARAMCD %in% paramcd_vec & dataset$CHG == 1, |
|
| 212 | +1099 | 3x |
- 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)))+ "Worsened by one level", dataset$CHGCAT1 |
|
| 213 | +1100 |
- ))) %>%+ ) |
||
| 214 | +1101 | 3x |
- dplyr::mutate(AESDTH = dplyr::case_when(+ dataset$CHGCAT1 <- ifelse( |
|
| 215 | +1102 | 3x |
- AEOUT == "FATAL" ~ "Y",+ dataset$PARAMCD %in% paramcd_vec & dataset$CHG == 2, |
|
| 216 | +1103 | 3x |
- TRUE ~ "N"+ "Worsened by two levels", dataset$CHGCAT1 |
|
| 217 | +1104 |
- )) %>%- |
- ||
| 218 | -3x | -
- dplyr::mutate(TRTEMFL = ifelse(ASTDTM >= TRTSDTM, "Y", "")) %>%+ ) |
||
| 219 | +1105 | 3x |
- dplyr::mutate(AECONTRT = sample(c("Y", "N"), prob = c(0.4, 0.6), size = dplyr::n(), replace = TRUE)) %>%
+ dataset$CHGCAT1 <- ifelse( |
|
| 220 | +1106 | 3x |
- dplyr::mutate(+ dataset$PARAMCD %in% paramcd_vec & dataset$CHG == 3, |
|
| 221 | +1107 | 3x |
- ANL01FL = ifelse(TRTEMFL == "Y" & ASTDTM <= TRTEDTM + lubridate::month(1), "Y", "")+ "Worsened by three levels", dataset$CHGCAT1 |
|
| 222 | +1108 |
- ) %>%- |
- ||
| 223 | -3x | -
- dplyr::mutate(ANL01FL = ifelse(is.na(ANL01FL), "", ANL01FL))+ ) |
||
| 224 | +1109 | |||
| 225 | +1110 | 3x |
- adae <- adae %>%+ return(dataset) |
|
| 226 | -3x | +|||
| 1111 | +
- dplyr::mutate(AERELNST = sample(c("Y", "N"), prob = c(0.4, 0.6), size = dplyr::n(), replace = TRUE)) %>%
+ } else {
|
|||
| 227 | -3x | +|||
| 1112 | +! |
- dplyr::mutate(AEACNOTH = sample(+ collapse_vars <- paste(check_vars, collapse = ", ") |
||
| 228 | -3x | +|||
| 1113 | +! |
- x = c("MEDICATION", "PROCEDURE/SURGERY", "SUBJECT DISCONTINUED FROM STUDY", "NONE"),
+ stop(sprintf( |
||
| 229 | -3x | +|||
| 1114 | +! |
- prob = c(0.2, 0.4, 0.2, 0.2),+ "%s: one or both variables is/are missing, needed for derivation", |
||
| 230 | -3x | +|||
| 1115 | +! |
- size = dplyr::n(),+ collapse_vars |
||
| 231 | -3x | +|||
| 1116 | +
- replace = TRUE+ )) |
|||
| 232 | +1117 |
- ))+ } |
||
| 233 | +1118 |
-
+ } |
||
| 234 | +1119 |
- # Split metadata for AEs of special interest (AESI).+ |
||
| 235 | -3x | +|||
| 1120 | +
- l_aag <- split(aag, interaction(aag$NAMVAR, aag$SRCVAR, aag$GRPTYPE, drop = TRUE))+ #' @describeIn h_adqlqc Completion/Compliance Data Calculation |
|||
| 236 | +1121 |
-
+ #' |
||
| 237 | +1122 |
- # Create AESI flags+ #' @param dataset (`data.frame`)\cr Dataset. |
||
| 238 | -3x | +|||
| 1123 | +
- l_aesi <- lapply(l_aag, function(d_adag, d_adae) {
+ #' |
|||
| 239 | -9x | +|||
| 1124 | +
- names(d_adag)[names(d_adag) == "REFTERM"] <- d_adag$SRCVAR[1]+ #' @return `data.frame` |
|||
| 240 | -9x | +|||
| 1125 | +
- names(d_adag)[names(d_adag) == "REFNAME"] <- d_adag$NAMVAR[1]+ #' @keywords internal |
|||
| 241 | +1126 |
-
+ comp_derv <- function(dataset, percent, number) {
|
||
| 242 | -9x | +|||
| 1127 | +
- if (d_adag$GRPTYPE[1] == "CUSTOM") {
+ # original items data |
|||
| 243 | +1128 | 3x |
- d_adag <- d_adag[-which(names(d_adag) == "SCOPE")]+ orig_data <- filter( |
|
| 244 | -6x | +1129 | +3x |
- } else if (d_adag$GRPTYPE[1] == "SMQ") {
+ dataset, |
| 245 | -6x | +1130 | +3x |
- names(d_adag)[names(d_adag) == "SCOPE"] <- paste0(substr(d_adag$NAMVAR[1], 1, 5), "SC")+ PARCAT2 == "Original Items" |
| 246 | +1131 |
- }+ ) |
||
| 247 | +1132 |
-
+ # total number of questionnaires |
||
| 248 | -9x | +1133 | +3x |
- d_adag <- d_adag[-which(names(d_adag) %in% c("NAMVAR", "SRCVAR", "GRPTYPE"))]
+ comp_count_all <- select( |
| 249 | -9x | +1134 | +3x |
- d_new <- dplyr::left_join(x = d_adae, y = d_adag, by = intersect(names(d_adae), names(d_adag)))+ orig_data, |
| 250 | -9x | +1135 | +3x |
- d_new[, dplyr::setdiff(names(d_new), names(d_adae)), drop = FALSE]+ PARAMCD+ |
+
| 1136 | ++ |
+ ) %>% |
||
| 251 | +1137 | 3x |
- }, adae)+ distinct() %>% |
|
| 252 | -+ | |||
| 1138 | +3x |
-
+ count() |
||
| 253 | +1139 | 3x |
- adae <- dplyr::bind_cols(adae, l_aesi)+ comp_count_all <- comp_count_all$n |
|
| 254 | +1140 |
-
+ # original items data count of questions answered |
||
| 255 | +1141 | 3x |
- adae <- dplyr::mutate(adae, AERELNST = sample(+ orig_data_summ <- group_by( |
|
| 256 | +1142 | 3x |
- x = c("CONCURRENT ILLNESS", "OTHER", "DISEASE UNDER STUDY", "NONE"),
+ orig_data, |
|
| 257 | +1143 | 3x |
- prob = c(0.3, 0.3, 0.3, 0.1),+ STUDYID, |
|
| 258 | +1144 | 3x |
- size = dplyr::n(),+ USUBJID, |
|
| 259 | +1145 | 3x |
- replace = TRUE+ PARCAT1, |
|
| 260 | -+ | |||
| 1146 | +3x |
- ))+ AVISIT, |
||
| 261 | -+ | |||
| 1147 | +3x |
-
+ AVISITN, |
||
| 262 | -+ | |||
| 1148 | +3x |
-
+ ADTM, |
||
| 263 | +1149 | 3x |
- adae <- adae %>%+ ADY |
|
| 264 | -3x | +|||
| 1150 | +
- dplyr::mutate(AES_FLAG = sample(+ ) %>% |
|||
| 265 | +1151 | 3x |
- x = c("AESLIFE", "AESHOSP", "AESDISAB", "AESCONG", "AESMIE"),
+ summarise( |
|
| 266 | +1152 | 3x |
- prob = c(0.1, 0.2, 0.2, 0.2, 0.3),+ comp_count = sum(!is.na(AVAL)), |
|
| 267 | +1153 | 3x |
- size = dplyr::n(),+ comp_count_all = comp_count_all, |
|
| 268 | +1154 | 3x |
- replace = TRUE+ .groups = "drop" |
|
| 269 | +1155 |
- )) %>%+ ) %>% |
||
| 270 | +1156 | 3x |
- dplyr::mutate(AES_FLAG = dplyr::case_when(+ mutate( |
|
| 271 | +1157 | 3x |
- AESDTH == "Y" ~ "AESDTH",+ per_comp = trunc((comp_count / comp_count_all) * 100) |
|
| 272 | -3x | +|||
| 1158 | +
- TRUE ~ AES_FLAG+ ) |
|||
| 273 | +1159 |
- )) %>%+ # expected data |
||
| 274 | +1160 | 3x |
- dplyr::mutate(+ ex028_data <- filter( |
|
| 275 | +1161 | 3x |
- AESCONG = ifelse(AES_FLAG == "AESCONG", "Y", "N"),+ dataset, |
|
| 276 | +1162 | 3x |
- AESDISAB = ifelse(AES_FLAG == "AESDISAB", "Y", "N"),+ PARAMCD == "EX028", |
|
| 277 | +1163 | 3x |
- AESHOSP = ifelse(AES_FLAG == "AESHOSP", "Y", "N"),+ AVAL == 1 |
|
| 278 | -3x | +|||
| 1164 | +
- AESLIFE = ifelse(AES_FLAG == "AESLIFE", "Y", "N"),+ ) %>% |
|||
| 279 | +1165 | 3x |
- AESMIE = ifelse(AES_FLAG == "AESMIE", "Y", "N")+ select( |
|
| 280 | -+ | |||
| 1166 | +3x |
- ) %>%+ STUDYID, |
||
| 281 | +1167 | 3x |
- dplyr::select(-"AES_FLAG")- |
- |
| 282 | -- |
-
+ USUBJID, |
||
| 283 | +1168 | 3x |
- if (length(na_vars) > 0 && na_percentage > 0) {
+ PARCAT1, |
|
| 284 | -! | +|||
| 1169 | +3x |
- adae <- mutate_na(ds = adae, na_vars = na_vars, na_percentage = na_percentage)+ AVISIT, |
||
| 285 | -+ | |||
| 1170 | +3x |
- }+ AVISITN, |
||
| 286 | -+ | |||
| 1171 | +3x |
-
+ ADTM, |
||
| 287 | -+ | |||
| 1172 | +3x |
- # apply metadata+ ADY, |
||
| 288 | +1173 | 3x |
- adae <- apply_metadata(adae, "metadata/ADAE.yml")+ AVAL_ex028 = AVAL |
|
| 289 | +1174 |
-
+ ) %>% |
||
| 290 | +1175 | 3x |
- return(adae)+ mutate( |
|
| 291 | -+ | |||
| 1176 | +3x |
- }+ comp_count_all = comp_count_all |
| 1 | +1177 |
- #' Generate Anthropometric Measurements for Males and Females.+ ) |
|
| 2 | +1178 |
- #'+ |
|
| 3 | -+ | ||
| 1179 | +3x |
- #' Anthropometric measurements are randomly generated using normal approximation.+ joined <- left_join( |
|
| 4 | -+ | ||
| 1180 | +3x |
- #' The default mean and standard deviation values used are based on US National Health+ ex028_data, |
|
| 5 | -+ | ||
| 1181 | +3x |
- #' Statistics for adults aged 20 years or over. The measurements are generated in same units+ orig_data_summ, |
|
| 6 | -+ | ||
| 1182 | +3x |
- #' as provided to the function.+ by = c( |
|
| 7 | -+ | ||
| 1183 | +3x |
- #'+ "STUDYID", |
|
| 8 | -+ | ||
| 1184 | +3x |
- #' @details One record per subject.+ "USUBJID", |
|
| 9 | -+ | ||
| 1185 | +3x |
- #'+ "PARCAT1", |
|
| 10 | -+ | ||
| 1186 | +3x |
- #' @inheritParams argument_convention+ "AVISIT", |
|
| 11 | -+ | ||
| 1187 | +3x |
- #' @param df (`data.frame`)\cr Analysis dataset.+ "AVISITN", |
|
| 12 | -+ | ||
| 1188 | +3x |
- #' @param id_var (`character`)\cr Patient identifier variable name.+ "comp_count_all" |
|
| 13 | +1189 |
- #' @param sex_var (`character`)\cr Name of variable representing sex of patient.+ ) |
|
| 14 | +1190 |
- #' @param sex_var_level_male (`character`)\cr Level of `sex_var` representing males.+ ) %>% |
|
| 15 | -+ | ||
| 1191 | +3x |
- #' @param male_weight_in_kg (named `list`)\cr List of means and SDs of male weights in kilograms.+ select(-c("ADTM.x", "ADY.x"))
|
|
| 16 | +1192 |
- #' @param female_weight_in_kg (named `list`)\cr List of means and SDs of female weights in kilograms.+ |
|
| 17 | -+ | ||
| 1193 | +3x |
- #' @param male_height_in_m (named `list`)\cr List of means and SDs of male heights in metres.+ joined <- rename( |
|
| 18 | -+ | ||
| 1194 | +3x |
- #' @param female_height_in_m (named `list`)\cr list of means and SDs of female heights in metres.+ joined, |
|
| 19 | -+ | ||
| 1195 | +3x |
- #'+ ADTM = ADTM.y, |
|
| 20 | -+ | ||
| 1196 | +3x |
- #' @return a dataframe with anthropometric measurements for each subject in analysis dataset.+ ADY = ADY.y |
|
| 21 | +1197 |
- #' @keywords internal+ ) |
|
| 22 | +1198 |
- #'+ # CO028ALL |
|
| 23 | -+ | ||
| 1199 | +3x |
- #' @examples+ co028all <- mutate( |
|
| 24 | -+ | ||
| 1200 | +3x |
- #' adsl <- radsl(N = 5, seed = 1)+ joined, |
|
| 25 | -+ | ||
| 1201 | +3x |
- #'+ PARAMCD = "CO028ALL", |
|
| 26 | -+ | ||
| 1202 | +3x |
- #' df_with_measurements <- random.cdisc.data:::h_anthropometrics_by_sex(df = adsl)+ PARAM = "EORTC QLQ-C30: Completion - Completed all questions", |
|
| 27 | -+ | ||
| 1203 | +3x |
- #' df_with_measurements+ PARCAT2 = "Completion", |
|
| 28 | -+ | ||
| 1204 | +3x |
- h_anthropometrics_by_sex <- function(df,+ AVAL = case_when( |
|
| 29 | -+ | ||
| 1205 | +3x |
- seed = 1,+ AVAL_ex028 == 1 & comp_count == comp_count_all ~ 1, |
|
| 30 | -+ | ||
| 1206 | +3x |
- id_var = "USUBJID",+ AVAL_ex028 == 1 & (is.na(comp_count) | comp_count < comp_count_all) ~ 0 |
|
| 31 | +1207 |
- sex_var = "SEX",+ ), |
|
| 32 | -+ | ||
| 1208 | +3x |
- sex_var_level_male = "M",+ AVALC = case_when( |
|
| 33 | -+ | ||
| 1209 | +3x |
- male_weight_in_kg = list(mean = 90.6, sd = 44.9),+ AVAL == 1 ~ "Completed all questions", |
|
| 34 | -+ | ||
| 1210 | +3x |
- female_weight_in_kg = list(mean = 77.5, sd = 46.2),+ AVAL == 0 ~ "Did not complete all questions" |
|
| 35 | +1211 |
- male_height_in_m = list(mean = 1.75, sd = 0.14),+ ) |
|
| 36 | +1212 |
- female_height_in_m = list(mean = 1.61, sd = 0.24)) {
+ ) |
|
| 37 | -3x | +||
| 1213 | +
- checkmate::assert_data_frame(df)+ # CO028<y>P |
||
| 38 | +1214 | 3x |
- checkmate::assert_string(id_var)+ co028p <- mutate( |
| 39 | +1215 | 3x |
- checkmate::assert_string(sex_var)+ joined, |
| 40 | +1216 | 3x |
- checkmate::assert_string(sex_var_level_male)+ PARAMCD = paste0("CO028", as.character(percent), "P"),
|
| 41 | +1217 | 3x |
- checkmate::assert_list(male_weight_in_kg, types = "numeric")+ PARAM = sprintf( |
| 42 | +1218 | 3x |
- checkmate::assert_subset(names(male_weight_in_kg), choices = c("mean", "sd"))
+ "EORTC QLQ-C30: Completion - Completed at least %s%% of questions", |
| 43 | +1219 | 3x |
- checkmate::assert_list(female_weight_in_kg, types = "numeric")+ as.character(percent) |
| 44 | -3x | +||
| 1220 | +
- checkmate::assert_subset(names(female_weight_in_kg), choices = c("mean", "sd"))
+ ), |
||
| 45 | +1221 | 3x |
- checkmate::assert_list(male_height_in_m, types = "numeric")+ PARCAT2 = "Completion", |
| 46 | +1222 | 3x |
- checkmate::assert_subset(names(male_height_in_m), choices = c("mean", "sd"))
+ AVAL = case_when( |
| 47 | +1223 | 3x |
- checkmate::assert_list(female_height_in_m, types = "numeric")+ AVAL_ex028 == 1 & per_comp >= percent ~ 1, |
| 48 | +1224 | 3x |
- checkmate::assert_subset(names(female_height_in_m), choices = c("mean", "sd"))
- |
-
| 49 | -- |
-
+ AVAL_ex028 == 1 & (is.na(per_comp) | per_comp < percent) ~ 0 |
|
| 50 | +1225 |
-
+ ), |
|
| 51 | +1226 | 3x |
- n <- length(unique(df[[id_var]]))+ AVALC = case_when( |
| 52 | +1227 | 3x |
- set.seed(seed)+ AVAL == 1 ~ sprintf( |
| 53 | -+ | ||
| 1228 | +3x |
-
+ "Completed at least %s%% of questions", |
|
| 54 | +1229 | 3x |
- df_by_sex <- unique(subset(df, select = c(id_var, sex_var)))+ as.character(percent) |
| 55 | +1230 |
-
+ ), |
|
| 56 | +1231 | 3x |
- df_with_measurements <- df_by_sex %>%+ AVAL == 0 ~ sprintf( |
| 57 | +1232 | 3x |
- dplyr::mutate(+ "Did not complete at least %s%% of questions", |
| 58 | +1233 | 3x |
- WEIGHT = ifelse(+ as.character(percent) |
| 59 | -3x | +||
| 1234 | +
- .data[[sex_var]] == sex_var_level_male,+ ) |
||
| 60 | -3x | +||
| 1235 | +
- stats::rnorm(n = n, mean = male_weight_in_kg$mean, sd = male_weight_in_kg$sd),+ ) |
||
| 61 | -3x | +||
| 1236 | +
- stats::rnorm(n = n, mean = female_weight_in_kg$mean, sd = female_weight_in_kg$sd)+ ) |
||
| 62 | +1237 |
- )+ # CO028<x>Q |
|
| 63 | -+ | ||
| 1238 | +3x |
- ) %>%+ co028q <- mutate( |
|
| 64 | +1239 | 3x |
- dplyr::mutate(+ joined, |
| 65 | +1240 | 3x |
- HEIGHT = ifelse(+ PARAMCD = paste0("CO028", as.character(number), "Q"),
|
| 66 | +1241 | 3x |
- .data[[sex_var]] == sex_var_level_male,+ PARAM = sprintf( |
| 67 | +1242 | 3x |
- stats::rnorm(n = n, mean = male_height_in_m$mean, sd = male_height_in_m$sd),+ "EORTC QLQ-C30: Completion - Completed at least %s question(s)", |
| 68 | +1243 | 3x |
- stats::rnorm(n = n, mean = female_height_in_m$mean, sd = female_height_in_m$sd)+ as.character(number) |
| 69 | +1244 |
- )+ ), |
|
| 70 | -+ | ||
| 1245 | +3x |
- ) %>%+ PARCAT2 = "Completion", |
|
| 71 | +1246 | 3x |
- dplyr::mutate(+ AVAL = case_when( |
| 72 | +1247 | 3x |
- BMI = WEIGHT / ((HEIGHT)^2)+ AVAL_ex028 == 1 & comp_count >= number ~ 1, |
| 73 | -+ | ||
| 1248 | +3x |
- )+ AVAL_ex028 == 1 & (comp_count < number | is.na(comp_count)) ~ 0 |
|
| 74 | +1249 |
-
+ ), |
|
| 75 | +1250 | 3x |
- return(df_with_measurements)+ AVALC = case_when( |
| 76 | -- |
- }+ | |
| 1251 | +3x | +
+ AVAL == 1 ~ sprintf(+ |
+ |
| 1252 | +3x | +
+ "Completed at least %s questions",+ |
+ |
| 1253 | +3x | +
+ as.character(number) |
|
| 77 | +1254 |
-
+ ),+ |
+ |
| 1255 | +3x | +
+ AVAL == 0 ~ sprintf(+ |
+ |
| 1256 | +3x | +
+ "Did not complete at least %s question(s)",+ |
+ |
| 1257 | +3x | +
+ as.character(number) |
|
| 78 | +1258 |
- #' Subcategory Analysis Dataset (ADSUB)+ ) |
|
| 79 | +1259 |
- #'+ ) |
|
| 80 | +1260 |
- #' @description `r lifecycle::badge("stable")`
+ ) |
|
| 81 | +1261 |
- #'+ + |
+ |
| 1262 | +3x | +
+ co028_bind <- rbind(+ |
+ |
| 1263 | +3x | +
+ co028all,+ |
+ |
| 1264 | +3x | +
+ co028p,+ |
+ |
| 1265 | +3x | +
+ co028q |
|
| 82 | +1266 |
- #' Function for generating a random Subcategory Analysis Dataset for a given+ ) %>%+ |
+ |
| 1267 | +3x | +
+ select(+ |
+ |
| 1268 | +3x | +
+ -c("AVAL_ex028", "comp_count", "comp_count_all", "per_comp")
|
|
| 83 | +1269 |
- #' Subject-Level Analysis Dataset.+ )+ |
+ |
| 1270 | +3x | +
+ return(co028_bind) |
|
| 84 | +1271 |
- #'+ } |
| 85 | +1 |
- #' @details One record per subject.+ #' Exposure Analysis Dataset (ADEX) |
||
| 86 | +2 |
#' |
||
| 87 | +3 |
- #' Keys: `STUDYID`, `USUBJID`, `PARAMCD`, `AVISITN`, `ADTM`, `SRCSEQ`+ #' @description `r lifecycle::badge("stable")`
|
||
| 88 | +4 |
#' |
||
| 89 | +5 |
- #' @inheritParams argument_convention+ #' Function for generating random Exposure Analysis Dataset for a given |
||
| 90 | +6 |
- #' @template param_cached+ #' Subject-Level Analysis Dataset. |
||
| 91 | +7 |
- #' @templateVar data adsub+ #' |
||
| 92 | +8 | ++ |
+ #' @details One record per each record in the corresponding SDTM domain.+ |
+ |
| 9 |
#' |
|||
| 93 | +10 |
- #' @return `data.frame`+ #' Keys: `STUDYID`, `USUBJID`, `EXSEQ`, `PARAMCD`, `PARCAT1`, `ASTDTM`, `AENDTM`, `ASTDY`, `AENDY`, |
||
| 94 | +11 |
- #' @export+ #' `AVISITN`, `EXDOSFRQ`, `EXROUTE`, `VISIT`, `VISITDY`, `EXSTDTC`, `EXENDTC`, `EXSTDY`, `EXENDY` |
||
| 95 | +12 |
#' |
||
| 96 | +13 |
- #' @author tomlinsj, npaszty, Xuefeng Hou, dipietrc+ #' @inheritParams argument_convention |
||
| 97 | +14 |
- #'+ #' @param parcat1 (`character vector`)\cr Dose amount categories. Defaults to "Individual" and "Overall". |
||
| 98 | +15 |
- #' @examples+ #' @param parcat2 (`character vector`)\cr Types of drug received. Defaults to "Drug A" and "Drug B". |
||
| 99 | +16 |
- #' adsl <- radsl(N = 10, seed = 1, study_duration = 2)+ #' @param max_n_exs (`integer`)\cr Maximum number of exposures per patient. Defaults to 6. |
||
| 100 | +17 |
- #'+ #' @template param_cached |
||
| 101 | +18 |
- #' adsub <- radsub(adsl, seed = 2)+ #' @templateVar data adex |
||
| 102 | +19 |
- #' adsub+ #' |
||
| 103 | +20 |
- radsub <- function(adsl,+ #' @return `data.frame` |
||
| 104 | +21 |
- param = c(+ #' @export |
||
| 105 | +22 |
- "Baseline Weight",+ #' |
||
| 106 | +23 |
- "Baseline Height",+ #' @examples |
||
| 107 | +24 |
- "Baseline BMI",+ #' adsl <- radsl(N = 10, study_duration = 2, seed = 1) |
||
| 108 | +25 |
- "Baseline ECOG",+ #' |
||
| 109 | +26 |
- "Baseline Biomarker Mutation"+ #' adex <- radex(adsl, seed = 2) |
||
| 110 | +27 |
- ),+ #' adex |
||
| 111 | +28 |
- paramcd = c("BWGHTSI", "BHGHTSI", "BBMISI", "BECOG", "BBMRKR1"),
+ radex <- function(adsl, |
||
| 112 | +29 |
- seed = NULL,+ param = c( |
||
| 113 | +30 |
- na_percentage = 0,+ "Dose administered during constant dosing interval", |
||
| 114 | +31 |
- na_vars = list(),+ "Number of doses administered during constant dosing interval", |
||
| 115 | +32 |
- cached = FALSE) {
+ "Total dose administered", |
||
| 116 | -4x | +|||
| 33 | +
- checkmate::assert_flag(cached)+ "Total number of doses administered" |
|||
| 117 | -4x | +|||
| 34 | +
- if (cached) {
+ ), |
|||
| 118 | -1x | +|||
| 35 | +
- return(get_cached_data("cadsub"))
+ paramcd = c("DOSE", "NDOSE", "TDOSE", "TNDOSE"),
|
|||
| 119 | +36 |
- }+ paramu = c("mg", " ", "mg", " "),
|
||
| 120 | +37 |
-
+ parcat1 = c("INDIVIDUAL", "OVERALL"),
|
||
| 121 | -3x | +|||
| 38 | +
- checkmate::assert_data_frame(adsl)+ parcat2 = c("Drug A", "Drug B"),
|
|||
| 122 | -3x | +|||
| 39 | +
- checkmate::assert_character(param, min.len = 1, any.missing = FALSE)+ visit_format = "WEEK", |
|||
| 123 | -3x | +|||
| 40 | +
- checkmate::assert_character(paramcd, min.len = 1, any.missing = FALSE)+ n_assessments = 5L, |
|||
| 124 | -3x | +|||
| 41 | +
- checkmate::assert_number(seed, null.ok = TRUE)+ n_days = 5L, |
|||
| 125 | -3x | +|||
| 42 | +
- checkmate::assert_number(na_percentage, lower = 0, upper = 1)+ max_n_exs = 6L, |
|||
| 126 | -3x | +|||
| 43 | +
- checkmate::assert_true(na_percentage < 1)+ lookup = NULL, |
|||
| 127 | +44 |
-
+ seed = NULL, |
||
| 128 | +45 |
- # Validate and initialize related variables.+ na_percentage = 0, |
||
| 129 | -3x | +|||
| 46 | +
- param_init_list <- relvar_init(param, paramcd)+ na_vars = list(AVAL = c(NA, 0.1), AVALU = c(NA), 0.1), |
|||
| 130 | +47 |
-
+ cached = FALSE) {
|
||
| 131 | -3x | +48 | +4x |
- if (!is.null(seed)) {
+ checkmate::assert_flag(cached) |
| 132 | -3x | +49 | +4x |
- set.seed(seed)+ if (cached) {
+ |
+
| 50 | +1x | +
+ return(get_cached_data("cadex"))
|
||
| 133 | +51 |
} |
||
| 134 | +52 | |||
| 135 | +53 | 3x |
- adsub <- expand.grid(+ checkmate::assert_data_frame(adsl) |
|
| 136 | +54 | 3x |
- STUDYID = unique(adsl$STUDYID),+ checkmate::assert_character(param, min.len = 1, any.missing = FALSE) |
|
| 137 | +55 | 3x |
- USUBJID = adsl$USUBJID,+ checkmate::assert_character(paramcd, min.len = 1, any.missing = FALSE) |
|
| 138 | +56 | 3x |
- PARAM = as.factor(param_init_list$relvar1),+ checkmate::assert_character(parcat1, min.len = 1, any.missing = FALSE) |
|
| 139 | +57 | 3x |
- AVISIT = "BASELINE",+ checkmate::assert_character(parcat2, min.len = 1, any.missing = FALSE) |
|
| 140 | +58 | 3x |
- stringsAsFactors = FALSE+ checkmate::assert_string(visit_format) |
|
| 141 | -+ | |||
| 59 | +3x |
- )+ checkmate::assert_integer(n_assessments, len = 1, any.missing = FALSE) |
||
| 142 | -+ | |||
| 60 | +3x |
-
+ checkmate::assert_integer(n_days, len = 1, any.missing = FALSE) |
||
| 143 | -+ | |||
| 61 | +3x |
- # Assign related variable values: PARAM and PARAMCD are related.+ checkmate::assert_integer(max_n_exs, len = 1, any.missing = FALSE) |
||
| 144 | +62 | 3x |
- adsub <- adsub %>% rel_var(+ checkmate::assert_data_frame(lookup, null.ok = TRUE) |
|
| 145 | +63 | 3x |
- var_name = "PARAMCD",+ checkmate::assert_number(seed, null.ok = TRUE) |
|
| 146 | +64 | 3x |
- related_var = "PARAM",+ checkmate::assert_number(na_percentage, lower = 0, upper = 1) |
|
| 147 | +65 | 3x |
- var_values = param_init_list$relvar2+ checkmate::assert_true(na_percentage < 1) |
|
| 148 | +66 |
- )+ |
||
| 149 | +67 |
-
+ # validate and initialize related variables |
||
| 150 | +68 | 3x |
- adsub <- adsub[order(adsub$STUDYID, adsub$USUBJID, adsub$PARAMCD), ]- |
- |
| 151 | -- |
-
+ param_init_list <- relvar_init(param, paramcd) |
||
| 152 | +69 | 3x |
- adsub <- var_relabel(+ unit_init_list <- relvar_init(param, paramu) |
|
| 153 | -3x | +|||
| 70 | +
- adsub,+ |
|||
| 154 | +71 | 3x |
- STUDYID = "Study Identifier",+ if (!is.null(seed)) {
|
|
| 155 | +72 | 3x |
- USUBJID = "Unique Subject Identifier"- |
- |
| 156 | -- |
- )+ set.seed(seed) |
||
| 157 | +73 |
-
+ } |
||
| 158 | -+ | |||
| 74 | +3x |
- # Merge ADSL to be able to add EG date and study day variables.+ study_duration_secs <- lubridate::seconds(attr(adsl, "study_duration_secs")) |
||
| 159 | +75 |
- # Sample ADTM to be a few days before TRTSDTM.+ |
||
| 160 | +76 | 3x |
- adsub <- dplyr::inner_join(+ adex <- expand.grid( |
|
| 161 | +77 | 3x |
- adsub,+ STUDYID = unique(adsl$STUDYID), |
|
| 162 | +78 | 3x |
- adsl,+ USUBJID = adsl$USUBJID, |
|
| 163 | +79 | 3x |
- by = c("STUDYID", "USUBJID")
+ PARAM = c( |
|
| 164 | -+ | |||
| 80 | +3x |
- ) %>%+ rep( |
||
| 165 | +81 | 3x |
- dplyr::group_by(USUBJID) %>%+ param_init_list$relvar1[1], |
|
| 166 | +82 | 3x |
- dplyr::mutate(ADTM = rep(+ length(levels(visit_schedule(visit_format = visit_format, n_assessments = n_assessments, n_days = n_days)))+ |
+ |
| 83 | ++ |
+ ), |
||
| 167 | +84 | 3x |
- lubridate::date(TRTSDTM)[1] - lubridate::days(sample(1:10, size = 1)),+ rep( |
|
| 168 | +85 | 3x |
- each = n()+ param_init_list$relvar1[2],+ |
+ |
| 86 | +3x | +
+ length(levels(visit_schedule(visit_format = visit_format, n_assessments = n_assessments, n_days = n_days))) |
||
| 169 | +87 |
- )) %>%+ ), |
||
| 170 | +88 | 3x |
- dplyr::ungroup() %>%+ param_init_list$relvar1[3:4]+ |
+ |
| 89 | ++ |
+ ), |
||
| 171 | +90 | 3x |
- dplyr::arrange(STUDYID, USUBJID, ADTM)+ stringsAsFactors = FALSE |
|
| 172 | +91 | ++ |
+ )+ |
+ |
| 92 | ||||
| 173 | +93 |
- # Generate a dataset with height, weight and BMI measurements for each subject.+ # assign related variable values: PARAMxPARAMCD are related |
||
| 174 | +94 | 3x |
- if (!is.null(seed)) {
+ adex <- adex %>% rel_var( |
|
| 175 | +95 | 3x |
- df_with_measurements <- h_anthropometrics_by_sex(adsub, seed = seed)+ var_name = "PARAMCD", |
|
| 176 | -+ | |||
| 96 | +3x |
- } else {
+ related_var = "PARAM", |
||
| 177 | -! | +|||
| 97 | +3x |
- df_with_measurements <- h_anthropometrics_by_sex(adsub)+ var_values = param_init_list$relvar2 |
||
| 178 | +98 |
- }+ ) |
||
| 179 | +99 | |||
| 180 | +100 |
- # Add this to adsub and create other measurements.+ # assign related variable values: AVALUxPARAM are related |
||
| 181 | +101 | 3x |
- adsub <- adsub %>%+ adex <- adex %>% rel_var( |
|
| 182 | +102 | 3x |
- dplyr::group_by(USUBJID) %>%+ var_name = "AVALU", |
|
| 183 | +103 | 3x |
- dplyr::mutate(+ related_var = "PARAM", |
|
| 184 | +104 | 3x |
- AVAL = dplyr::case_when(+ var_values = unit_init_list$relvar2+ |
+ |
| 105 | ++ |
+ )+ |
+ ||
| 106 | ++ | + | ||
| 185 | +107 | 3x |
- PARAMCD ==+ adex <- adex %>% |
|
| 186 | +108 | 3x |
- "BWGHTSI" ~ df_with_measurements$WEIGHT[df_with_measurements$USUBJID == USUBJID],+ dplyr::group_by(USUBJID) %>% |
|
| 187 | +109 | 3x |
- PARAMCD ==+ dplyr::mutate(PARCAT_ind = sample(c(1, 2), size = 1)) %>% |
|
| 188 | +110 | 3x |
- "BHGHTSI" ~ df_with_measurements$HEIGHT[df_with_measurements$USUBJID == USUBJID],+ dplyr::mutate(PARCAT2 = ifelse(PARCAT_ind == 1, parcat2[1], parcat2[2])) %>% |
|
| 189 | +111 | 3x |
- PARAMCD ==+ dplyr::select(-"PARCAT_ind")+ |
+ |
| 112 | ++ | + + | +||
| 113 | ++ |
+ # Add in PARCAT1 |
||
| 190 | +114 | 3x |
- "BBMISI" ~ df_with_measurements$BMI[df_with_measurements$USUBJID == USUBJID],+ adex <- adex %>% dplyr::mutate(PARCAT1 = dplyr::case_when( |
|
| 191 | +115 | 3x |
- PARAMCD == "BECOG" ~ sample(c(0, 1, 2, 3, 4, 5), 1),+ (PARAMCD == "TNDOSE" | PARAMCD == "TDOSE") ~ "OVERALL", |
|
| 192 | +116 | 3x |
- PARAMCD == "BBMRKR1" ~ sample(c(1, 2), prob = c(0.5, 0.5), 1)+ PARAMCD == "DOSE" | PARAMCD == "NDOSE" ~ "INDIVIDUAL" |
|
| 193 | +117 |
- )+ )) |
||
| 194 | +118 |
- ) %>%- |
- ||
| 195 | -3x | -
- dplyr::arrange(PARAMCD) %>%+ |
||
| 196 | +119 | 3x |
- dplyr::ungroup() %>%+ adex_visit <- adex %>% |
|
| 197 | +120 | 3x |
- dplyr::mutate(AVAL = dplyr::case_when(+ dplyr::filter(PARAMCD == "DOSE" | PARAMCD == "NDOSE") %>% |
|
| 198 | +121 | 3x |
- PARAMCD != "BBMRKR1" | PARAMCD != "BECOG" ~ round(AVAL, 1),+ dplyr::mutate( |
|
| 199 | +122 | 3x |
- TRUE ~ round(AVAL)+ AVISIT = rep(visit_schedule(visit_format = visit_format, n_assessments = n_assessments, n_days = n_days), 2) |
|
| 200 | +123 |
- ))+ ) |
||
| 201 | +124 | |||
| 202 | +125 | 3x |
- adsub <- adsub %>%+ adex <- dplyr::left_join( |
|
| 203 | +126 | 3x |
- dplyr::mutate(+ adex %>% |
|
| 204 | +127 | 3x |
- AVALC = dplyr::case_when(+ dplyr::group_by( |
|
| 205 | +128 | 3x |
- PARAMCD == "BBMRKR1" ~ dplyr::case_when(+ USUBJID, |
|
| 206 | +129 | 3x |
- AVAL == "1" ~ "WILD TYPE",+ STUDYID, |
|
| 207 | +130 | 3x |
- AVAL == "2" ~ "MUTANT",+ PARAM, |
|
| 208 | +131 | 3x |
- TRUE ~ ""- |
- |
| 209 | -- |
- ),+ PARAMCD, |
||
| 210 | +132 | 3x |
- TRUE ~ as.character(AVAL)+ AVALU, |
|
| 211 | -+ | |||
| 133 | +3x |
- ),+ PARCAT1, |
||
| 212 | +134 | 3x |
- AVALU = dplyr::case_when(+ PARCAT2 |
|
| 213 | -3x | +|||
| 135 | +
- PARAMCD == "BWGHTSI" ~ "kg",+ ) %>% |
|||
| 214 | +136 | 3x |
- PARAMCD == "BHGHTSI" ~ "m",+ dplyr::mutate(id = dplyr::row_number()), |
|
| 215 | +137 | 3x |
- PARAMCD == "BBMISI" ~ "kg/m2",+ adex_visit %>% |
|
| 216 | +138 | 3x |
- TRUE ~ ""+ dplyr::group_by( |
|
| 217 | -+ | |||
| 139 | +3x |
- ),+ USUBJID, |
||
| 218 | +140 | 3x |
- AVALCAT1 = dplyr::case_when(+ STUDYID, |
|
| 219 | +141 | 3x |
- PARAMCD == "BBMISI" ~ dplyr::case_when(+ PARAM, |
|
| 220 | +142 | 3x |
- AVAL < 18.5 ~ "<18.5",+ PARAMCD, |
|
| 221 | +143 | 3x |
- AVAL >= 18.5 & AVAL < 25 ~ "18.5 - 24.9",+ AVALU, |
|
| 222 | +144 | 3x |
- AVAL >= 25 & AVAL < 30 ~ "25 - 29.9",+ PARCAT1, |
|
| 223 | +145 | 3x |
- TRUE ~ ">30"+ PARCAT2 |
|
| 224 | +146 |
- ),+ ) %>% |
||
| 225 | +147 | 3x |
- PARAMCD == "BECOG" ~ dplyr::case_when(+ dplyr::mutate(id = dplyr::row_number()), |
|
| 226 | +148 | 3x |
- AVAL <= 1 ~ "0-1",+ by = c("USUBJID", "STUDYID", "PARCAT1", "PARCAT2", "id", "PARAMCD", "PARAM", "AVALU")
|
|
| 227 | -3x | +|||
| 149 | +
- AVAL > 1 & AVAL <= 3 ~ "2-3",+ ) %>% |
|||
| 228 | +150 | 3x |
- TRUE ~ "4-5"+ dplyr::select(-"id") |
|
| 229 | +151 |
- ),- |
- ||
| 230 | -3x | -
- TRUE ~ ""+ |
||
| 231 | +152 |
- ),+ # Visit numbers |
||
| 232 | +153 | 3x |
- AVISITN = "0",+ adex <- adex %>% dplyr::mutate(AVISITN = dplyr::case_when( |
|
| 233 | +154 | 3x |
- SRCSEQ = "1"+ AVISIT == "SCREENING" ~ -1, |
|
| 234 | -+ | |||
| 155 | +3x |
- ) %>%+ AVISIT == "BASELINE" ~ 0, |
||
| 235 | +156 | 3x |
- dplyr::arrange(+ (grepl("^WEEK", AVISIT) | grepl("^CYCLE", AVISIT)) ~ as.numeric(AVISIT) - 2,
|
|
| 236 | +157 | 3x |
- USUBJID,+ TRUE ~ 999000 |
|
| 237 | -3x | +|||
| 158 | +
- factor(PARAMCD, levels = c("BWGHTSI", "BHGHTSI", "BBMISI", "BECOG", "BBMRKR1"))
+ )) |
|||
| 238 | +159 |
- )+ |
||
| 239 | +160 | |||
| 240 | +161 | 3x |
- if (length(na_vars) > 0 && na_percentage > 0) {
+ adex2 <- split(adex, adex$USUBJID) %>% |
|
| 241 | -! | +|||
| 162 | +3x |
- adsub <- mutate_na(ds = adsub, na_vars = na_vars, na_percentage = na_percentage)+ lapply(function(pinfo) {
|
||
| 242 | -+ | |||
| 163 | +30x |
- }+ pinfo %>% |
||
| 243 | -+ | |||
| 164 | +30x |
-
+ dplyr::filter(PARAMCD == "DOSE") %>% |
||
| 244 | -+ | |||
| 165 | +30x |
- # Apply metadata.+ dplyr::group_by(USUBJID, PARCAT2, AVISIT) %>% |
||
| 245 | -3x | +166 | +30x |
- adsub <- apply_metadata(adsub, "metadata/ADSUB.yml")+ dplyr::mutate(changeind = dplyr::case_when( |
| 246 | -+ | |||
| 167 | +30x |
-
+ AVISIT == "SCREENING" ~ 0, |
||
| 247 | -3x | +168 | +30x |
- return(adsub)+ AVISIT != "SCREENING" ~ sample(c(-1, 0, 1), |
| 248 | -+ | |||
| 169 | +30x |
- }+ size = 1, |
| 1 | -+ | |||
| 170 | +30x |
- #' ECG Analysis Dataset (ADEG)+ prob = c(0.25, 0.5, 0.25), |
||
| 2 | -+ | |||
| 171 | +30x |
- #'+ replace = TRUE |
||
| 3 | +172 |
- #' @description `r lifecycle::badge("stable")`
+ ) |
||
| 4 | +173 |
- #'+ )) %>% |
||
| 5 | -+ | |||
| 174 | +30x |
- #' Function for generating random dataset from ECG Analysis Dataset for a given+ dplyr::ungroup() %>% |
||
| 6 | -+ | |||
| 175 | +30x |
- #' Subject-Level Analysis Dataset.+ dplyr::group_by(USUBJID, PARCAT2) %>% |
||
| 7 | -+ | |||
| 176 | +30x |
- #'+ dplyr::mutate( |
||
| 8 | -+ | |||
| 177 | +30x |
- #' @details One record per subject per parameter per analysis visit per analysis date.+ csum = cumsum(changeind), |
||
| 9 | -+ | |||
| 178 | +30x |
- #'+ changeind = dplyr::case_when( |
||
| 10 | -+ | |||
| 179 | +30x |
- #' Keys: `STUDYID`, `USUBJID`, `PARAMCD`, `BASETYPE`, `AVISITN`, `ATPTN`, `DTYPE`, `ADTM`, `EGSEQ`, `ASPID`+ csum <= -3 ~ sample(c(0, 1), size = 1, prob = c(0.5, 0.5)), |
||
| 11 | -+ | |||
| 180 | +30x |
- #'+ csum >= 3 ~ sample(c(0, -1), size = 1, prob = c(0.5, 0.5)), |
||
| 12 | -+ | |||
| 181 | +30x |
- #' @inheritParams argument_convention+ TRUE ~ changeind |
||
| 13 | +182 |
- #' @param egcat (`character vector`)\cr EG category values.+ ) |
||
| 14 | +183 |
- #' @param max_n_eg (`integer`)\cr Maximum number of EG results per patient. Defaults to 10.+ ) %>% |
||
| 15 | -+ | |||
| 184 | +30x |
- #' @template param_cached+ dplyr::mutate(csum = cumsum(changeind)) %>% |
||
| 16 | -+ | |||
| 185 | +30x |
- #' @templateVar data adeg+ dplyr::ungroup() %>% |
||
| 17 | -+ | |||
| 186 | +30x |
- #'+ dplyr::group_by(USUBJID, PARCAT2, AVISIT) %>% |
||
| 18 | -+ | |||
| 187 | +30x |
- #' @return `data.frame`+ dplyr::mutate(AVAL = dplyr::case_when( |
||
| 19 | -+ | |||
| 188 | +30x |
- #' @export+ csum == -2 ~ 480, |
||
| 20 | -+ | |||
| 189 | +30x |
- #'+ csum == -1 ~ 720, |
||
| 21 | -+ | |||
| 190 | +30x |
- #' @author tomlinsj, npaszty, Xuefeng Hou, dipietrc+ csum == 0 ~ 960, |
||
| 22 | -+ | |||
| 191 | +30x |
- #'+ csum == 1 ~ 1200, |
||
| 23 | -+ | |||
| 192 | +30x |
- #' @examples+ csum == 2 ~ 1440 |
||
| 24 | +193 |
- #' adsl <- radsl(N = 10, seed = 1, study_duration = 2)+ )) %>% |
||
| 25 | -+ | |||
| 194 | +30x |
- #'+ dplyr::select(-c("csum", "changeind")) %>%
|
||
| 26 | -+ | |||
| 195 | +30x |
- #' adeg <- radeg(adsl, visit_format = "WEEK", n_assessments = 7L, seed = 2)+ dplyr::ungroup() |
||
| 27 | +196 |
- #' adeg+ }) %>% |
||
| 28 | -+ | |||
| 197 | +3x |
- #'+ Reduce(rbind, .) |
||
| 29 | +198 |
- #' adeg <- radeg(adsl, visit_format = "CYCLE", n_assessments = 2L, seed = 2)+ |
||
| 30 | -+ | |||
| 199 | +3x |
- #' adeg+ adex_tmp <- dplyr::full_join(adex2, adex, by = names(adex)) |
||
| 31 | -+ | |||
| 200 | +3x |
- radeg <- function(adsl,+ adex <- adex_tmp %>% |
||
| 32 | -+ | |||
| 201 | +3x |
- egcat = c("INTERVAL", "INTERVAL", "MEASUREMENT", "FINDING"),
+ dplyr::group_by(USUBJID) %>% |
||
| 33 | -+ | |||
| 202 | +3x |
- param = c(+ dplyr::mutate(AVAL = ifelse(PARAMCD == "NDOSE", 1, AVAL)) %>% |
||
| 34 | -+ | |||
| 203 | +3x |
- "QT Duration",+ dplyr::mutate(AVAL = ifelse( |
||
| 35 | -+ | |||
| 204 | +3x |
- "RR Duration",+ PARAMCD == "TNDOSE", |
||
| 36 | -+ | |||
| 205 | +3x |
- "Heart Rate",+ sum(AVAL[PARAMCD == "NDOSE"]), |
||
| 37 | -+ | |||
| 206 | +3x |
- "ECG Interpretation"+ AVAL |
||
| 38 | +207 |
- ),+ )) %>% |
||
| 39 | -+ | |||
| 208 | +3x |
- paramcd = c("QT", "RR", "HR", "ECGINTP"),
+ dplyr::ungroup() %>% |
||
| 40 | -+ | |||
| 209 | +3x |
- paramu = c("msec", "msec", "beats/min", ""),
+ dplyr::group_by(USUBJID, STUDYID, PARCAT2) %>% |
||
| 41 | -+ | |||
| 210 | +3x |
- visit_format = "WEEK",+ dplyr::mutate(AVAL = ifelse( |
||
| 42 | -+ | |||
| 211 | +3x |
- n_assessments = 5L,+ PARAMCD == "TDOSE", |
||
| 43 | -+ | |||
| 212 | +3x |
- n_days = 5L,+ sum(AVAL[PARAMCD == "DOSE"]), |
||
| 44 | -+ | |||
| 213 | +3x |
- max_n_eg = 10L,+ AVAL |
||
| 45 | +214 |
- lookup = NULL,+ )) |
||
| 46 | +215 |
- seed = NULL,+ |
||
| 47 | -+ | |||
| 216 | +3x |
- na_percentage = 0,+ adex <- var_relabel( |
||
| 48 | -+ | |||
| 217 | +3x |
- na_vars = list(+ adex, |
||
| 49 | -+ | |||
| 218 | +3x |
- ABLFL = c(1235, 0.1), BASE = c(NA, 0.1), BASEC = c(NA, 0.1),+ STUDYID = "Study Identifier",+ |
+ ||
| 219 | +3x | +
+ USUBJID = "Unique Subject Identifier" |
||
| 50 | +220 |
- CHG = c(1234, 0.1), PCHG = c(1234, 0.1)+ ) |
||
| 51 | +221 |
- ),+ |
||
| 52 | +222 |
- cached = FALSE) {
+ # merge ADSL to be able to add ADEX date and study day variables |
||
| 53 | -4x | +223 | +3x |
- checkmate::assert_flag(cached)+ adex <- dplyr::inner_join(adex, adsl, by = c("STUDYID", "USUBJID")) %>%
|
| 54 | -4x | +224 | +3x |
- if (cached) {
+ dplyr::rowwise() %>% |
| 55 | -1x | +225 | +3x |
- return(get_cached_data("cadeg"))
+ dplyr::mutate(TRTENDT = lubridate::date(dplyr::case_when( |
| 56 | -+ | |||
| 226 | +3x |
- }+ is.na(TRTEDTM) ~ lubridate::floor_date(lubridate::date(TRTSDTM) + study_duration_secs, unit = "day"), |
||
| 57 | -+ | |||
| 227 | +3x |
-
+ TRUE ~ TRTEDTM |
||
| 58 | -3x | +|||
| 228 | +
- checkmate::assert_data_frame(adsl)+ ))) %>% |
|||
| 59 | +229 | 3x |
- checkmate::assert_character(egcat, min.len = 1, any.missing = FALSE)+ dplyr::mutate(ASTDTM = sample( |
|
| 60 | +230 | 3x |
- checkmate::assert_character(param, min.len = 1, any.missing = FALSE)+ seq(lubridate::as_datetime(TRTSDTM), lubridate::as_datetime(TRTENDT), by = "day"), |
|
| 61 | +231 | 3x |
- checkmate::assert_character(paramcd, min.len = 1, any.missing = FALSE)+ size = 1 |
|
| 62 | -3x | +|||
| 232 | +
- checkmate::assert_character(paramu, min.len = 1, any.missing = FALSE)+ )) %>% |
|||
| 63 | -3x | +|||
| 233 | +
- checkmate::assert_string(visit_format)+ # add 1 to end of range incase both values passed to sample() are the same |
|||
| 64 | +234 | 3x |
- checkmate::assert_integer(n_assessments, len = 1, any.missing = FALSE)+ dplyr::mutate(AENDTM = sample( |
|
| 65 | +235 | 3x |
- checkmate::assert_integer(n_days, len = 1, any.missing = FALSE)+ seq(lubridate::as_datetime(ASTDTM), lubridate::as_datetime(TRTENDT + 1), by = "day"), |
|
| 66 | +236 | 3x |
- checkmate::assert_integer(max_n_eg, len = 1, any.missing = FALSE)+ size = 1 |
|
| 67 | -3x | +|||
| 237 | +
- checkmate::assert_data_frame(lookup, null.ok = TRUE)+ )) %>% |
|||
| 68 | +238 | 3x |
- checkmate::assert_number(seed, null.ok = TRUE)+ dplyr::select(-TRTENDT) %>% |
|
| 69 | +239 | 3x |
- checkmate::assert_number(na_percentage, lower = 0, upper = 1)+ dplyr::ungroup() %>% |
|
| 70 | +240 | 3x |
- checkmate::assert_true(na_percentage < 1)+ dplyr::arrange(STUDYID, USUBJID, ASTDTM) |
|
| 71 | +241 | |||
| 72 | +242 |
- # validate and initialize related variables+ |
||
| 73 | +243 | 3x |
- egcat_init_list <- relvar_init(param, egcat)+ adex <- adex %>% |
|
| 74 | +244 | 3x |
- param_init_list <- relvar_init(param, paramcd)+ dplyr::group_by(USUBJID) %>% |
|
| 75 | +245 | 3x |
- unit_init_list <- relvar_init(param, paramu)- |
- |
| 76 | -- |
-
+ dplyr::mutate(EXSEQ = seq_len(dplyr::n())) %>% |
||
| 77 | +246 | 3x |
- if (!is.null(seed)) {
+ dplyr::mutate(ASEQ = EXSEQ) %>% |
|
| 78 | +247 | 3x |
- set.seed(seed)- |
- |
| 79 | -- |
- }+ dplyr::ungroup() %>% |
||
| 80 | +248 | 3x |
- study_duration_secs <- lubridate::seconds(attr(adsl, "study_duration_secs"))- |
- |
| 81 | -- |
-
+ dplyr::arrange( |
||
| 82 | +249 | 3x |
- adeg <- expand.grid(+ STUDYID, |
|
| 83 | +250 | 3x |
- STUDYID = unique(adsl$STUDYID),+ USUBJID, |
|
| 84 | +251 | 3x |
- USUBJID = adsl$USUBJID,+ PARAMCD, |
|
| 85 | +252 | 3x |
- PARAM = as.factor(param_init_list$relvar1),+ ASTDTM, |
|
| 86 | +253 | 3x |
- AVISIT = visit_schedule(visit_format = visit_format, n_assessments = n_assessments, n_days = n_days),+ AVISITN, |
|
| 87 | +254 | 3x |
- stringsAsFactors = FALSE+ EXSEQ |
|
| 88 | +255 |
- )+ ) |
||
| 89 | +256 | |||
| 90 | +257 |
- # assign related variable values: PARAMxEGCAT are related+ # Adding EXDOSFRQ |
||
| 91 | +258 | 3x |
- adeg <- adeg %>% rel_var(+ adex <- adex %>% |
|
| 92 | +259 | 3x |
- var_name = "EGCAT",+ dplyr::mutate(EXDOSFRQ = dplyr::case_when( |
|
| 93 | +260 | 3x |
- related_var = "PARAM",+ PARCAT1 == "INDIVIDUAL" ~ "ONCE", |
|
| 94 | +261 | 3x |
- var_values = egcat_init_list$relvar2+ TRUE ~ "" |
|
| 95 | +262 |
- )+ )) |
||
| 96 | +263 | |||
| 97 | +264 |
- # assign related variable values: PARAMxPARAMCD are related- |
- ||
| 98 | -3x | -
- adeg <- adeg %>% rel_var(+ # Adding EXROUTE |
||
| 99 | +265 | 3x |
- var_name = "PARAMCD",+ adex <- adex %>% |
|
| 100 | +266 | 3x |
- related_var = "PARAM",+ dplyr::mutate(EXROUTE = dplyr::case_when( |
|
| 101 | +267 | 3x |
- var_values = param_init_list$relvar2- |
- |
| 102 | -- |
- )- |
- ||
| 103 | -- |
-
+ PARCAT1 == "INDIVIDUAL" ~ sample(c("INTRAVENOUS", "SUBCUTANEOUS"),
|
||
| 104 | +268 | 3x |
- adeg <- adeg %>% dplyr::mutate(AVAL = dplyr::case_when(+ nrow(adex), |
|
| 105 | +269 | 3x |
- PARAMCD == "QT" ~ stats::rnorm(nrow(adeg), mean = 350, sd = 100),+ replace = TRUE, |
|
| 106 | +270 | 3x |
- PARAMCD == "RR" ~ stats::rnorm(nrow(adeg), mean = 1050, sd = 300),+ prob = c(0.9, 0.1) |
|
| 107 | -3x | +|||
| 271 | +
- PARAMCD == "HR" ~ stats::rnorm(nrow(adeg), mean = 70, sd = 20),+ ), |
|||
| 108 | +272 | 3x |
- PARAMCD == "ECGINTP" ~ NA_real_+ TRUE ~ "" |
|
| 109 | +273 |
- ))+ )) |
||
| 110 | +274 | |||
| 111 | -3x | +|||
| 275 | +
- adeg <- adeg %>%+ # Fix VISIT according to AVISIT |
|||
| 112 | +276 | 3x |
- dplyr::mutate(EGTESTCD = PARAMCD) %>%+ adex <- adex %>% |
|
| 113 | +277 | 3x |
- dplyr::mutate(EGTEST = PARAM)+ dplyr::mutate(VISIT = AVISIT) |
|
| 114 | +278 | |||
| 115 | -3x | -
- adeg <- adeg %>% dplyr::mutate(AVISITN = dplyr::case_when(- |
- ||
| 116 | -3x | +|||
| 279 | +
- AVISIT == "SCREENING" ~ -1,+ # Hack for VISITDY - to fix in ADSL |
|||
| 117 | +280 | 3x |
- AVISIT == "BASELINE" ~ 0,+ visit_levels <- str_extract(levels(adex$VISIT), pattern = "[0-9]+") |
|
| 118 | +281 | 3x |
- (grepl("^WEEK", AVISIT) | grepl("^CYCLE", AVISIT)) ~ as.numeric(AVISIT) - 2,
+ vl_extracted <- vapply(visit_levels, function(x) as.numeric(x[2]), numeric(1)) |
|
| 119 | +282 | 3x |
- TRUE ~ NA_real_+ vl_extracted <- c(-1, 1, vl_extracted[!is.na(vl_extracted)]) |
|
| 120 | +283 |
- ))+ |
||
| 121 | +284 | - - | -||
| 122 | -3x | -
- adeg <- adeg %>% rel_var(- |
- ||
| 123 | -3x | -
- var_name = "AVALU",+ # Adding VISITDY |
||
| 124 | +285 | 3x |
- related_var = "PARAM",+ adex <- adex %>% |
|
| 125 | +286 | 3x |
- var_values = unit_init_list$relvar2- |
- |
| 126 | -- |
- )+ dplyr::mutate(VISITDY = as.numeric(as.character(factor(VISIT, labels = vl_extracted)))) |
||
| 127 | +287 | |||
| 128 | +288 |
- # order to prepare for change from screening and baseline values+ # Exposure time stamps |
||
| 129 | +289 | 3x |
- adeg <- adeg[order(adeg$STUDYID, adeg$USUBJID, adeg$PARAMCD, adeg$AVISITN), ]- |
- |
| 130 | -- |
-
+ adex <- adex %>% |
||
| 131 | +290 | 3x |
- adeg <- Reduce(rbind, lapply(split(adeg, adeg$USUBJID), function(x) {
+ dplyr::mutate( |
|
| 132 | -30x | +291 | +3x |
- x$STUDYID <- adsl$STUDYID[which(adsl$USUBJID == x$USUBJID[1])]+ EXSTDTC = TRTSDTM + lubridate::days(VISITDY), |
| 133 | -30x | +292 | +3x |
- x$ABLFL <- ifelse(toupper(visit_format) == "WEEK" & x$AVISIT == "BASELINE",+ EXENDTC = EXSTDTC + lubridate::hours(1), |
| 134 | -30x | +293 | +3x |
- "Y",+ EXSTDY = VISITDY, |
| 135 | -30x | +294 | +3x |
- ifelse(toupper(visit_format) == "CYCLE" & x$AVISIT == "CYCLE 1 DAY 1", "Y", "")+ EXENDY = VISITDY |
| 136 | +295 |
) |
||
| 137 | -30x | -
- x- |
- ||
| 138 | -- |
- }))- |
- ||
| 139 | +296 | |||
| 140 | -3x | -
- adeg$BASE <- ifelse(adeg$AVISITN >= 0, retain(adeg, adeg$AVAL, adeg$ABLFL == "Y"), adeg$AVAL)- |
- ||
| 141 | +297 | - - | -||
| 142 | -3x | -
- adeg <- adeg %>% dplyr::mutate(ANRLO = dplyr::case_when(+ # Correcting last exposure to treatment |
||
| 143 | +298 | 3x |
- PARAMCD == "QT" ~ 200,+ adex <- adex %>% |
|
| 144 | +299 | 3x |
- PARAMCD == "RR" ~ 600,+ dplyr::group_by(SUBJID) %>% |
|
| 145 | +300 | 3x |
- PARAMCD == "HR" ~ 40,+ dplyr::mutate(TRTEDTM = lubridate::as_datetime(max(EXENDTC, na.rm = TRUE))) %>% |
|
| 146 | +301 | 3x |
- PARAMCD == "ECGINTP" ~ NA_real_+ dplyr::ungroup() |
|
| 147 | +302 |
- ))+ |
||
| 148 | +303 |
-
+ # Fixing Date - to add into ADSL |
||
| 149 | +304 | 3x |
- adeg <- adeg %>% dplyr::mutate(ANRHI = dplyr::case_when(+ adex <- adex %>% |
|
| 150 | +305 | 3x |
- PARAMCD == "QT" ~ 500,+ dplyr::mutate( |
|
| 151 | +306 | 3x |
- PARAMCD == "RR" ~ 1500,+ TRTSDT = lubridate::date(TRTSDTM), |
|
| 152 | +307 | 3x |
- PARAMCD == "HR" ~ 100,+ TRTEDT = lubridate::date(TRTEDTM) |
|
| 153 | -3x | +|||
| 308 | +
- PARAMCD == "ECGINTP" ~ NA_real_+ ) |
|||
| 154 | +309 |
- ))+ |
||
| 155 | +310 |
-
+ # Fixing analysis time stamps |
||
| 156 | +311 | 3x |
- adeg <- adeg %>% dplyr::mutate(ANRIND = factor(dplyr::case_when(+ adex <- adex %>% |
|
| 157 | +312 | 3x |
- AVAL < ANRLO ~ "LOW",+ dplyr::mutate( |
|
| 158 | +313 | 3x |
- AVAL >= ANRLO & AVAL <= ANRHI ~ "NORMAL",+ ASTDY = EXSTDY, |
|
| 159 | +314 | 3x |
- AVAL > ANRHI ~ "HIGH"+ AENDY = EXENDY,+ |
+ |
| 315 | +3x | +
+ ASTDTM = EXSTDTC,+ |
+ ||
| 316 | +3x | +
+ AENDTM = EXENDTC |
||
| 160 | +317 |
- )))+ ) |
||
| 161 | +318 | |||
| 162 | +319 | 3x |
- adeg <- adeg %>%+ if (length(na_vars) > 0 && na_percentage > 0) {
|
|
| 163 | -3x | +|||
| 320 | +! |
- dplyr::mutate(CHG = ifelse(AVISITN > 0, AVAL - BASE, NA)) %>%+ adex <- mutate_na(ds = adex, na_vars = na_vars, na_percentage = na_percentage) |
||
| 164 | -3x | +|||
| 321 | +
- dplyr::mutate(PCHG = ifelse(AVISITN > 0, 100 * (CHG / BASE), NA)) %>%+ } |
|||
| 165 | -3x | +|||
| 322 | +
- dplyr::mutate(BASETYPE = "LAST") %>%+ |
|||
| 166 | -3x | +|||
| 323 | +
- dplyr::group_by(USUBJID, PARAMCD, BASETYPE) %>%+ # apply metadata |
|||
| 167 | +324 | 3x |
- dplyr::mutate(BNRIND = ANRIND[ABLFL == "Y"]) %>%+ adex <- apply_metadata(adex, "metadata/ADEX.yml") |
|
| 168 | -3x | +|||
| 325 | +
- dplyr::ungroup() %>%+ } |
|||
| 169 | -3x | +|||
| 326 | +
- dplyr::mutate(ATPTN = 1) %>%+ |
|||
| 170 | -3x | +|||
| 327 | +
- dplyr::mutate(DTYPE = NA) %>%+ # Equivalent of stringr::str_extract_all() |
|||
| 171 | -3x | +|||
| 328 | +
- var_relabel(+ str_extract <- function(string, pattern) {
|
|||
| 172 | -3x | +329 | +2850x |
- STUDYID = attr(adeg$STUDYID, "label"),+ regmatches(string, gregexpr(pattern, string)) |
| 173 | -3x | +|||
| 330 | +
- USUBJID = attr(adeg$USUBJID, "label")+ } |
| 174 | +1 |
- )+ #' Medical History Analysis Dataset (ADMH) |
||
| 175 | +2 |
-
+ #' |
||
| 176 | -3x | +|||
| 3 | +
- adeg$ANRIND <- factor(adeg$ANRIND, levels = c("LOW", "NORMAL", "HIGH"))
+ #' @description `r lifecycle::badge("stable")`
|
|||
| 177 | -3x | +|||
| 4 | +
- adeg$BNRIND <- factor(adeg$BNRIND, levels = c("LOW", "NORMAL", "HIGH"))
+ #' |
|||
| 178 | +5 |
-
+ #' Function for generating a random Medical History Analysis Dataset for a given |
||
| 179 | -3x | +|||
| 6 | +
- adeg <- var_relabel(+ #' Subject-Level Analysis Dataset. |
|||
| 180 | -3x | +|||
| 7 | +
- adeg,+ #' |
|||
| 181 | -3x | +|||
| 8 | +
- STUDYID = "Study Identifier",+ #' @details One record per each record in the corresponding SDTM domain. |
|||
| 182 | -3x | +|||
| 9 | +
- USUBJID = "Unique Subject Identifier"+ #' |
|||
| 183 | +10 |
- )+ #' Keys: `STUDYID`, `USUBJID`, `ASTDTM`, `MHSEQ` |
||
| 184 | +11 |
-
+ #' |
||
| 185 | +12 |
- # merge ADSL to be able to add EG date and study day variables+ #' @inheritParams argument_convention |
||
| 186 | -3x | +|||
| 13 | +
- adeg <- dplyr::inner_join(+ #' @param max_n_mhs (`integer`)\cr Maximum number of MHs per patient. Defaults to 10. |
|||
| 187 | -3x | +|||
| 14 | +
- adeg,+ #' @template param_cached |
|||
| 188 | -3x | +|||
| 15 | +
- adsl,+ #' @templateVar data admh |
|||
| 189 | -3x | +|||
| 16 | +
- by = c("STUDYID", "USUBJID")
+ #' |
|||
| 190 | +17 |
- ) %>%+ #' @return `data.frame` |
||
| 191 | -3x | +|||
| 18 | +
- dplyr::rowwise() %>%+ #' @export |
|||
| 192 | -3x | +|||
| 19 | +
- dplyr::mutate(TRTENDT = lubridate::date(dplyr::case_when(+ #' |
|||
| 193 | -3x | +|||
| 20 | +
- is.na(TRTEDTM) ~ lubridate::floor_date(lubridate::date(TRTSDTM) + study_duration_secs, unit = "day"),+ #' @examples |
|||
| 194 | -3x | +|||
| 21 | +
- TRUE ~ TRTEDTM+ #' adsl <- radsl(N = 10, study_duration = 2, seed = 1) |
|||
| 195 | +22 |
- ))) %>%+ #' |
||
| 196 | -3x | +|||
| 23 | +
- dplyr::ungroup()+ #' admh <- radmh(adsl, seed = 2) |
|||
| 197 | +24 |
-
+ #' admh |
||
| 198 | -3x | +|||
| 25 | +
- adeg <- adeg %>%+ radmh <- function(adsl, |
|||
| 199 | -3x | +|||
| 26 | +
- dplyr::group_by(USUBJID) %>%+ max_n_mhs = 10L, |
|||
| 200 | -3x | +|||
| 27 | +
- dplyr::arrange(USUBJID, AVISITN) %>%+ lookup = NULL, |
|||
| 201 | -3x | +|||
| 28 | +
- dplyr::mutate(ADTM = rep(+ seed = NULL,+ |
+ |||
| 29 | ++ |
+ na_percentage = 0,+ |
+ ||
| 30 | ++ |
+ na_vars = list(MHBODSYS = c(NA, 0.1), MHDECOD = c(1234, 0.1)),+ |
+ ||
| 31 | ++ |
+ cached = FALSE) {
|
||
| 202 | -3x | +32 | +4x |
- sort(sample(+ checkmate::assert_flag(cached) |
| 203 | -3x | +33 | +4x |
- seq(lubridate::as_datetime(TRTSDTM[1]), lubridate::as_datetime(TRTENDT[1]), by = "day"),+ if (cached) {
|
| 204 | -3x | +34 | +1x |
- size = nlevels(AVISIT)+ return(get_cached_data("cadmh"))
|
| 205 | +35 |
- )),+ } |
||
| 206 | -3x | +|||
| 36 | +
- each = n() / nlevels(AVISIT)+ |
|||
| 207 | -+ | |||
| 37 | +3x |
- )) %>%+ checkmate::assert_data_frame(adsl) |
||
| 208 | +38 | 3x |
- dplyr::ungroup() %>%+ checkmate::assert_integer(max_n_mhs, len = 1, any.missing = FALSE) |
|
| 209 | +39 | 3x |
- dplyr::mutate(ADY = ceiling(difftime(ADTM, TRTSDTM, units = "days"))) %>%+ checkmate::assert_number(seed, null.ok = TRUE) |
|
| 210 | +40 | 3x |
- dplyr::select(-TRTENDT) %>%+ checkmate::assert_number(na_percentage, lower = 0, upper = 1) |
|
| 211 | +41 | 3x |
- dplyr::arrange(STUDYID, USUBJID, ADTM)+ checkmate::assert_true(na_percentage < 1) |
|
| 212 | +42 | |||
| 213 | +43 | 3x |
- adeg <- adeg %>%+ checkmate::assert_data_frame(lookup, null.ok = TRUE) |
|
| 214 | +44 | 3x |
- dplyr::mutate(ASPID = sample(seq_len(dplyr::n()))) %>%+ lookup_mh <- if (!is.null(lookup)) {
|
|
| 215 | -3x | +|||
| 45 | +! |
- dplyr::group_by(USUBJID) %>%+ lookup |
||
| 216 | -3x | +|||
| 46 | +
- dplyr::mutate(EGSEQ = seq_len(dplyr::n())) %>%+ } else {
|
|||
| 217 | +47 | 3x |
- dplyr::mutate(ASEQ = EGSEQ) %>%+ tibble::tribble( |
|
| 218 | +48 | 3x |
- dplyr::ungroup() %>%+ ~MHBODSYS, ~MHDECOD, ~MHSOC, |
|
| 219 | +49 | 3x |
- dplyr::arrange(+ "cl A", "trm A_1/2", "cl A", |
|
| 220 | +50 | 3x |
- STUDYID,+ "cl A", "trm A_2/2", "cl A", |
|
| 221 | +51 | 3x |
- USUBJID,+ "cl B", "trm B_1/3", "cl B", |
|
| 222 | +52 | 3x |
- PARAMCD,+ "cl B", "trm B_2/3", "cl B", |
|
| 223 | +53 | 3x |
- BASETYPE,+ "cl B", "trm B_3/3", "cl B", |
|
| 224 | +54 | 3x |
- AVISITN,+ "cl C", "trm C_1/2", "cl C", |
|
| 225 | +55 | 3x |
- ATPTN,+ "cl C", "trm C_2/2", "cl C", |
|
| 226 | +56 | 3x |
- DTYPE,+ "cl D", "trm D_1/3", "cl D", |
|
| 227 | +57 | 3x |
- ADTM,+ "cl D", "trm D_2/3", "cl D", |
|
| 228 | +58 | 3x |
- EGSEQ,+ "cl D", "trm D_3/3", "cl D" |
|
| 229 | -3x | +|||
| 59 | +
- ASPID+ ) |
|||
| 230 | +60 |
- )+ } |
||
| 231 | +61 | |||
| 232 | +62 | 3x |
- adeg <- adeg %>% dplyr::mutate(ONTRTFL = factor(dplyr::case_when(+ if (!is.null(seed)) {
|
|
| 233 | +63 | 3x |
- !AVISIT %in% c("SCREENING", "BASELINE") ~ "Y",
+ set.seed(seed) |
|
| 234 | -3x | +|||
| 64 | +
- TRUE ~ ""+ } |
|||
| 235 | -+ | |||
| 65 | +3x |
- )))+ study_duration_secs <- lubridate::seconds(attr(adsl, "study_duration_secs")) |
||
| 236 | +66 | |||
| 237 | +67 | 3x |
- adeg <- adeg %>% dplyr::mutate(AVALC = ifelse(+ admh <- Map( |
|
| 238 | +68 | 3x |
- PARAMCD == "ECGINTP",+ function(id, sid) {
|
|
| 239 | -3x | +69 | +30x |
- as.character(sample_fct(c("ABNORMAL", "NORMAL"), nrow(adeg), prob = c(0.25, 0.75))),
+ n_mhs <- sample(0:max_n_mhs, 1) |
| 240 | -3x | +70 | +30x |
- as.character(AVAL)+ i <- sample(seq_len(nrow(lookup_mh)), n_mhs, TRUE) |
| 241 | -+ | |||
| 71 | +30x |
- ))+ dplyr::mutate( |
||
| 242 | -+ | |||
| 72 | +30x |
-
+ lookup_mh[i, ],+ |
+ ||
| 73 | +30x | +
+ USUBJID = id,+ |
+ ||
| 74 | +30x | +
+ STUDYID = sid |
||
| 243 | +75 |
- # Temporarily creating a row_check column to easily match newly created+ ) |
||
| 244 | +76 |
- # observations with their row correct arrangement.+ }, |
||
| 245 | +77 | 3x |
- adeg <- adeg %>%+ adsl$USUBJID, |
|
| 246 | +78 | 3x |
- dplyr::mutate(row_check = seq_len(nrow(adeg)))+ adsl$STUDYID |
|
| 247 | +79 |
-
+ ) %>% |
||
| 248 | -+ | |||
| 80 | +3x |
- # Created function to add in new observations for DTYPE, "MINIMUM" & "MAXIMUM" in this case.+ Reduce(rbind, .) %>% |
||
| 249 | +81 | 3x |
- get_groups <- function(data,+ `[`(c(4, 5, 1, 2, 3)) %>% |
|
| 250 | +82 | 3x |
- minimum) {
+ dplyr::mutate(MHTERM = MHDECOD) |
|
| 251 | -6x | +|||
| 83 | +
- data <- data %>%+ |
|||
| 252 | -6x | +84 | +3x |
- dplyr::group_by(USUBJID, PARAMCD, BASETYPE) %>%+ admh <- var_relabel( |
| 253 | -6x | +85 | +3x |
- dplyr::arrange(ADTM, ASPID, EGSEQ) %>%+ admh, |
| 254 | -6x | +86 | +3x |
- dplyr::filter(+ STUDYID = "Study Identifier", |
| 255 | -6x | +87 | +3x |
- (AVISIT != "BASELINE" & AVISIT != "SCREENING") &+ USUBJID = "Unique Subject Identifier" |
| 256 | -6x | +|||
| 88 | +
- (ONTRTFL == "Y" | ADTM <= TRTSDTM)+ ) |
|||
| 257 | +89 |
- ) %>%+ |
||
| 258 | +90 |
- {
+ # merge ADSL to be able to add MH date and study day variables |
||
| 259 | -6x | +91 | +3x |
- if (minimum == TRUE) {
+ admh <- dplyr::inner_join( |
| 260 | +92 | 3x |
- dplyr::filter(., AVAL == min(AVAL)) %>%+ admh, |
|
| 261 | +93 | 3x |
- dplyr::mutate(., DTYPE = "MINIMUM", AVISIT = "POST-BASELINE MINIMUM")+ adsl,+ |
+ |
| 94 | +3x | +
+ by = c("STUDYID", "USUBJID")
|
||
| 262 | +95 |
- } else {
+ ) %>% |
||
| 263 | +96 | 3x |
- dplyr::filter(., AVAL == max(AVAL)) %>%+ dplyr::rowwise() %>% |
|
| 264 | +97 | 3x |
- dplyr::mutate(., DTYPE = "MAXIMUM", AVISIT = "POST-BASELINE MAXIMUM")+ dplyr::mutate(TRTENDT = lubridate::date(dplyr::case_when( |
|
| 265 | -+ | |||
| 98 | +3x |
- }+ is.na(TRTEDTM) ~ lubridate::floor_date(lubridate::date(TRTSDTM) + study_duration_secs, unit = "day"),+ |
+ ||
| 99 | +3x | +
+ TRUE ~ TRTEDTM |
||
| 266 | +100 |
- } %>%+ ))) %>% |
||
| 267 | -6x | +101 | +3x |
- dplyr::slice(1) %>%+ dplyr::mutate(ASTDTM = sample( |
| 268 | -6x | +102 | +3x |
- dplyr::ungroup()+ seq(lubridate::as_datetime(TRTSDTM), lubridate::as_datetime(TRTENDT), by = "day"), |
| 269 | -+ | |||
| 103 | +3x |
-
+ size = 1+ |
+ ||
| 104 | ++ |
+ )) %>% |
||
| 270 | -6x | +105 | +3x |
- return(data)+ dplyr::mutate(ASTDY = ceiling(difftime(ASTDTM, TRTSDTM, units = "days"))) %>% |
| 271 | +106 |
- }+ # add 1 to end of range incase both values passed to sample() are the same |
||
| 272 | -+ | |||
| 107 | +3x |
-
+ dplyr::mutate(AENDTM = sample(+ |
+ ||
| 108 | +3x | +
+ seq(lubridate::as_datetime(ASTDTM), lubridate::as_datetime(TRTENDT + 1), by = "day"),+ |
+ ||
| 109 | +3x | +
+ size = 1 |
||
| 273 | +110 |
- # Binding the new observations to the dataset from the function above and rearranging in the correct order.+ )) %>% |
||
| 274 | +111 | 3x |
- adeg <- rbind(adeg, get_groups(adeg, TRUE), get_groups(adeg, FALSE)) %>%+ dplyr::mutate(AENDY = ceiling(difftime(AENDTM, TRTSDTM, units = "days"))) %>% |
|
| 275 | +112 | 3x |
- dplyr::arrange(row_check) %>%+ select(-TRTENDT) %>% |
|
| 276 | +113 | 3x |
- dplyr::group_by(USUBJID, PARAMCD, BASETYPE) %>%+ dplyr::ungroup() %>% |
|
| 277 | +114 | 3x |
- dplyr::arrange(AVISIT, .by_group = TRUE) %>%+ dplyr::arrange(STUDYID, USUBJID, ASTDTM, MHTERM) %>% |
|
| 278 | +115 | 3x |
- dplyr::ungroup()+ dplyr::mutate(MHDISTAT = sample( |
|
| 279 | -+ | |||
| 116 | +3x |
-
+ x = c("Resolved", "Ongoing with treatment", "Ongoing without treatment"),
|
||
| 280 | -+ | |||
| 117 | +3x |
- # Dropping the "row_check" column created above.+ prob = c(0.6, 0.2, 0.2), |
||
| 281 | +118 | 3x |
- adeg <- adeg[, -which(names(adeg) %in% c("row_check"))]
+ size = dplyr::n(), |
|
| 282 | -+ | |||
| 119 | +3x |
-
+ replace = TRUE |
||
| 283 | +120 |
- # Created function to easily match rows which comply to ONTRTFL derivation+ )) %>% |
||
| 284 | +121 | 3x |
- flag_variables <- function(data, worst_obs) {
+ dplyr::mutate(ATIREL = dplyr::case_when( |
|
| 285 | -6x | +122 | +3x |
- data_compare <- data %>%+ (AENDTM < TRTSDTM | (is.na(AENDTM) & MHDISTAT == "Resolved")) ~ "PRIOR", |
| 286 | -6x | +123 | +3x |
- dplyr::mutate(row_check = seq_len(nrow(data)))+ (AENDTM >= TRTSDTM | (is.na(AENDTM) & grepl("Ongoing", MHDISTAT))) ~ "PRIOR_CONCOMITANT"
|
| 287 | +124 | - - | -||
| 288 | -6x | -
- data <- data_compare %>%+ )) |
||
| 289 | +125 |
- {
+
|
||
| 290 | -6x | +126 | +3x |
- if (worst_obs == FALSE) {
+ admh <- admh %>% |
| 291 | +127 | 3x |
- dplyr::group_by(., USUBJID, PARAMCD, BASETYPE, AVISIT) %>%+ dplyr::group_by(USUBJID) %>% |
|
| 292 | +128 | 3x |
- dplyr::arrange(., ADTM, ASPID, EGSEQ)+ dplyr::mutate(MHSEQ = seq_len(dplyr::n())) %>% |
|
| 293 | -+ | |||
| 129 | +3x |
- } else {
+ dplyr::mutate(ASEQ = MHSEQ) %>% |
||
| 294 | +130 | 3x |
- dplyr::group_by(., USUBJID, PARAMCD, BASETYPE)+ dplyr::ungroup() %>% |
|
| 295 | -+ | |||
| 131 | +3x |
- }+ dplyr::arrange(STUDYID, USUBJID, ASTDTM, MHSEQ) |
||
| 296 | +132 |
- } %>%+ |
||
| 297 | -6x | +133 | +3x |
- dplyr::filter(+ if (length(na_vars) > 0 && na_percentage > 0 && na_percentage <= 1) {
|
| 298 | -6x | +|||
| 134 | +! |
- AVISITN > 0 & (ONTRTFL == "Y" | ADTM <= TRTSDTM) &+ admh <- mutate_na(ds = admh, na_vars = na_vars, na_percentage = na_percentage) |
||
| 299 | -6x | +|||
| 135 | +
- is.na(DTYPE)+ } |
|||
| 300 | +136 |
- ) %>%+ |
||
| 301 | +137 |
- {
+ # apply metadata |
||
| 302 | -6x | +138 | +3x |
- if (worst_obs == TRUE) {
+ admh <- apply_metadata(admh, "metadata/ADMH.yml") |
| 303 | -3x | +|||
| 139 | +
- dplyr::arrange(., AVALC) %>% dplyr::filter(., ifelse(+ |
|||
| 304 | +140 | 3x |
- PARAMCD == "ECGINTP",+ return(admh) |
|
| 305 | -3x | +|||
| 141 | +
- ifelse(AVALC == "ABNORMAL", AVALC == "ABNORMAL", AVALC == "NORMAL"),+ } |
|||
| 306 | -3x | +
| 1 | +
- AVAL == min(AVAL)+ #' Adverse Event Analysis Dataset (ADAE) |
|||
| 307 | +2 |
- ))+ #' |
||
| 308 | +3 |
- } else {
+ #' @description `r lifecycle::badge("stable")`
|
||
| 309 | -3x | +|||
| 4 | +
- dplyr::filter(., ifelse(+ #' |
|||
| 310 | -3x | +|||
| 5 | +
- PARAMCD == "ECGINTP",+ #' Function for generating random Adverse Event Analysis Dataset for a given |
|||
| 311 | -3x | +|||
| 6 | +
- AVALC == "ABNORMAL" | AVALC == "NORMAL",+ #' Subject-Level Analysis Dataset. |
|||
| 312 | -3x | +|||
| 7 | +
- AVAL == min(AVAL)+ #' |
|||
| 313 | +8 |
- ))+ #' @details One record per each record in the corresponding SDTM domain. |
||
| 314 | +9 |
- }+ #' |
||
| 315 | +10 |
- } %>%+ #' Keys: `STUDYID`, `USUBJID`, `ASTDTM`, `AETERM`, `AESEQ` |
||
| 316 | -6x | +|||
| 11 | +
- dplyr::slice(1) %>%+ #' |
|||
| 317 | +12 |
- {
+ #' @inheritParams argument_convention |
||
| 318 | -6x | +|||
| 13 | +
- if (worst_obs == TRUE) {
+ #' @param max_n_aes (`integer`)\cr Maximum number of AEs per patient. Defaults to 10. |
|||
| 319 | -3x | +|||
| 14 | +
- dplyr::mutate(., new_var = dplyr::case_when(+ #' @template param_cached |
|||
| 320 | -3x | +|||
| 15 | +
- (AVALC == "ABNORMAL" | AVALC == "NORMAL") ~ "Y",+ #' @templateVar data adae |
|||
| 321 | -3x | +|||
| 16 | +
- (!is.na(AVAL) & is.na(DTYPE)) ~ "Y",+ #' |
|||
| 322 | -3x | +|||
| 17 | +
- TRUE ~ ""+ #' @return `data.frame` |
|||
| 323 | +18 |
- ))+ #' @export |
||
| 324 | +19 |
- } else {
+ #' |
||
| 325 | -3x | +|||
| 20 | +
- dplyr::mutate(., new_var = dplyr::case_when(+ #' @examples |
|||
| 326 | -3x | +|||
| 21 | +
- (AVALC == "ABNORMAL" | AVALC == "NORMAL") ~ "Y",+ #' adsl <- radsl(N = 10, study_duration = 2, seed = 1) |
|||
| 327 | -3x | +|||
| 22 | +
- (!is.na(AVAL) & is.na(DTYPE)) ~ "Y",+ #' |
|||
| 328 | -3x | +|||
| 23 | +
- TRUE ~ ""+ #' adae <- radae(adsl, seed = 2) |
|||
| 329 | +24 |
- ))+ #' adae |
||
| 330 | +25 |
- }+ #' |
||
| 331 | +26 |
- } %>%+ #' # Add metadata. |
||
| 332 | -6x | +|||
| 27 | +
- dplyr::ungroup()+ #' aag <- utils::read.table( |
|||
| 333 | +28 |
-
+ #' sep = ",", header = TRUE, |
||
| 334 | -6x | +|||
| 29 | +
- data_compare$new_var <- ifelse(data_compare$row_check %in% data$row_check, "Y", "")+ #' text = paste( |
|||
| 335 | -6x | +|||
| 30 | +
- data_compare <- data_compare[, -which(names(data_compare) %in% c("row_check"))]
+ #' "NAMVAR,SRCVAR,GRPTYPE,REFNAME,REFTERM,SCOPE", |
|||
| 336 | +31 |
-
+ #' "CQ01NAM,AEDECOD,CUSTOM,D.2.1.5.3/A.1.1.1.1 AESI,dcd D.2.1.5.3,", |
||
| 337 | -6x | +|||
| 32 | +
- return(data_compare)+ #' "CQ01NAM,AEDECOD,CUSTOM,D.2.1.5.3/A.1.1.1.1 AESI,dcd A.1.1.1.1,", |
|||
| 338 | +33 |
- }+ #' "SMQ01NAM,AEDECOD,SMQ,C.1.1.1.3/B.2.2.3.1 AESI,dcd C.1.1.1.3,BROAD", |
||
| 339 | +34 |
-
+ #' "SMQ01NAM,AEDECOD,SMQ,C.1.1.1.3/B.2.2.3.1 AESI,dcd B.2.2.3.1,BROAD", |
||
| 340 | -3x | +|||
| 35 | +
- adeg <- flag_variables(adeg, FALSE) %>% dplyr::rename(WORS01FL = "new_var")+ #' "SMQ02NAM,AEDECOD,SMQ,Y.9.9.9.9/Z.9.9.9.9 AESI,dcd Y.9.9.9.9,NARROW", |
|||
| 341 | -3x | +|||
| 36 | +
- adeg <- flag_variables(adeg, TRUE) %>% dplyr::rename(WORS02FL = "new_var")+ #' "SMQ02NAM,AEDECOD,SMQ,Y.9.9.9.9/Z.9.9.9.9 AESI,dcd Z.9.9.9.9,NARROW", |
|||
| 342 | +37 |
-
+ #' sep = "\n" |
||
| 343 | -3x | +|||
| 38 | +
- adeg <- adeg %>% dplyr::mutate(ANL01FL = factor(ifelse(+ #' ), stringsAsFactors = FALSE |
|||
| 344 | -3x | +|||
| 39 | +
- (ABLFL == "Y" | (is.na(DTYPE) & WORS01FL == "Y")) &+ #' ) |
|||
| 345 | -3x | +|||
| 40 | +
- (AVISIT != "SCREENING"),+ #' |
|||
| 346 | -3x | +|||
| 41 | +
- "Y",+ #' adae <- radae(adsl, lookup_aag = aag) |
|||
| 347 | +42 |
- ""+ #' |
||
| 348 | +43 |
- )))+ #' with( |
||
| 349 | +44 |
-
+ #' adae, |
||
| 350 | -3x | +|||
| 45 | +
- adeg <- adeg %>%+ #' cbind( |
|||
| 351 | -3x | +|||
| 46 | +
- dplyr::group_by(USUBJID, PARAMCD, BASETYPE) %>%+ #' table(AEDECOD, SMQ01NAM), |
|||
| 352 | -3x | +|||
| 47 | +
- dplyr::mutate(BASEC = ifelse(+ #' table(AEDECOD, CQ01NAM) |
|||
| 353 | -3x | +|||
| 48 | +
- PARAMCD == "ECGINTP",+ #' ) |
|||
| 354 | -3x | +|||
| 49 | +
- AVALC[AVISIT == "BASELINE"],+ #' ) |
|||
| 355 | -3x | +|||
| 50 | +
- as.character(BASE)+ radae <- function(adsl, |
|||
| 356 | +51 |
- )) %>%+ max_n_aes = 10L, |
||
| 357 | -3x | +|||
| 52 | +
- dplyr::mutate(ANL03FL = dplyr::case_when(+ lookup = NULL, |
|||
| 358 | -3x | +|||
| 53 | +
- DTYPE == "MINIMUM" ~ "Y",+ lookup_aag = NULL, |
|||
| 359 | -3x | +|||
| 54 | +
- ABLFL == "Y" & PARAMCD != "ECGINTP" ~ "Y",+ seed = NULL, |
|||
| 360 | -3x | +|||
| 55 | +
- TRUE ~ ""+ na_percentage = 0, |
|||
| 361 | +56 |
- )) %>%+ na_vars = list( |
||
| 362 | -3x | +|||
| 57 | +
- dplyr::mutate(ANL04FL = dplyr::case_when(+ AEBODSYS = c(NA, 0.1), |
|||
| 363 | -3x | +|||
| 58 | +
- DTYPE == "MAXIMUM" ~ "Y",+ AEDECOD = c(1234, 0.1), |
|||
| 364 | -3x | +|||
| 59 | +
- ABLFL == "Y" & PARAMCD != "ECGINTP" ~ "Y",+ AETOXGR = c(1234, 0.1) |
|||
| 365 | -3x | +|||
| 60 | +
- TRUE ~ ""+ ), |
|||
| 366 | +61 |
- )) %>%+ cached = FALSE) {
|
||
| 367 | -3x | -
- dplyr::ungroup()- |
- ||
| 368 | -+ | 62 | +4x |
-
+ checkmate::assert_flag(cached) |
| 369 | -3x | +63 | +4x |
- if (length(na_vars) > 0 && na_percentage > 0) {
+ if (cached) {
|
| 370 | -! | +|||
| 64 | +1x |
- adeg <- mutate_na(ds = adeg, na_vars = na_vars, na_percentage = na_percentage)+ return(get_cached_data("cadae"))
|
||
| 371 | +65 |
} |
||
| 372 | +66 | |||
| 373 | -+ | |||
| 67 | +3x |
- # apply metadata+ checkmate::assert_data_frame(adsl) |
||
| 374 | +68 | 3x |
- adeg <- apply_metadata(adeg, "metadata/ADEG.yml")+ checkmate::assert_integer(max_n_aes, len = 1, any.missing = FALSE) |
|
| 375 | -+ | |||
| 69 | +3x |
-
+ checkmate::assert_number(seed, null.ok = TRUE) |
||
| 376 | +70 | 3x |
- return(adeg)+ checkmate::assert_number(na_percentage, lower = 0, upper = 1) |
|
| 377 | -+ | |||
| 71 | +3x |
- }+ checkmate::assert_true(na_percentage < 1) |
| 1 | +72 |
- #' Time to Adverse Event Analysis Dataset (ADAETTE)+ |
||
| 2 | +73 |
- #'+ # check lookup parameters |
||
| 3 | -+ | |||
| 74 | +3x |
- #' @description `r lifecycle::badge("stable")`
+ checkmate::assert_data_frame(lookup, null.ok = TRUE) |
||
| 4 | -+ | |||
| 75 | +3x |
- #'+ lookup_ae <- if (!is.null(lookup)) {
|
||
| 5 | -+ | |||
| 76 | +! |
- #' Function to generate random Time-to-AE Dataset for a+ lookup |
||
| 6 | +77 |
- #' given Subject-Level Analysis Dataset.+ } else {
|
||
| 7 | -+ | |||
| 78 | +3x |
- #'+ tibble::tribble( |
||
| 8 | -+ | |||
| 79 | +3x |
- #' @details+ ~AEBODSYS, ~AELLT, ~AEDECOD, ~AEHLT, ~AEHLGT, ~AETOXGR, ~AESOC, ~AESER, ~AEREL, |
||
| 9 | -+ | |||
| 80 | +3x |
- #'+ "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", |
||
| 10 | -+ | |||
| 81 | +3x |
- #' Keys: `STUDYID`, `USUBJID`, `PARAMCD`+ "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", |
||
| 11 | -+ | |||
| 82 | +3x |
- #'+ "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", |
||
| 12 | -+ | |||
| 83 | +3x |
- #' @inheritParams argument_convention+ "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", |
||
| 13 | -+ | |||
| 84 | +3x |
- #' @param event_descr (`character vector`)\cr Descriptions of events. Defaults to `NULL`.+ "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", |
||
| 14 | -+ | |||
| 85 | +3x |
- #' @param censor_descr (`character vector`)\cr Descriptions of censors. Defaults to `NULL`.+ "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", |
||
| 15 | -+ | |||
| 86 | +3x |
- #' @template param_cached+ "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", |
||
| 16 | -+ | |||
| 87 | +3x |
- #' @templateVar data adaette+ "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", |
||
| 17 | -+ | |||
| 88 | +3x |
- #'+ "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", |
||
| 18 | -+ | |||
| 89 | +3x |
- #' @return `data.frame`+ "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" |
||
| 19 | +90 |
- #' @export+ ) |
||
| 20 | +91 |
- #'+ } |
||
| 21 | +92 |
- #' @author Xiuting Mi+ |
||
| 22 | -+ | |||
| 93 | +3x |
- #'+ checkmate::assert_data_frame(lookup_aag, null.ok = TRUE) |
||
| 23 | -+ | |||
| 94 | +3x |
- #' @examples+ aag <- if (!is.null(lookup_aag)) {
|
||
| 24 | -+ | |||
| 95 | +! |
- #' adsl <- radsl(N = 10, seed = 1, study_duration = 2)+ lookup_aag |
||
| 25 | +96 |
- #'+ } else {
|
||
| 26 | -+ | |||
| 97 | +3x |
- #' adaette <- radaette(adsl, seed = 2)+ aag <- utils::read.table( |
||
| 27 | -+ | |||
| 98 | +3x |
- #' adaette+ sep = ",", header = TRUE, |
||
| 28 | -+ | |||
| 99 | +3x |
- radaette <- function(adsl,+ text = paste( |
||
| 29 | -+ | |||
| 100 | +3x |
- event_descr = NULL,+ "NAMVAR,SRCVAR,GRPTYPE,REFNAME,REFTERM,SCOPE", |
||
| 30 | -+ | |||
| 101 | +3x |
- censor_descr = NULL,+ "CQ01NAM,AEDECOD,CUSTOM,D.2.1.5.3/A.1.1.1.1 AESI,dcd D.2.1.5.3,", |
||
| 31 | -+ | |||
| 102 | +3x |
- lookup = NULL,+ "CQ01NAM,AEDECOD,CUSTOM,D.2.1.5.3/A.1.1.1.1 AESI,dcd A.1.1.1.1,", |
||
| 32 | -+ | |||
| 103 | +3x |
- seed = NULL,+ "SMQ01NAM,AEDECOD,SMQ,C.1.1.1.3/B.2.2.3.1 AESI,dcd C.1.1.1.3,BROAD", |
||
| 33 | -+ | |||
| 104 | +3x |
- na_percentage = 0,+ "SMQ01NAM,AEDECOD,SMQ,C.1.1.1.3/B.2.2.3.1 AESI,dcd B.2.2.3.1,BROAD", |
||
| 34 | -+ | |||
| 105 | +3x |
- na_vars = list(CNSR = c(NA, 0.1), AVAL = c(1234, 0.1)),+ "SMQ02NAM,AEDECOD,SMQ,Y.9.9.9.9/Z.9.9.9.9 AESI,dcd Y.9.9.9.9,NARROW", |
||
| 35 | -+ | |||
| 106 | +3x |
- cached = FALSE) {
+ "SMQ02NAM,AEDECOD,SMQ,Y.9.9.9.9/Z.9.9.9.9 AESI,dcd Z.9.9.9.9,NARROW", |
||
| 36 | -6x | +107 | +3x |
- checkmate::assert_flag(cached)+ sep = "\n" |
| 37 | -6x | +108 | +3x |
- if (cached) {
+ ), stringsAsFactors = FALSE |
| 38 | -1x | +|||
| 109 | +
- return(get_cached_data("cadaette"))
+ ) |
|||
| 39 | +110 |
} |
||
| 40 | +111 | |||
| 41 | -5x | +112 | +3x |
- checkmate::assert_data_frame(adsl)+ if (!is.null(seed)) set.seed(seed) |
| 42 | -5x | +113 | +3x |
- checkmate::assert_character(censor_descr, null.ok = TRUE, min.len = 1, any.missing = FALSE)+ study_duration_secs <- lubridate::seconds(attr(adsl, "study_duration_secs")) |
| 43 | -5x | +|||
| 114 | +
- checkmate::assert_character(event_descr, null.ok = TRUE, min.len = 1, any.missing = FALSE)+ |
|||
| 44 | -5x | +115 | +3x |
- checkmate::assert_number(seed, null.ok = TRUE)+ adae <- Map( |
| 45 | -5x | +116 | +3x |
- checkmate::assert_number(na_percentage, lower = 0, upper = 1)+ function(id, sid) {
|
| 46 | -5x | +117 | +30x |
- checkmate::assert_true(na_percentage < 1)+ n_aes <- sample(c(0, seq_len(max_n_aes)), 1) |
| 47 | -+ | |||
| 118 | +30x |
-
+ i <- sample(seq_len(nrow(lookup_ae)), n_aes, TRUE) |
||
| 48 | -5x | +119 | +30x |
- checkmate::assert_data_frame(lookup, null.ok = TRUE)+ dplyr::mutate( |
| 49 | -5x | +120 | +30x |
- lookup_adaette <- if (!is.null(lookup)) {
+ lookup_ae[i, ], |
| 50 | -! | +|||
| 121 | +30x |
- lookup+ USUBJID = id, |
||
| 51 | -+ | |||
| 122 | +30x |
- } else {
+ STUDYID = sid |
||
| 52 | -5x | +|||
| 123 | +
- tibble::tribble(+ ) |
|||
| 53 | -5x | +|||
| 124 | +
- ~ARM, ~CATCD, ~CAT, ~LAMBDA, ~CNSR_P,+ }, |
|||
| 54 | -5x | +125 | +3x |
- "ARM A", "1", "any adverse event", 1 / 80, 0.4,+ adsl$USUBJID, |
| 55 | -5x | +126 | +3x |
- "ARM B", "1", "any adverse event", 1 / 100, 0.2,+ adsl$STUDYID |
| 56 | -5x | +|||
| 127 | +
- "ARM C", "1", "any adverse event", 1 / 60, 0.42,+ ) %>% |
|||
| 57 | -5x | +128 | +3x |
- "ARM A", "2", "any serious adverse event", 1 / 100, 0.3,+ Reduce(rbind, .) %>% |
| 58 | -5x | +129 | +3x |
- "ARM B", "2", "any serious adverse event", 1 / 150, 0.1,+ `[`(c(10, 11, 1, 2, 3, 4, 5, 6, 7, 8, 9)) %>% |
| 59 | -5x | +130 | +3x |
- "ARM C", "2", "any serious adverse event", 1 / 80, 0.32,+ dplyr::mutate(AETERM = gsub("dcd", "trm", AEDECOD)) %>%
|
| 60 | -5x | +131 | +3x |
- "ARM A", "3", "a grade 3-5 adverse event", 1 / 80, 0.2,+ dplyr::mutate(AESEV = dplyr::case_when( |
| 61 | -5x | +132 | +3x |
- "ARM B", "3", "a grade 3-5 adverse event", 1 / 100, 0.08,+ AETOXGR == 1 ~ "MILD", |
| 62 | -5x | +133 | +3x |
- "ARM C", "3", "a grade 3-5 adverse event", 1 / 60, 0.23+ AETOXGR %in% c(2, 3) ~ "MODERATE", |
| 63 | -+ | |||
| 134 | +3x |
- )+ AETOXGR %in% c(4, 5) ~ "SEVERE" |
||
| 64 | +135 |
- }+ )) |
||
| 65 | +136 | |||
| 66 | -5x | +137 | +3x |
- if (!is.null(seed)) {
+ adae <- var_relabel( |
| 67 | -5x | +138 | +3x |
- set.seed(seed)+ adae, |
| 68 | -+ | |||
| 139 | +3x |
- }+ STUDYID = "Study Identifier", |
||
| 69 | -5x | +140 | +3x |
- study_duration_secs <- lubridate::seconds(attr(adsl, "study_duration_secs"))+ USUBJID = "Unique Subject Identifier" |
| 70 | +141 | - - | -||
| 71 | -5x | -
- evntdescr_sel <- if (!is.null(event_descr)) {
+ ) |
||
| 72 | -! | +|||
| 142 | +
- event_descr+ |
|||
| 73 | +143 |
- } else {
+ # merge adsl to be able to add AE date and study day variables |
||
| 74 | -5x | +144 | +3x |
- "Preferred Term"+ adae <- dplyr::inner_join(adae, adsl, by = c("STUDYID", "USUBJID")) %>%
|
| 75 | -+ | |||
| 145 | +3x |
- }+ dplyr::rowwise() %>% |
||
| 76 | -+ | |||
| 146 | +3x |
-
+ dplyr::mutate(TRTENDT = lubridate::date(dplyr::case_when( |
||
| 77 | -5x | +147 | +3x |
- cnsdtdscr_sel <- if (!is.null(censor_descr)) {
+ is.na(TRTEDTM) ~ lubridate::floor_date(lubridate::date(TRTSDTM) + study_duration_secs, unit = "day"), |
| 78 | -! | +|||
| 148 | +3x |
- censor_descr+ TRUE ~ TRTEDTM |
||
| 79 | +149 |
- } else {
- |
- ||
| 80 | -5x | -
- c(+ ))) %>% |
||
| 81 | -5x | +150 | +3x |
- "Clinical Cut Off",+ dplyr::mutate(ASTDTM = sample( |
| 82 | -5x | +151 | +3x |
- "Completion or Discontinuation",+ seq(lubridate::as_datetime(TRTSDTM), lubridate::as_datetime(TRTENDT), by = "day"), |
| 83 | -5x | +152 | +3x |
- "End of AE Reporting Period"+ size = 1 |
| 84 | +153 |
- )+ )) %>% |
||
| 85 | -+ | |||
| 154 | +3x |
- }+ dplyr::mutate(ASTDY = ceiling(difftime(ASTDTM, TRTSDTM, units = "days"))) %>% |
||
| 86 | +155 | - - | -||
| 87 | -5x | -
- random_patient_data <- function(patient_info) {
+ # add 1 to end of range incase both values passed to sample() are the same |
||
| 88 | -50x | +156 | +3x |
- startdt <- lubridate::date(patient_info$TRTSDTM)+ dplyr::mutate(AENDTM = sample( |
| 89 | -50x | +157 | +3x |
- trtedtm <- lubridate::floor_date(dplyr::case_when(+ seq(lubridate::as_datetime(ASTDTM), lubridate::as_datetime(TRTENDT + 1), by = "day"), |
| 90 | -50x | +158 | +3x |
- is.na(patient_info$TRTEDTM) ~ lubridate::date(patient_info$TRTSDTM) + study_duration_secs,+ size = 1 |
| 91 | -50x | +|||
| 159 | +
- TRUE ~ lubridate::date(patient_info$TRTEDTM)+ )) %>% |
|||
| 92 | -50x | +160 | +3x |
- ), unit = "day")+ dplyr::mutate(AENDY = ceiling(difftime(AENDTM, TRTSDTM, units = "days"))) %>% |
| 93 | -50x | +161 | +3x |
- enddts <- c(patient_info$EOSDT, lubridate::date(trtedtm))+ dplyr::mutate(LDOSEDTM = dplyr::case_when( |
| 94 | -50x | +162 | +3x |
- enddts_min_index <- which.min(enddts)+ TRTSDTM < ASTDTM ~ lubridate::as_datetime(stats::runif(1, TRTSDTM, ASTDTM)), |
| 95 | -50x | +163 | +3x |
- adt <- enddts[enddts_min_index]+ TRUE ~ ASTDTM |
| 96 | -50x | +|||
| 164 | +
- adtm <- lubridate::as_datetime(adt)+ )) %>% |
|||
| 97 | -50x | +165 | +3x |
- ady <- as.numeric(adt - startdt + 1)+ dplyr::mutate(LDRELTM = as.numeric(difftime(ASTDTM, LDOSEDTM, units = "mins"))) %>% |
| 98 | -50x | +166 | +3x |
- data.frame(+ dplyr::select(-TRTENDT) %>% |
| 99 | -50x | +167 | +3x |
- ARM = patient_info$ARM,+ dplyr::ungroup() %>% |
| 100 | -50x | +168 | +3x |
- STUDYID = patient_info$STUDYID,+ dplyr::arrange(STUDYID, USUBJID, ASTDTM, AETERM) |
| 101 | -50x | +|||
| 169 | +
- SITEID = patient_info$SITEID,+ |
|||
| 102 | -50x | +170 | +3x |
- USUBJID = patient_info$USUBJID,+ adae <- adae %>% |
| 103 | -50x | +171 | +3x |
- PARAMCD = "AEREPTTE",+ dplyr::group_by(USUBJID) %>% |
| 104 | -50x | +172 | +3x |
- PARAM = "Time to end of AE reporting period",+ dplyr::mutate(AESEQ = seq_len(dplyr::n())) %>% |
| 105 | -50x | +173 | +3x |
- CNSR = 0,+ dplyr::mutate(ASEQ = AESEQ) %>% |
| 106 | -50x | +174 | +3x |
- AVAL = lubridate::days(ady) / lubridate::years(1),+ dplyr::ungroup() %>% |
| 107 | -50x | +175 | +3x |
- AVALU = "YEARS",+ dplyr::arrange( |
| 108 | -50x | +176 | +3x |
- EVNTDESC = ifelse(enddts_min_index == 1, "Completion or Discontinuation", "End of AE Reporting Period"),+ STUDYID, |
| 109 | -50x | +177 | +3x |
- CNSDTDSC = NA,+ USUBJID, |
| 110 | -50x | +178 | +3x |
- ADTM = adtm,+ ASTDTM, |
| 111 | -50x | +179 | +3x |
- ADY = ady,+ AETERM, |
| 112 | -50x | +180 | +3x |
- stringsAsFactors = FALSE+ AESEQ |
| 113 | +181 |
) |
||
| 114 | +182 |
- }+ |
||
| 115 | -+ | |||
| 183 | +3x |
-
+ outcomes <- c( |
||
| 116 | -+ | |||
| 184 | +3x |
- # validate and initialize related variables for Hy's law+ "UNKNOWN", |
||
| 117 | -5x | +185 | +3x |
- paramcd_hy <- c("HYSTTEUL", "HYSTTEBL")
+ "NOT RECOVERED/NOT RESOLVED", |
| 118 | -5x | +186 | +3x |
- param_hy <- c("Time to Hy's Law Elevation in relation to ULN", "Time to Hy's Law Elevation in relation to Baseline")
+ "RECOVERED/RESOLVED WITH SEQUELAE", |
| 119 | -5x | +187 | +3x |
- param_init_list <- relvar_init(param_hy, paramcd_hy)+ "RECOVERING/RESOLVING", |
| 120 | -5x | +188 | +3x |
- adsl_hy <- dplyr::select(adsl, "STUDYID", "USUBJID", "TRTSDTM", "SITEID", "ARM")+ "RECOVERED/RESOLVED" |
| 121 | +189 |
-
+ ) |
||
| 122 | +190 |
- # create all combinations of unique values in STUDYID, USUBJID, PARAM, AVISIT+ |
||
| 123 | -5x | +191 | +3x |
- adaette_hy <- expand.grid(+ actions <- c( |
| 124 | -5x | +192 | +3x |
- STUDYID = unique(adsl$STUDYID),+ "DOSE RATE REDUCED", |
| 125 | -5x | +193 | +3x |
- USUBJID = adsl$USUBJID,+ "UNKNOWN", |
| 126 | -5x | +194 | +3x |
- PARAM = as.factor(param_init_list$relvar1),+ "NOT APPLICABLE", |
| 127 | -5x | +195 | +3x |
- stringsAsFactors = FALSE+ "DRUG INTERRUPTED", |
| 128 | -+ | |||
| 196 | +3x |
- )+ "DRUG WITHDRAWN", |
||
| 129 | -+ | |||
| 197 | +3x |
-
+ "DOSE INCREASED", |
||
| 130 | -+ | |||
| 198 | +3x |
- # Add other variables to adaette_hy+ "DOSE NOT CHANGED", |
||
| 131 | -5x | +199 | +3x |
- adaette_hy <- dplyr::left_join(adaette_hy, adsl_hy, by = c("STUDYID", "USUBJID")) %>%
+ "DOSE REDUCED", |
| 132 | -5x | +200 | +3x |
- rel_var(+ "NOT EVALUABLE"+ |
+
| 201 | ++ |
+ )+ |
+ ||
| 202 | ++ | + | ||
| 133 | -5x | +203 | +3x |
- var_name = "PARAMCD",+ adae <- adae %>% |
| 134 | -5x | +204 | +3x |
- related_var = "PARAM",+ dplyr::mutate(AEOUT = factor(ifelse( |
| 135 | -5x | +205 | +3x |
- var_values = param_init_list$relvar2+ AETOXGR == "5",+ |
+
| 206 | +3x | +
+ "FATAL",+ |
+ ||
| 207 | +3x | +
+ as.character(sample_fct(outcomes, nrow(adae), prob = c(0.1, 0.2, 0.1, 0.3, 0.3))) |
||
| 136 | +208 |
- ) %>%+ ))) %>% |
||
| 137 | -5x | +209 | +3x |
- dplyr::mutate(+ dplyr::mutate(AEACN = factor(ifelse( |
| 138 | -5x | +210 | +3x |
- CNSR = sample(c(0, 1), prob = c(0.1, 0.9), size = dplyr::n(), replace = TRUE),+ AETOXGR == "5", |
| 139 | -5x | +211 | +3x |
- EVNTDESC = dplyr::if_else(+ "NOT EVALUABLE", |
| 140 | -5x | +212 | +3x |
- CNSR == 0,+ 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)))+ |
+
| 213 | ++ |
+ ))) %>% |
||
| 141 | -5x | +214 | +3x |
- "First Post-Baseline Raised ALT or AST Elevation Result",+ dplyr::mutate(AESDTH = dplyr::case_when( |
| 142 | -5x | +215 | +3x |
- NA_character_+ AEOUT == "FATAL" ~ "Y",+ |
+
| 216 | +3x | +
+ TRUE ~ "N" |
||
| 143 | +217 |
- ),+ )) %>% |
||
| 144 | -5x | +218 | +3x |
- CNSDTDSC = dplyr::if_else(CNSR == 0, NA_character_,+ dplyr::mutate(TRTEMFL = ifelse(ASTDTM >= TRTSDTM, "Y", "")) %>% |
| 145 | -5x | +219 | +3x |
- sample(c("Last Post-Baseline ALT or AST Result", "Treatment Start"),
+ dplyr::mutate(AECONTRT = sample(c("Y", "N"), prob = c(0.4, 0.6), size = dplyr::n(), replace = TRUE)) %>%
|
| 146 | -5x | +220 | +3x |
- prob = c(0.9, 0.1),+ dplyr::mutate( |
| 147 | -5x | +221 | +3x |
- size = dplyr::n(), replace = TRUE+ ANL01FL = ifelse(TRTEMFL == "Y" & ASTDTM <= TRTEDTM + lubridate::month(1), "Y", "") |
| 148 | +222 |
- )+ ) %>% |
||
| 149 | -+ | |||
| 223 | +3x |
- )+ dplyr::mutate(ANL01FL = ifelse(is.na(ANL01FL), "", ANL01FL)) |
||
| 150 | +224 |
- ) %>%+ |
||
| 151 | -5x | +225 | +3x |
- dplyr::rowwise() %>%+ adae <- adae %>% |
| 152 | -5x | +226 | +3x |
- dplyr::mutate(ADTM = dplyr::case_when(+ dplyr::mutate(AERELNST = sample(c("Y", "N"), prob = c(0.4, 0.6), size = dplyr::n(), replace = TRUE)) %>%
|
| 153 | -5x | +227 | +3x |
- CNSDTDSC == "Treatment Start" ~ TRTSDTM,+ dplyr::mutate(AEACNOTH = sample( |
| 154 | -5x | -
- TRUE ~ TRTSDTM + sample(seq(0, study_duration_secs), size = dplyr::n(), replace = TRUE)- |
- ||
| 155 | -+ | 228 | +3x |
- )) %>%+ x = c("MEDICATION", "PROCEDURE/SURGERY", "SUBJECT DISCONTINUED FROM STUDY", "NONE"),
|
| 156 | -5x | +229 | +3x |
- dplyr::mutate(+ prob = c(0.2, 0.4, 0.2, 0.2), |
| 157 | -5x | +230 | +3x |
- ADY_int = lubridate::date(ADTM) - lubridate::date(TRTSDTM) + 1,+ size = dplyr::n(), |
| 158 | -5x | +231 | +3x |
- ADY = as.numeric(ADY_int),+ replace = TRUE |
| 159 | -5x | +|||
| 232 | +
- AVAL = lubridate::days(ADY_int) / lubridate::weeks(1),+ )) |
|||
| 160 | -5x | +|||
| 233 | +
- AVALU = "WEEKS"+ |
|||
| 161 | +234 |
- ) %>%+ # Split metadata for AEs of special interest (AESI). |
||
| 162 | -5x | +235 | +3x |
- dplyr::select(-TRTSDTM, -ADY_int)+ l_aag <- split(aag, interaction(aag$NAMVAR, aag$SRCVAR, aag$GRPTYPE, drop = TRUE)) |
| 163 | +236 | |||
| 164 | -5x | +|||
| 237 | +
- random_ae_data <- function(lookup_info, patient_info, patient_data) {
+ # Create AESI flags |
|||
| 165 | -150x | +238 | +3x |
- cnsr <- sample(c(0, 1), 1, prob = c(1 - lookup_info$CNSR_P, lookup_info$CNSR_P))+ l_aesi <- lapply(l_aag, function(d_adag, d_adae) {
|
| 166 | -150x | +239 | +9x |
- ae_rep_tte <- patient_data$AVAL[patient_data$PARAMCD == "AEREPTTE"]+ names(d_adag)[names(d_adag) == "REFTERM"] <- d_adag$SRCVAR[1] |
| 167 | -150x | +240 | +9x |
- data.frame(+ names(d_adag)[names(d_adag) == "REFNAME"] <- d_adag$NAMVAR[1] |
| 168 | -150x | +|||
| 241 | +
- ARM = rep(patient_data$ARM, 2),+ |
|||
| 169 | -150x | +242 | +9x |
- STUDYID = rep(patient_data$STUDYID, 2),+ if (d_adag$GRPTYPE[1] == "CUSTOM") {
|
| 170 | -150x | +243 | +3x |
- SITEID = rep(patient_data$SITEID, 2),+ d_adag <- d_adag[-which(names(d_adag) == "SCOPE")] |
| 171 | -150x | +244 | +6x |
- USUBJID = rep(patient_data$USUBJID, 2),+ } else if (d_adag$GRPTYPE[1] == "SMQ") {
|
| 172 | -150x | +245 | +6x |
- PARAMCD = c(+ names(d_adag)[names(d_adag) == "SCOPE"] <- paste0(substr(d_adag$NAMVAR[1], 1, 5), "SC") |
| 173 | -150x | +|||
| 246 | +
- paste0("AETTE", lookup_info$CATCD),
+ } |
|||
| 174 | -150x | +|||
| 247 | +
- paste0("AETOT", lookup_info$CATCD)
+
|
|||
| 175 | -+ | |||
| 248 | +9x |
- ),+ d_adag <- d_adag[-which(names(d_adag) %in% c("NAMVAR", "SRCVAR", "GRPTYPE"))]
|
||
| 176 | -150x | +249 | +9x |
- PARAM = c(+ d_new <- dplyr::left_join(x = d_adae, y = d_adag, by = intersect(names(d_adae), names(d_adag))) |
| 177 | -150x | +250 | +9x |
- paste("Time to first occurrence of", lookup_info$CAT),
+ d_new[, dplyr::setdiff(names(d_new), names(d_adae)), drop = FALSE] |
| 178 | -150x | +251 | +3x |
- paste("Number of occurrences of", lookup_info$CAT)
+ }, adae) |
| 179 | +252 |
- ),+ |
||
| 180 | -150x | +253 | +3x |
- CNSR = c(+ adae <- dplyr::bind_cols(adae, l_aesi)+ |
+
| 254 | ++ | + | ||
| 181 | -150x | +255 | +3x |
- cnsr,+ adae <- dplyr::mutate(adae, AERELNST = sample( |
| 182 | -150x | +256 | +3x |
- NA+ x = c("CONCURRENT ILLNESS", "OTHER", "DISEASE UNDER STUDY", "NONE"),
|
| 183 | -+ | |||
| 257 | +3x |
- ),+ prob = c(0.3, 0.3, 0.3, 0.1), |
||
| 184 | -150x | +258 | +3x |
- AVAL = c(+ size = dplyr::n(), |
| 185 | -+ | |||
| 259 | +3x |
- # We generate these values conditional on the censoring information.+ replace = TRUE |
||
| 186 | +260 |
- # If this time to event is censored, then there were no AEs reported and the time is set+ )) |
||
| 187 | +261 |
- # to the AE reporting period time. Otherwise we draw from truncated distributions to make+ |
||
| 188 | +262 |
- # sure that we are within the AE reporting time and above 0 AEs.+ |
||
| 189 | -150x | +263 | +3x |
- ifelse(cnsr == 1, ae_rep_tte, rtexp(1, lookup_info$LAMBDA * 365.25, r = ae_rep_tte)),+ adae <- adae %>% |
| 190 | -150x | +264 | +3x |
- ifelse(cnsr == 1, 0, rtpois(1, lookup_info$LAMBDA * 365.25))+ dplyr::mutate(AES_FLAG = sample( |
| 191 | -+ | |||
| 265 | +3x |
- ),+ x = c("AESLIFE", "AESHOSP", "AESDISAB", "AESCONG", "AESMIE"),
|
||
| 192 | -150x | +266 | +3x |
- AVALU = c(+ prob = c(0.1, 0.2, 0.2, 0.2, 0.3), |
| 193 | -150x | +267 | +3x |
- "YEARS",+ size = dplyr::n(), |
| 194 | -150x | +268 | +3x |
- NA+ replace = TRUE |
| 195 | +269 |
- ),+ )) %>% |
||
| 196 | -150x | +270 | +3x |
- EVNTDESC = c(+ dplyr::mutate(AES_FLAG = dplyr::case_when( |
| 197 | -150x | +271 | +3x |
- ifelse(cnsr == 0, sample(evntdescr_sel, 1), ""),+ AESDTH == "Y" ~ "AESDTH", |
| 198 | -150x | +272 | +3x |
- NA+ TRUE ~ AES_FLAG |
| 199 | +273 |
- ),+ )) %>% |
||
| 200 | -150x | +274 | +3x |
- CNSDTDSC = c(+ dplyr::mutate( |
| 201 | -150x | +275 | +3x |
- ifelse(cnsr == 1, sample(cnsdtdscr_sel, 1), ""),+ AESCONG = ifelse(AES_FLAG == "AESCONG", "Y", "N"), |
| 202 | -150x | +276 | +3x |
- NA+ AESDISAB = ifelse(AES_FLAG == "AESDISAB", "Y", "N"), |
| 203 | -+ | |||
| 277 | +3x |
- ),+ AESHOSP = ifelse(AES_FLAG == "AESHOSP", "Y", "N"), |
||
| 204 | -150x | +278 | +3x |
- stringsAsFactors = FALSE+ AESLIFE = ifelse(AES_FLAG == "AESLIFE", "Y", "N"), |
| 205 | -150x | +279 | +3x |
- ) %>% dplyr::mutate(+ AESMIE = ifelse(AES_FLAG == "AESMIE", "Y", "N") |
| 206 | -150x | +|||
| 280 | +
- ADY = dplyr::if_else(is.na(AVALU), NA_real_, ceiling(as.numeric(lubridate::dyears(AVAL), "days"))),+ ) %>% |
|||
| 207 | -150x | +281 | +3x |
- ADTM = dplyr::if_else(- |
-
| 208 | -150x | -
- is.na(AVALU),- |
- ||
| 209 | -150x | -
- lubridate::as_datetime(NA),- |
- ||
| 210 | -150x | -
- patient_info$TRTSDTM + lubridate::days(ADY)- |
- ||
| 211 | -- |
- )- |
- ||
| 212 | -- |
- )- |
- ||
| 213 | -- |
- }- |
- ||
| 214 | -- | - - | -||
| 215 | -5x | -
- adaette <- split(adsl, adsl$USUBJID) %>%- |
- ||
| 216 | -5x | -
- lapply(function(patient_info) {
- |
- ||
| 217 | -50x | -
- patient_data <- random_patient_data(patient_info)- |
- ||
| 218 | -50x | -
- lookup_arm <- lookup_adaette %>%- |
- ||
| 219 | -50x | -
- dplyr::filter(ARM == as.character(patient_info$ARMCD))- |
- ||
| 220 | -50x | -
- ae_data <- split(lookup_arm, lookup_arm$CATCD) %>%- |
- ||
| 221 | -50x | -
- lapply(random_ae_data, patient_data = patient_data, patient_info = patient_info) %>%- |
- ||
| 222 | -50x | -
- Reduce(rbind, .)- |
- ||
| 223 | -50x | -
- dplyr::bind_rows(patient_data, ae_data)- |
- ||
| 224 | -- |
- }) %>%- |
- ||
| 225 | -5x | -
- Reduce(rbind, .) %>%- |
- ||
| 226 | -5x | -
- var_relabel(- |
- ||
| 227 | -5x | -
- STUDYID = "Study Identifier",- |
- ||
| 228 | -5x | -
- USUBJID = "Unique Subject Identifier"- |
- ||
| 229 | -- |
- )- |
- ||
| 230 | -- | - - | -||
| 231 | -5x | -
- adaette <- var_relabel(- |
- ||
| 232 | -5x | -
- adaette,- |
- ||
| 233 | -5x | -
- STUDYID = "Study Identifier",- |
- ||
| 234 | -5x | -
- USUBJID = "Unique Subject Identifier"- |
- ||
| 235 | -- |
- )- |
- ||
| 236 | -- | - - | -||
| 237 | -5x | -
- adaette <- rbind(adaette, adaette_hy)- |
- ||
| 238 | -- | - - | -||
| 239 | -5x | -
- adaette <- dplyr::inner_join(- |
- ||
| 240 | -5x | -
- dplyr::select(adaette, -"SITEID", -"ARM"),- |
- ||
| 241 | -5x | -
- adsl,- |
- ||
| 242 | -5x | -
- by = c("STUDYID", "USUBJID")
- |
- ||
| 243 | -- |
- ) %>%- |
- ||
| 244 | -5x | -
- dplyr::group_by(USUBJID) %>%- |
- ||
| 245 | -5x | -
- dplyr::arrange(ADTM) %>%- |
- ||
| 246 | -5x | -
- dplyr::mutate(TTESEQ = seq_len(dplyr::n())) %>%- |
- ||
| 247 | -5x | -
- dplyr::mutate(ASEQ = TTESEQ) %>%- |
- ||
| 248 | -5x | -
- dplyr::mutate(PARAM = as.factor(PARAM)) %>%- |
- ||
| 249 | -5x | -
- dplyr::mutate(PARAMCD = as.factor(PARAMCD)) %>%- |
- ||
| 250 | -5x | -
- dplyr::ungroup() %>%- |
- ||
| 251 | -5x | -
- dplyr::arrange(- |
- ||
| 252 | -5x | -
- STUDYID,- |
- ||
| 253 | -5x | -
- USUBJID,- |
- ||
| 254 | -5x | -
- PARAMCD,- |
- ||
| 255 | -5x | -
- ADTM,- |
- ||
| 256 | -5x | -
- TTESEQ- |
- ||
| 257 | -- |
- )+ dplyr::select(-"AES_FLAG") |
||
| 258 | +282 | |||
| 259 | -5x | +283 | +3x |
if (length(na_vars) > 0 && na_percentage > 0) {
|
| 260 | +284 | ! |
- adaette <- dplyr::mutate(ds = adaette, na_vars = na_vars, na_percentage = na_percentage)+ adae <- mutate_na(ds = adae, na_vars = na_vars, na_percentage = na_percentage) |
|
| 261 | +285 |
} |
||
| 262 | +286 | |||
| 263 | +287 |
# apply metadata |
||
| 264 | -5x | +288 | +3x |
- adaette <- apply_metadata(adaette, "metadata/ADAETTE.yml")+ adae <- apply_metadata(adae, "metadata/ADAE.yml") |
| 265 | +289 | |||
| 266 | -5x | +290 | +3x |
- return(adaette)+ return(adae) |
| 267 | +291 |
}@@ -17917,14 +17410,14 @@ random.cdisc.data coverage - 98.86% |
| 1 |
- #' Load Cached Data+ #' ECG Analysis Dataset (ADEG) |
||
| 3 |
- #' Return data attached to package.+ #' @description `r lifecycle::badge("stable")`
|
||
| 5 |
- #' @keywords internal+ #' Function for generating random dataset from ECG Analysis Dataset for a given |
||
| 6 |
- #' @noRd+ #' Subject-Level Analysis Dataset. |
||
| 7 |
- get_cached_data <- function(dataname) {
+ #' |
||
| 8 | -22x | +
- checkmate::assert_string(dataname)+ #' @details One record per subject per parameter per analysis visit per analysis date. |
|
| 9 | -22x | +
- if (!("package:random.cdisc.data" %in% search())) {
+ #' |
|
| 10 | -1x | +
- stop("cached data can only be loaded if the random.cdisc.data package is attached.",
+ #' Keys: `STUDYID`, `USUBJID`, `PARAMCD`, `BASETYPE`, `AVISITN`, `ATPTN`, `DTYPE`, `ADTM`, `EGSEQ`, `ASPID` |
|
| 11 | -1x | +
- "Please run library(random.cdisc.data) before loading cached data.",+ #' |
|
| 12 | -1x | +
- call. = FALSE+ #' @inheritParams argument_convention |
|
| 13 |
- )+ #' @param egcat (`character vector`)\cr EG category values. |
||
| 14 |
- } else {
+ #' @param max_n_eg (`integer`)\cr Maximum number of EG results per patient. Defaults to 10. |
||
| 15 | -21x | +
- get(dataname, envir = asNamespace("random.cdisc.data"))
+ #' @template param_cached |
|
| 16 |
- }+ #' @templateVar data adeg |
||
| 17 |
- }+ #' |
||
| 18 |
-
+ #' @return `data.frame` |
||
| 19 |
- #' Create a Factor with Random Elements of x+ #' @export |
||
| 21 |
- #' Sample elements from `x` with replacement to build a factor.+ #' @author tomlinsj, npaszty, Xuefeng Hou, dipietrc |
||
| 23 |
- #' @param x (`character vector` or `factor`)\cr If character vector then it is also used+ #' @examples |
||
| 24 |
- #' as levels of the returned factor. If factor then the levels are used as the new levels.+ #' adsl <- radsl(N = 10, seed = 1, study_duration = 2) |
||
| 25 |
- #' @param N (`numeric`)\cr Number of items to choose.+ #' |
||
| 26 |
- #' @param ... Additional arguments to be passed to `sample`.+ #' adeg <- radeg(adsl, visit_format = "WEEK", n_assessments = 7L, seed = 2) |
||
| 27 |
- #'+ #' adeg |
||
| 28 |
- #' @return A factor of length `N`.+ #' |
||
| 29 |
- #' @keywords internal+ #' adeg <- radeg(adsl, visit_format = "CYCLE", n_assessments = 2L, seed = 2) |
||
| 30 |
- #'+ #' adeg |
||
| 31 |
- #' @examples+ radeg <- function(adsl, |
||
| 32 |
- #' random.cdisc.data:::sample_fct(letters[1:3], 10)+ egcat = c("INTERVAL", "INTERVAL", "MEASUREMENT", "FINDING"),
|
||
| 33 |
- #' random.cdisc.data:::sample_fct(iris$Species, 10)+ param = c( |
||
| 34 |
- sample_fct <- function(x, N, ...) { # nolint
+ "QT Duration", |
||
| 35 | -296x | +
- checkmate::assert_number(N)+ "RR Duration", |
|
| 36 |
-
+ "Heart Rate", |
||
| 37 | -296x | +
- factor(sample(x, N, replace = TRUE, ...), levels = if (is.factor(x)) levels(x) else x)+ "ECG Interpretation" |
|
| 38 |
- }+ ), |
||
| 39 |
-
+ paramcd = c("QT", "RR", "HR", "ECGINTP"),
|
||
| 40 |
- #' Related Variables: Initialize+ paramu = c("msec", "msec", "beats/min", ""),
|
||
| 41 |
- #'+ visit_format = "WEEK", |
||
| 42 |
- #' Verify and initialize related variable values.+ n_assessments = 5L, |
||
| 43 |
- #'+ n_days = 5L, |
||
| 44 |
- #' @param relvar1 (`list` of `character`)\cr List of n elements.+ max_n_eg = 10L, |
||
| 45 |
- #' @param relvar2 (`list` of `character`)\cr List of n elements.+ lookup = NULL, |
||
| 46 |
- #'+ seed = NULL, |
||
| 47 |
- #' @return A vector of n elements.+ na_percentage = 0, |
||
| 48 |
- #'+ na_vars = list( |
||
| 49 |
- #' @keywords internal+ ABLFL = c(1235, 0.1), BASE = c(NA, 0.1), BASEC = c(NA, 0.1), |
||
| 50 |
- #'+ CHG = c(1234, 0.1), PCHG = c(1234, 0.1) |
||
| 51 |
- #' @examples+ ), |
||
| 52 |
- #' random.cdisc.data:::relvar_init("Alanine Aminotransferase Measurement", "ALT")
+ cached = FALSE) {
|
||
| 53 | -+ | 4x |
- #' random.cdisc.data:::relvar_init("Alanine Aminotransferase Measurement", "U/L")
+ checkmate::assert_flag(cached) |
| 54 | -+ | 4x |
- relvar_init <- function(relvar1, relvar2) {
+ if (cached) {
|
| 55 | -64x | +1x |
- checkmate::assert_character(relvar1, min.len = 1, any.missing = FALSE)+ return(get_cached_data("cadeg"))
|
| 56 | -64x | +
- checkmate::assert_character(relvar2, min.len = 1, any.missing = FALSE)+ } |
|
| 58 | -64x | +3x |
- if (length(relvar1) != length(relvar2)) {
+ checkmate::assert_data_frame(adsl) |
| 59 | -1x | +3x |
- message(simpleError(+ checkmate::assert_character(egcat, min.len = 1, any.missing = FALSE) |
| 60 | -1x | +3x |
- "The argument value length of relvar1 and relvar2 differ. They must contain the same number of elements."+ checkmate::assert_character(param, min.len = 1, any.missing = FALSE) |
| 61 | -+ | 3x |
- ))+ checkmate::assert_character(paramcd, min.len = 1, any.missing = FALSE) |
| 62 | -! | +3x |
- return(NA)+ checkmate::assert_character(paramu, min.len = 1, any.missing = FALSE) |
| 63 | -+ | 3x |
- }+ checkmate::assert_string(visit_format) |
| 64 | -63x | +3x |
- return(list("relvar1" = relvar1, "relvar2" = relvar2))
+ checkmate::assert_integer(n_assessments, len = 1, any.missing = FALSE) |
| 65 | -+ | 3x |
- }+ checkmate::assert_integer(n_days, len = 1, any.missing = FALSE) |
| 66 | -+ | 3x |
-
+ checkmate::assert_integer(max_n_eg, len = 1, any.missing = FALSE) |
| 67 | -+ | 3x |
- #' Related Variables: Assign+ checkmate::assert_data_frame(lookup, null.ok = TRUE) |
| 68 | -+ | 3x |
- #'+ checkmate::assert_number(seed, null.ok = TRUE) |
| 69 | -+ | 3x |
- #' Assign values to a related variable within a domain.+ checkmate::assert_number(na_percentage, lower = 0, upper = 1) |
| 70 | -+ | 3x |
- #'+ checkmate::assert_true(na_percentage < 1) |
| 71 |
- #' @param df (`data.frame`)\cr Data frame containing the related variables.+ |
||
| 72 |
- #' @param var_name (`character`)\cr Name of variable related to `rel_var` to add to `df`.+ # validate and initialize related variables |
||
| 73 | -+ | 3x |
- #' @param var_values (`any`)\cr Vector of values related to values of `related_var`.+ egcat_init_list <- relvar_init(param, egcat) |
| 74 | -+ | 3x |
- #' @param related_var (`character`)\cr Name of variable within `df` with values to which values+ param_init_list <- relvar_init(param, paramcd) |
| 75 | -+ | 3x |
- #' of `var_name` must relate.+ unit_init_list <- relvar_init(param, paramu) |
| 76 |
- #'+ |
||
| 77 | -+ | 3x |
- #' @return `df` with added factor variable `var_name` containing `var_values` corresponding to `related_var`.+ if (!is.null(seed)) {
|
| 78 | -+ | 3x |
- #' @keywords internal+ set.seed(seed) |
| 79 |
- #'+ } |
||
| 80 | -+ | 3x |
- #' @examples+ study_duration_secs <- lubridate::seconds(attr(adsl, "study_duration_secs")) |
| 81 |
- #' # Example with data.frame.+ |
||
| 82 | -+ | 3x |
- #' params <- c("Level A", "Level B", "Level C")
+ adeg <- expand.grid( |
| 83 | -+ | 3x |
- #' adlb_df <- data.frame(+ STUDYID = unique(adsl$STUDYID), |
| 84 | -+ | 3x |
- #' ID = 1:9,+ USUBJID = adsl$USUBJID, |
| 85 | -+ | 3x |
- #' PARAM = factor(+ PARAM = as.factor(param_init_list$relvar1), |
| 86 | -+ | 3x |
- #' rep(c("Level A", "Level B", "Level C"), 3),
+ AVISIT = visit_schedule(visit_format = visit_format, n_assessments = n_assessments, n_days = n_days), |
| 87 | -+ | 3x |
- #' levels = params+ stringsAsFactors = FALSE |
| 88 |
- #' )+ ) |
||
| 89 |
- #' )+ |
||
| 90 |
- #' random.cdisc.data:::rel_var(+ # assign related variable values: PARAMxEGCAT are related |
||
| 91 | -+ | 3x |
- #' df = adlb_df,+ adeg <- adeg %>% rel_var( |
| 92 | -+ | 3x |
- #' var_name = "PARAMCD",+ var_name = "EGCAT", |
| 93 | -+ | 3x |
- #' var_values = c("A", "B", "C"),
+ related_var = "PARAM", |
| 94 | -+ | 3x |
- #' related_var = "PARAM"+ var_values = egcat_init_list$relvar2 |
| 95 |
- #' )+ ) |
||
| 96 |
- #'+ |
||
| 97 |
- #' # Example with tibble.+ # assign related variable values: PARAMxPARAMCD are related |
||
| 98 | -+ | 3x |
- #' adlb_tbl <- tibble::tibble(+ adeg <- adeg %>% rel_var( |
| 99 | -+ | 3x |
- #' ID = 1:9,+ var_name = "PARAMCD", |
| 100 | -+ | 3x |
- #' PARAM = factor(+ related_var = "PARAM", |
| 101 | -+ | 3x |
- #' rep(c("Level A", "Level B", "Level C"), 3),
+ var_values = param_init_list$relvar2 |
| 102 |
- #' levels = params+ ) |
||
| 103 |
- #' )+ |
||
| 104 | -+ | 3x |
- #' )+ adeg <- adeg %>% dplyr::mutate(AVAL = dplyr::case_when( |
| 105 | -+ | 3x |
- #' random.cdisc.data:::rel_var(+ PARAMCD == "QT" ~ stats::rnorm(nrow(adeg), mean = 350, sd = 100), |
| 106 | -+ | 3x |
- #' df = adlb_tbl,+ PARAMCD == "RR" ~ stats::rnorm(nrow(adeg), mean = 1050, sd = 300), |
| 107 | -+ | 3x |
- #' var_name = "PARAMCD",+ PARAMCD == "HR" ~ stats::rnorm(nrow(adeg), mean = 70, sd = 20), |
| 108 | -+ | 3x |
- #' var_values = c("A", "B", "C"),
+ PARAMCD == "ECGINTP" ~ NA_real_ |
| 109 |
- #' related_var = "PARAM"+ )) |
||
| 110 |
- #' )+ |
||
| 111 | -+ | 3x |
- rel_var <- function(df, var_name, related_var, var_values = NULL) {
+ adeg <- adeg %>% |
| 112 | -64x | +3x |
- checkmate::assert_data_frame(df)+ dplyr::mutate(EGTESTCD = PARAMCD) %>% |
| 113 | -64x | +3x |
- checkmate::assert_string(var_name)+ dplyr::mutate(EGTEST = PARAM) |
| 114 | -64x | +
- checkmate::assert_string(related_var)+ |
|
| 115 | -64x | +3x |
- n_relvar1 <- length(unique(df[, related_var, drop = TRUE]))+ adeg <- adeg %>% dplyr::mutate(AVISITN = dplyr::case_when( |
| 116 | -64x | +3x |
- checkmate::assert_vector(var_values, null.ok = TRUE, len = n_relvar1, any.missing = FALSE)+ AVISIT == "SCREENING" ~ -1, |
| 117 | -1x | +3x |
- if (is.null(var_values)) var_values <- rep(NA, n_relvar1)+ AVISIT == "BASELINE" ~ 0, |
| 118 | -+ | 3x |
-
+ (grepl("^WEEK", AVISIT) | grepl("^CYCLE", AVISIT)) ~ as.numeric(AVISIT) - 2,
|
| 119 | -64x | +3x |
- relvar1 <- unique(df[, related_var, drop = TRUE])+ TRUE ~ NA_real_ |
| 120 | -64x | +
- relvar2_values <- rep(NA, nrow(df))+ )) |
|
| 121 | -64x | +
- for (r in seq_len(n_relvar1)) {
+
|
|
| 122 | -538x | +3x |
- matched <- which(df[, related_var, drop = TRUE] == relvar1[r])+ adeg <- adeg %>% rel_var( |
| 123 | -538x | +3x |
- relvar2_values[matched] <- var_values[r]+ var_name = "AVALU", |
| 124 | -+ | 3x |
- }+ related_var = "PARAM", |
| 125 | -64x | +3x |
- df[[var_name]] <- factor(relvar2_values)+ var_values = unit_init_list$relvar2 |
| 126 | -64x | +
- return(df)+ ) |
|
| 127 |
- }+ |
||
| 128 |
-
+ # order to prepare for change from screening and baseline values |
||
| 129 | -+ | 3x |
- #' Create Visit Schedule+ adeg <- adeg[order(adeg$STUDYID, adeg$USUBJID, adeg$PARAMCD, adeg$AVISITN), ] |
| 130 |
- #'+ |
||
| 131 | -+ | 3x |
- #' Create a visit schedule as a factor.+ adeg <- Reduce(rbind, lapply(split(adeg, adeg$USUBJID), function(x) {
|
| 132 | -+ | 30x |
- #'+ x$STUDYID <- adsl$STUDYID[which(adsl$USUBJID == x$USUBJID[1])] |
| 133 | -+ | 30x |
- #' X number of visits, or X number of cycles and Y number of days.+ x$ABLFL <- ifelse(toupper(visit_format) == "WEEK" & x$AVISIT == "BASELINE", |
| 134 | -+ | 30x |
- #'+ "Y", |
| 135 | -+ | 30x |
- #' @inheritParams argument_convention+ ifelse(toupper(visit_format) == "CYCLE" & x$AVISIT == "CYCLE 1 DAY 1", "Y", "") |
| 136 |
- #'+ ) |
||
| 137 | -+ | 30x |
- #' @return A factor of length `n_assessments`.+ x |
| 138 |
- #' @keywords internal+ })) |
||
| 139 |
- #'+ |
||
| 140 | -+ | 3x |
- #' @examples+ adeg$BASE <- ifelse(adeg$AVISITN >= 0, retain(adeg, adeg$AVAL, adeg$ABLFL == "Y"), adeg$AVAL) |
| 141 |
- #' random.cdisc.data:::visit_schedule(visit_format = "WEeK", n_assessments = 10L)+ |
||
| 142 | -+ | 3x |
- #' random.cdisc.data:::visit_schedule(visit_format = "CyCLE", n_assessments = 5L, n_days = 2L)+ adeg <- adeg %>% dplyr::mutate(ANRLO = dplyr::case_when( |
| 143 | -+ | 3x |
- visit_schedule <- function(visit_format = "WEEK",+ PARAMCD == "QT" ~ 200, |
| 144 | -+ | 3x |
- n_assessments = 10L,+ PARAMCD == "RR" ~ 600, |
| 145 | -+ | 3x |
- n_days = 5L) {
+ PARAMCD == "HR" ~ 40, |
| 146 | -56x | +3x |
- checkmate::assert_string(visit_format, pattern = "^WEEK$|^CYCLE$", ignore.case = TRUE)+ PARAMCD == "ECGINTP" ~ NA_real_ |
| 147 | -56x | +
- checkmate::assert_integer(n_assessments, len = 1, any.missing = FALSE)+ )) |
|
| 148 | -56x | +
- checkmate::assert_integer(n_days, len = 1, any.missing = FALSE)+ |
|
| 149 | -+ | 3x |
-
+ adeg <- adeg %>% dplyr::mutate(ANRHI = dplyr::case_when( |
| 150 | -56x | +3x |
- if (toupper(visit_format) == "WEEK") {
+ PARAMCD == "QT" ~ 500, |
| 151 | -+ | 3x |
- # numeric vector of n assessments/cycles/days+ PARAMCD == "RR" ~ 1500, |
| 152 | -49x | +3x |
- assessments <- 1:n_assessments+ PARAMCD == "HR" ~ 100, |
| 153 | -+ | 3x |
- # numeric vector for ordering including screening (-1) and baseline (0) place holders+ PARAMCD == "ECGINTP" ~ NA_real_ |
| 154 | -49x | +
- assessments_ord <- -1:n_assessments+ )) |
|
| 155 |
- # character vector of nominal visit values+ |
||
| 156 | -49x | +3x |
- visit_values <- c("SCREENING", "BASELINE", paste(toupper(visit_format), assessments, "DAY", (assessments * 7) + 1))
+ adeg <- adeg %>% dplyr::mutate(ANRIND = factor(dplyr::case_when( |
| 157 | -7x | +3x |
- } else if (toupper(visit_format) == "CYCLE") {
+ AVAL < ANRLO ~ "LOW", |
| 158 | -7x | +3x |
- cycles <- sort(rep(1:n_assessments, times = 1, each = n_days))+ AVAL >= ANRLO & AVAL <= ANRHI ~ "NORMAL", |
| 159 | -7x | +3x |
- days <- rep(seq(1:n_days), times = n_assessments, each = 1)+ AVAL > ANRHI ~ "HIGH" |
| 160 | -7x | +
- assessments_ord <- 0:(n_assessments * n_days)+ ))) |
|
| 161 | -7x | +
- visit_values <- c("SCREENING", paste(toupper(visit_format), cycles, "DAY", days))
+
|
|
| 162 | -+ | 3x |
- }+ adeg <- adeg %>% |
| 163 | -+ | 3x |
-
+ dplyr::mutate(CHG = ifelse(AVISITN > 0, AVAL - BASE, NA)) %>% |
| 164 | -+ | 3x |
- # create and order factor variable to return from function+ dplyr::mutate(PCHG = ifelse(AVISITN > 0, 100 * (CHG / BASE), NA)) %>% |
| 165 | -56x | +3x |
- visit_values <- stats::reorder(factor(visit_values), assessments_ord)+ dplyr::mutate(BASETYPE = "LAST") %>% |
| 166 | -+ | 3x |
- }+ dplyr::group_by(USUBJID, PARAMCD, BASETYPE) %>% |
| 167 | -+ | 3x |
-
+ dplyr::mutate(BNRIND = ANRIND[ABLFL == "Y"]) %>% |
| 168 | -+ | 3x |
- #' Primary Keys: Retain Values+ dplyr::ungroup() %>% |
| 169 | -+ | 3x |
- #'+ dplyr::mutate(ATPTN = 1) %>% |
| 170 | -+ | 3x |
- #' Retain values within primary keys.+ dplyr::mutate(DTYPE = NA) %>% |
| 171 | -+ | 3x |
- #'+ var_relabel( |
| 172 | -+ | 3x |
- #' @param df (`data.frame`)\cr Data frame in which to apply the retain.+ STUDYID = attr(adeg$STUDYID, "label"), |
| 173 | -+ | 3x |
- #' @param value_var (`any`)\cr Variable in `df` containing the value to be retained.+ USUBJID = attr(adeg$USUBJID, "label") |
| 174 |
- #' @param event (`expression`)\cr Expression returning a logical value to trigger the retain.+ ) |
||
| 175 |
- #' @param outside (`any`)\cr Additional value to retain. Defaults to `NA`.+ |
||
| 176 | -+ | 3x |
- #'+ adeg$ANRIND <- factor(adeg$ANRIND, levels = c("LOW", "NORMAL", "HIGH"))
|
| 177 | -+ | 3x |
- #' @keywords internal+ adeg$BNRIND <- factor(adeg$BNRIND, levels = c("LOW", "NORMAL", "HIGH"))
|
| 178 |
- #'+ |
||
| 179 | -+ | 3x |
- #' @examples+ adeg <- var_relabel( |
| 180 | -+ | 3x |
- #' adlb <- radlb(radsl(N = 10, na_percentage = 0), na_vars = list())+ adeg, |
| 181 | -+ | 3x |
- #' adlb$BASE2 <- random.cdisc.data:::retain(+ STUDYID = "Study Identifier", |
| 182 | -+ | 3x |
- #' df = adlb, value_var = adlb$AVAL,+ USUBJID = "Unique Subject Identifier" |
| 183 |
- #' event = adlb$ABLFL2 == "Y"+ ) |
||
| 184 |
- #' )+ |
||
| 185 |
- retain <- function(df, value_var, event, outside = NA) {
+ # merge ADSL to be able to add EG date and study day variables |
||
| 186 | -31x | +3x |
- indices <- c(1, which(event == TRUE), nrow(df) + 1)+ adeg <- dplyr::inner_join( |
| 187 | -31x | +3x |
- values <- c(outside, value_var[event == TRUE])+ adeg, |
| 188 | -31x | +3x |
- rep(values, diff(indices))+ adsl, |
| 189 | -+ | 3x |
- }+ by = c("STUDYID", "USUBJID")
|
| 190 |
-
+ ) %>% |
||
| 191 | -+ | 3x |
- #' Primary Keys: Labels+ dplyr::rowwise() %>% |
| 192 | -+ | 3x |
- #'+ dplyr::mutate(TRTENDT = lubridate::date(dplyr::case_when( |
| 193 | -+ | 3x |
- #' Relabel a subset of variables in a data set.+ is.na(TRTEDTM) ~ lubridate::floor_date(lubridate::date(TRTSDTM) + study_duration_secs, unit = "day"), |
| 194 | -+ | 3x |
- #'+ TRUE ~ TRTEDTM |
| 195 |
- #' @param x (`data.frame`)\cr Data frame containing variables to which labels are applied.+ ))) %>% |
||
| 196 | -+ | 3x |
- #' @param ... (`named character`)\cr Name-Value pairs, where name corresponds to a variable+ dplyr::ungroup() |
| 197 |
- #' name in `x` and the value to the new variable label.+ |
||
| 198 | -+ | 3x |
- #'+ adeg <- adeg %>% |
| 199 | -+ | 3x |
- #' @keywords internal+ dplyr::group_by(USUBJID) %>% |
| 200 | -+ | 3x |
- #'+ dplyr::arrange(USUBJID, AVISITN) %>% |
| 201 | -+ | 3x |
- #' @examples+ dplyr::mutate(ADTM = rep( |
| 202 | -+ | 3x |
- #' adsl <- radsl()+ sort(sample( |
| 203 | -+ | 3x |
- #' random.cdisc.data:::var_relabel(adsl,+ seq(lubridate::as_datetime(TRTSDTM[1]), lubridate::as_datetime(TRTENDT[1]), by = "day"), |
| 204 | -+ | 3x |
- #' STUDYID = "Study Identifier",+ size = nlevels(AVISIT) |
| 205 |
- #' USUBJID = "Unique Subject Identifier"+ )), |
||
| 206 | -+ | 3x |
- #' )+ each = n() / nlevels(AVISIT) |
| 207 |
- var_relabel <- function(x, ...) {
+ )) %>% |
||
| 208 | -82x | +3x |
- dots <- list(...)+ dplyr::ungroup() %>% |
| 209 | -82x | +3x |
- varnames <- names(dots)+ dplyr::mutate(ADY = ceiling(difftime(ADTM, TRTSDTM, units = "days"))) %>% |
| 210 | -82x | +3x |
- if (is.null(varnames)) {
+ dplyr::select(-TRTENDT) %>% |
| 211 | -1x | +3x |
- stop("missing variable declarations")
+ dplyr::arrange(STUDYID, USUBJID, ADTM) |
| 212 |
- }+ |
||
| 213 | -81x | +3x |
- map_varnames <- match(varnames, names(x))+ adeg <- adeg %>% |
| 214 | -81x | +3x |
- for (i in seq_along(map_varnames)) {
+ dplyr::mutate(ASPID = sample(seq_len(dplyr::n()))) %>% |
| 215 | -161x | +3x |
- attr(x[[map_varnames[[i]]]], "label") <- dots[[i]]+ dplyr::group_by(USUBJID) %>% |
| 216 | -+ | 3x |
- }+ dplyr::mutate(EGSEQ = seq_len(dplyr::n())) %>% |
| 217 | -81x | +3x |
- x+ dplyr::mutate(ASEQ = EGSEQ) %>% |
| 218 | -+ | 3x |
- }+ dplyr::ungroup() %>% |
| 219 | -+ | 3x |
-
+ dplyr::arrange( |
| 220 | -+ | 3x |
- #' Apply Metadata+ STUDYID, |
| 221 | -+ | 3x |
- #'+ USUBJID, |
| 222 | -+ | 3x |
- #' Apply label and variable ordering attributes to domains.+ PARAMCD, |
| 223 | -+ | 3x |
- #'+ BASETYPE, |
| 224 | -+ | 3x |
- #' @param df (`data.frame`)\cr Data frame to which metadata is applied.+ AVISITN, |
| 225 | -+ | 3x |
- #' @param filename (`yaml`)\cr File containing domain metadata.+ ATPTN, |
| 226 | -+ | 3x |
- #' @param add_adsl (`logical`)\cr Should ADSL data be merged to domain.+ DTYPE, |
| 227 | -+ | 3x |
- #' @param adsl_filename (`yaml`)\cr File containing ADSL metadata.+ ADTM, |
| 228 | -+ | 3x |
- #'+ EGSEQ, |
| 229 | -+ | 3x |
- #' @keywords internal+ ASPID |
| 230 |
- #'+ ) |
||
| 231 |
- #' @examples+ |
||
| 232 | -+ | 3x |
- #' seed <- 1+ adeg <- adeg %>% dplyr::mutate(ONTRTFL = factor(dplyr::case_when( |
| 233 | -+ | 3x |
- #' adsl <- radsl(seed = seed)+ !AVISIT %in% c("SCREENING", "BASELINE") ~ "Y",
|
| 234 | -+ | 3x |
- #' adsub <- radsub(adsl, seed = seed)+ TRUE ~ "" |
| 235 |
- #' yaml_path <- file.path(path.package("random.cdisc.data"), "inst", "metadata")
+ ))) |
||
| 236 |
- #' adsl <- random.cdisc.data:::apply_metadata(adsl, file.path(yaml_path, "ADSL.yml"), FALSE)+ |
||
| 237 | -+ | 3x |
- #' adsub <- random.cdisc.data:::apply_metadata(+ adeg <- adeg %>% dplyr::mutate(AVALC = ifelse( |
| 238 | -+ | 3x |
- #' adsub, file.path(yaml_path, "ADSUB.yml"), TRUE,+ PARAMCD == "ECGINTP", |
| 239 | -+ | 3x |
- #' file.path(yaml_path, "ADSL.yml")+ as.character(sample_fct(c("ABNORMAL", "NORMAL"), nrow(adeg), prob = c(0.25, 0.75))),
|
| 240 | -+ | 3x |
- #' )+ as.character(AVAL) |
| 241 |
- apply_metadata <- function(df, filename, add_adsl = TRUE, adsl_filename = "metadata/ADSL.yml") {
+ )) |
||
| 242 | -90x | +
- checkmate::assert_data_frame(df)+ |
|
| 243 | -90x | +
- checkmate::assert_string(filename)+ # Temporarily creating a row_check column to easily match newly created |
|
| 244 | -90x | +
- checkmate::assert_flag(add_adsl)+ # observations with their row correct arrangement. |
|
| 245 | -90x | +3x |
- checkmate::assert_string(adsl_filename)+ adeg <- adeg %>% |
| 246 | -+ | 3x |
-
+ dplyr::mutate(row_check = seq_len(nrow(adeg))) |
| 247 | -90x | +
- apply_type <- function(df, var, type) {
+
|
|
| 248 | -5986x | +
- if (is.null(type)) {
+ # Created function to add in new observations for DTYPE, "MINIMUM" & "MAXIMUM" in this case. |
|
| 249 | -! | +3x |
- return()+ get_groups <- function(data, |
| 250 | -+ | 3x |
- }+ minimum) {
|
| 251 | -+ | 6x |
-
+ data <- data %>% |
| 252 | -5986x | +6x |
- if (type == "character" && !is.character(df[[var]])) {
+ dplyr::group_by(USUBJID, PARAMCD, BASETYPE) %>% |
| 253 | -12x | +6x |
- df[[var]] <<- as.character(df[[var]])+ dplyr::arrange(ADTM, ASPID, EGSEQ) %>% |
| 254 | -5974x | +6x |
- } else if (type == "factor" && !is.factor(df[[var]])) {
+ dplyr::filter( |
| 255 | -730x | +6x |
- df[[var]] <<- as.factor(df[[var]])+ (AVISIT != "BASELINE" & AVISIT != "SCREENING") & |
| 256 | -5244x | +6x |
- } else if (type == "integer" && !is.integer(df[[var]])) {
+ (ONTRTFL == "Y" | ADTM <= TRTSDTM) |
| 257 | -225x | +
- df[[var]] <<- as.integer(df[[var]])+ ) %>% |
|
| 258 | -5019x | +
- } else if (type == "numeric" && !is.numeric(df[[var]])) {
+ {
|
|
| 259 | -3x | +6x |
- df[[var]] <<- as.numeric(df[[var]])+ if (minimum == TRUE) {
|
| 260 | -5016x | +3x |
- } else if (type == "logical" && !is.logical(df[[var]])) {
+ dplyr::filter(., AVAL == min(AVAL)) %>% |
| 261 | -! | +3x |
- df[[var]] <<- as.logical(df[[var]])+ dplyr::mutate(., DTYPE = "MINIMUM", AVISIT = "POST-BASELINE MINIMUM") |
| 262 | -5016x | +
- } else if (type == "datetime" && !lubridate::is.POSIXct(df[[var]])) {
+ } else {
|
|
| 263 | -9x | +3x |
- df[[var]] <<- as.POSIXct(df[[var]])+ dplyr::filter(., AVAL == max(AVAL)) %>% |
| 264 | -5007x | +3x |
- } else if (type == "date" && !lubridate::is.Date(df[[var]])) {
+ dplyr::mutate(., DTYPE = "MAXIMUM", AVISIT = "POST-BASELINE MAXIMUM") |
| 265 | -! | +
- df[[var]] <<- as.Date(df[[var]])+ } |
|
| 266 |
- }+ } %>% |
||
| 267 | -+ | 6x |
- }+ dplyr::slice(1) %>% |
| 268 | -+ | 6x |
-
+ dplyr::ungroup() |
| 269 |
- # remove existing attributes+ |
||
| 270 | -90x | +6x |
- for (i in base::setdiff(names(attributes(df)), names(attributes(data.frame())))) {
+ return(data) |
| 271 | -3x | +
- attr(df, i) <- NULL+ } |
|
| 272 |
- }+ |
||
| 273 |
-
+ # Binding the new observations to the dataset from the function above and rearranging in the correct order. |
||
| 274 | -+ | 3x |
- # get metadata+ adeg <- rbind(adeg, get_groups(adeg, TRUE), get_groups(adeg, FALSE)) %>% |
| 275 | -90x | +3x |
- metadata <- yaml::yaml.load_file(system.file(filename, package = "random.cdisc.data"))+ dplyr::arrange(row_check) %>% |
| 276 | -90x | +3x |
- adsl_metadata <- if (add_adsl) {
+ dplyr::group_by(USUBJID, PARAMCD, BASETYPE) %>% |
| 277 | -64x | +3x |
- yaml::yaml.load_file(system.file(adsl_filename, package = "random.cdisc.data"))+ dplyr::arrange(AVISIT, .by_group = TRUE) %>% |
| 278 | -+ | 3x |
- } else {
+ dplyr::ungroup() |
| 279 | -26x | +
- NULL+ |
|
| 280 |
- }+ # Dropping the "row_check" column created above. |
||
| 281 | -90x | +3x |
- metadata_variables <- append(adsl_metadata$variables, metadata$variables)+ adeg <- adeg[, -which(names(adeg) %in% c("row_check"))]
|
| 282 | -90x | +
- metadata_varnames <- names(metadata_variables)+ |
|
| 283 |
-
+ # Created function to easily match rows which comply to ONTRTFL derivation |
||
| 284 | -+ | 3x |
- # find variables that does not have labels and are not it metadata+ flag_variables <- function(data, worst_obs) {
|
| 285 | -90x | +6x |
- missing_vars_map <- vapply(+ data_compare <- data %>% |
| 286 | -90x | +6x |
- names(df),+ dplyr::mutate(row_check = seq_len(nrow(data))) |
| 287 | -90x | +
- function(x) {
+
|
|
| 288 | -5986x | +6x |
- !(x %in% c("STUDYID", "USUBJID", metadata_varnames)) && is.null(attr(df[[x]], "label"))
+ data <- data_compare %>% |
| 289 |
- },+ {
|
||
| 290 | -90x | +6x |
- logical(1)+ if (worst_obs == FALSE) {
|
| 291 | -+ | 3x |
- )+ dplyr::group_by(., USUBJID, PARAMCD, BASETYPE, AVISIT) %>% |
| 292 | -90x | +3x |
- missing_vars <- names(df)[missing_vars_map]+ dplyr::arrange(., ADTM, ASPID, EGSEQ) |
| 293 | -90x | +
- if (length(missing_vars) > 0) {
+ } else {
|
|
| 294 | -! | +3x |
- msg <- paste0(+ dplyr::group_by(., USUBJID, PARAMCD, BASETYPE) |
| 295 | -! | +
- "Following variables does not have label or are not found in ",+ } |
|
| 296 | -! | +
- filename,+ } %>% |
|
| 297 | -+ | 6x |
- ": ",+ dplyr::filter( |
| 298 | -! | +6x |
- paste0(missing_vars, collapse = ", ")+ AVISITN > 0 & (ONTRTFL == "Y" | ADTM <= TRTSDTM) & |
| 299 | -+ | 6x |
- )+ is.na(DTYPE) |
| 300 | -! | +
- warning(msg)+ ) %>% |
|
| 301 |
- }+ {
|
||
| 302 | -+ | 6x |
-
+ if (worst_obs == TRUE) {
|
| 303 | -90x | +3x |
- if (!all(metadata_varnames %in% names(df))) {
+ dplyr::arrange(., AVALC) %>% dplyr::filter(., ifelse( |
| 304 | -6x | +3x |
- metadata_varnames <- metadata_varnames[metadata_varnames %in% names(df)]+ PARAMCD == "ECGINTP", |
| 305 | -+ | 3x |
- }+ ifelse(AVALC == "ABNORMAL", AVALC == "ABNORMAL", AVALC == "NORMAL"), |
| 306 | -+ | 3x |
-
+ AVAL == min(AVAL) |
| 307 |
- # assign labels to variables+ )) |
||
| 308 | -90x | +
- for (var in metadata_varnames) {
+ } else {
|
|
| 309 | -5986x | +3x |
- apply_type(df, var, metadata_variables[[var]]$type)+ dplyr::filter(., ifelse( |
| 310 | -5986x | +3x |
- attr(df[[var]], "label") <- metadata_variables[[var]]$label+ PARAMCD == "ECGINTP", |
| 311 | -+ | 3x |
- }+ AVALC == "ABNORMAL" | AVALC == "NORMAL", |
| 312 | -+ | 3x |
-
+ AVAL == min(AVAL) |
| 313 |
- # reorder data frame columns to expected BDS order+ )) |
||
| 314 | -90x | +
- df <- df[, unique(c("STUDYID", "USUBJID", metadata_varnames, names(df)))]
+ } |
|
| 315 |
-
+ } %>% |
||
| 316 | -+ | 6x |
- # assign label to data frame+ dplyr::slice(1) %>% |
| 317 | -90x | +
- attr(df, "label") <- metadata$domain$label+ {
|
|
| 318 | -+ | 6x |
-
+ if (worst_obs == TRUE) {
|
| 319 | -90x | +3x |
- df+ dplyr::mutate(., new_var = dplyr::case_when( |
| 320 | -+ | 3x |
- }+ (AVALC == "ABNORMAL" | AVALC == "NORMAL") ~ "Y", |
| 321 | -+ | 3x |
-
+ (!is.na(AVAL) & is.na(DTYPE)) ~ "Y", |
| 322 | -+ | 3x |
- #' Replace Values in a Vector by NA+ TRUE ~ "" |
| 323 |
- #'+ )) |
||
| 324 |
- #' @description `r lifecycle::badge("stable")`
+ } else {
|
||
| 325 | -+ | 3x |
- #'+ dplyr::mutate(., new_var = dplyr::case_when( |
| 326 | -+ | 3x |
- #' Randomized replacement of values by `NA`.+ (AVALC == "ABNORMAL" | AVALC == "NORMAL") ~ "Y", |
| 327 | -+ | 3x |
- #'+ (!is.na(AVAL) & is.na(DTYPE)) ~ "Y", |
| 328 | -+ | 3x |
- #' @inheritParams argument_convention+ TRUE ~ "" |
| 329 |
- #' @param v (`any`)\cr Vector of any type.+ )) |
||
| 330 |
- #' @param percentage (`proportion`)\cr Value between 0 and 1 defining+ } |
||
| 331 |
- #' how much of the vector shall be replaced by `NA`. This number+ } %>% |
||
| 332 | -+ | 6x |
- #' is randomized by +/- 5% to have full randomization.+ dplyr::ungroup() |
| 333 |
- #'+ |
||
| 334 | -+ | 6x |
- #' @return The input vector `v` where a certain number of values are replaced by `NA`.+ data_compare$new_var <- ifelse(data_compare$row_check %in% data$row_check, "Y", "") |
| 335 | -+ | 6x |
- #'+ data_compare <- data_compare[, -which(names(data_compare) %in% c("row_check"))]
|
| 336 |
- #' @export+ |
||
| 337 | -+ | 6x |
- replace_na <- function(v, percentage = 0.05, seed = NULL) {
+ return(data_compare) |
| 338 | -9x | +
- checkmate::assert_number(percentage, lower = 0, upper = 1)+ } |
|
| 340 | -9x | +3x |
- if (percentage == 0) {
+ adeg <- flag_variables(adeg, FALSE) %>% dplyr::rename(WORS01FL = "new_var") |
| 341 | -1x | +3x |
- return(v)+ adeg <- flag_variables(adeg, TRUE) %>% dplyr::rename(WORS02FL = "new_var") |
| 342 |
- }+ |
||
| 343 | -+ | 3x |
-
+ adeg <- adeg %>% dplyr::mutate(ANL01FL = factor(ifelse( |
| 344 | -8x | +3x |
- if (!is.null(seed) && !is.na(seed)) {
+ (ABLFL == "Y" | (is.na(DTYPE) & WORS01FL == "Y")) & |
| 345 | -8x | +3x |
- set.seed(seed)+ (AVISIT != "SCREENING"), |
| 346 | -+ | 3x |
- }+ "Y", |
| 347 |
-
+ "" |
||
| 348 |
- # randomize the percentage+ ))) |
||
| 349 | -8x | +
- ind <- sample(seq_along(v), round(length(v) * percentage))+ |
|
| 350 | -+ | 3x |
-
+ adeg <- adeg %>% |
| 351 | -8x | +3x |
- v[ind] <- NA+ dplyr::group_by(USUBJID, PARAMCD, BASETYPE) %>% |
| 352 | -+ | 3x |
-
+ dplyr::mutate(BASEC = ifelse( |
| 353 | -8x | +3x |
- return(v)+ PARAMCD == "ECGINTP", |
| 354 | -+ | 3x |
- }+ AVALC[AVISIT == "BASELINE"], |
| 355 | -+ | 3x |
-
+ as.character(BASE) |
| 356 |
- #' Replace Values with NA+ )) %>% |
||
| 357 | -+ | 3x |
- #'+ dplyr::mutate(ANL03FL = dplyr::case_when( |
| 358 | -+ | 3x |
- #' @description `r lifecycle::badge("stable")`
+ DTYPE == "MINIMUM" ~ "Y", |
| 359 | -+ | 3x |
- #'+ ABLFL == "Y" & PARAMCD != "ECGINTP" ~ "Y", |
| 360 | -+ | 3x |
- #' Replace column values with `NA`s.+ TRUE ~ "" |
| 361 |
- #'+ )) %>% |
||
| 362 | -+ | 3x |
- #' @inheritParams argument_convention+ dplyr::mutate(ANL04FL = dplyr::case_when( |
| 363 | -+ | 3x |
- #' @param ds (`data.frame`)\cr Any data set.+ DTYPE == "MAXIMUM" ~ "Y", |
| 364 | -+ | 3x |
- #'+ ABLFL == "Y" & PARAMCD != "ECGINTP" ~ "Y", |
| 365 | -+ | 3x |
- #' @export+ TRUE ~ "" |
| 366 |
- mutate_na <- function(ds, na_vars = NULL, na_percentage = 0.05) {
+ )) %>% |
||
| 367 | -5x | +3x |
- if (!is.null(na_vars)) {
+ dplyr::ungroup() |
| 368 | -4x | +
- stopifnot(is.list(na_vars)) # any list is OK; as values can be left NA+ |
|
| 369 | -4x | +3x |
- stopifnot(length(names(na_vars)) == length(na_vars)) # names for all elements+ if (length(na_vars) > 0 && na_percentage > 0) {
|
| 370 | -+ | ! |
- } else {
+ adeg <- mutate_na(ds = adeg, na_vars = na_vars, na_percentage = na_percentage) |
| 371 | -1x | +
- na_vars <- names(ds)+ } |
|
| 372 |
- }+ |
||
| 373 |
-
+ # apply metadata |
||
| 374 | -5x | +3x |
- stopifnot(is.numeric(na_percentage))+ adeg <- apply_metadata(adeg, "metadata/ADEG.yml") |
| 375 | -5x | +
- stopifnot(na_percentage >= 0 && na_percentage < 1)+ |
|
| 376 | -+ | 3x |
-
+ return(adeg) |
| 377 | -5x | +
- for (na_var in names(na_vars)) {
+ } |
|
| 378 | -8x | +
| 1 | +
- if (!is.na(na_var)) {
+ #' Time to Adverse Event Analysis Dataset (ADAETTE) |
|||
| 379 | -8x | +|||
| 2 | +
- if (!na_var %in% names(ds)) {
- |
- |||
| 380 | -1x | -
- warning(paste(na_var, "not in column names"))+ #' |
||
| 381 | +3 |
- } else {
- |
- ||
| 382 | -7x | -
- ds <- ds %>%- |
- ||
| 383 | -7x | -
- ungroup_rowwise_df() %>%- |
- ||
| 384 | -7x | -
- dplyr::mutate(- |
- ||
| 385 | -7x | -
- !!na_var := ds[[na_var]] %>%- |
- ||
| 386 | -7x | -
- replace_na(- |
- ||
| 387 | -7x | -
- percentage = ifelse(is.na(na_vars[[na_var]][2]), na_percentage, na_vars[[na_var]][2]),- |
- ||
| 388 | -7x | -
- seed = na_vars[[na_var]][1]+ #' @description `r lifecycle::badge("stable")`
|
||
| 389 | +4 |
- )+ #' |
||
| 390 | +5 |
- )+ #' Function to generate random Time-to-AE Dataset for a |
||
| 391 | +6 |
- }+ #' given Subject-Level Analysis Dataset. |
||
| 392 | +7 |
- }+ #' |
||
| 393 | +8 |
- }- |
- ||
| 394 | -5x | -
- return(ds)+ #' @details |
||
| 395 | +9 |
- }+ #' |
||
| 396 | +10 |
-
+ #' Keys: `STUDYID`, `USUBJID`, `PARAMCD` |
||
| 397 | +11 |
- ungroup_rowwise_df <- function(x) {
- |
- ||
| 398 | -7x | -
- class(x) <- c("tbl", "tbl_df", "data.frame")
- |
- ||
| 399 | -7x | -
- return(x)+ #' |
||
| 400 | +12 |
- }+ #' @inheritParams argument_convention |
||
| 401 | +13 |
-
+ #' @param event_descr (`character vector`)\cr Descriptions of events. Defaults to `NULL`. |
||
| 402 | +14 |
- #' Zero-Truncated Poisson Distribution+ #' @param censor_descr (`character vector`)\cr Descriptions of censors. Defaults to `NULL`. |
||
| 403 | +15 |
- #'+ #' @template param_cached |
||
| 404 | +16 |
- #' @description `r lifecycle::badge("stable")`
+ #' @templateVar data adaette |
||
| 405 | +17 |
#' |
||
| 406 | -- |
- #' This generates random numbers from a zero-truncated Poisson distribution,- |
- ||
| 407 | +18 |
- #' i.e. from `X | X > 0` when `X ~ Poisson(lambda)`. The advantage here is that+ #' @return `data.frame` |
||
| 408 | +19 |
- #' we guarantee to return exactly `n` numbers and without using a loop internally.+ #' @export |
||
| 409 | +20 |
- #' This solution was provided in a post by+ #' |
||
| 410 | +21 |
- #' [Peter Dalgaard](https://stat.ethz.ch/pipermail/r-help/2005-May/070680.html).+ #' @author Xiuting Mi |
||
| 411 | +22 |
#' |
||
| 412 | +23 |
- #' @param n (`numeric`)\cr Number of random numbers.+ #' @examples |
||
| 413 | +24 |
- #' @param lambda (`numeric`)\cr Non-negative mean(s).+ #' adsl <- radsl(N = 10, seed = 1, study_duration = 2) |
||
| 414 | +25 |
#' |
||
| 415 | -- |
- #' @return The random numbers.- |
- ||
| 416 | +26 |
- #' @export+ #' adaette <- radaette(adsl, seed = 2) |
||
| 417 | +27 |
- #'+ #' adaette |
||
| 418 | +28 |
- #' @examples+ radaette <- function(adsl, |
||
| 419 | +29 |
- #' x <- rpois(1e6, lambda = 5)+ event_descr = NULL, |
||
| 420 | +30 |
- #' x <- x[x > 0]+ censor_descr = NULL, |
||
| 421 | +31 |
- #' hist(x)+ lookup = NULL, |
||
| 422 | +32 |
- #'+ seed = NULL, |
||
| 423 | +33 |
- #' y <- rtpois(1e6, lambda = 5)+ na_percentage = 0, |
||
| 424 | +34 |
- #' hist(y)+ na_vars = list(CNSR = c(NA, 0.1), AVAL = c(1234, 0.1)), |
||
| 425 | +35 |
- rtpois <- function(n, lambda) {
+ cached = FALSE) {
|
||
| 426 | -121x | +36 | +6x |
- stats::qpois(stats::runif(n, stats::dpois(0, lambda), 1), lambda)+ checkmate::assert_flag(cached) |
| 427 | -+ | |||
| 37 | +6x |
- }+ if (cached) {
|
||
| 428 | -+ | |||
| 38 | +1x |
-
+ return(get_cached_data("cadaette"))
|
||
| 429 | +39 |
- #' Truncated Exponential Distribution+ } |
||
| 430 | +40 |
- #'+ |
||
| 431 | -+ | |||
| 41 | +5x |
- #' @description `r lifecycle::badge("stable")`
+ checkmate::assert_data_frame(adsl) |
||
| 432 | -+ | |||
| 42 | +5x |
- #'+ checkmate::assert_character(censor_descr, null.ok = TRUE, min.len = 1, any.missing = FALSE) |
||
| 433 | -+ | |||
| 43 | +5x |
- #' This generates random numbers from a truncated Exponential distribution,+ checkmate::assert_character(event_descr, null.ok = TRUE, min.len = 1, any.missing = FALSE) |
||
| 434 | -+ | |||
| 44 | +5x |
- #' i.e. from `X | X > l` or `X | X < r` when `X ~ Exp(rate)`. The advantage here is that+ checkmate::assert_number(seed, null.ok = TRUE) |
||
| 435 | -+ | |||
| 45 | +5x |
- #' we guarantee to return exactly `n` numbers and without using a loop internally.+ checkmate::assert_number(na_percentage, lower = 0, upper = 1) |
||
| 436 | -+ | |||
| 46 | +5x |
- #' This can be derived from the quantile functions of the left- and right-truncated+ checkmate::assert_true(na_percentage < 1) |
||
| 437 | +47 |
- #' Exponential distributions.+ |
||
| 438 | -+ | |||
| 48 | +5x |
- #'+ checkmate::assert_data_frame(lookup, null.ok = TRUE) |
||
| 439 | -+ | |||
| 49 | +5x |
- #' @param n (`numeric`)\cr Number of random numbers.+ lookup_adaette <- if (!is.null(lookup)) {
|
||
| 440 | -+ | |||
| 50 | +! |
- #' @param rate (`numeric`)\cr Non-negative rate.+ lookup |
||
| 441 | +51 |
- #' @param l (`numeric`)\cr Positive left-hand truncation parameter.+ } else {
|
||
| 442 | -+ | |||
| 52 | +5x |
- #' @param r (`numeric`)\cr Positive right-hand truncation parameter.+ tibble::tribble( |
||
| 443 | -+ | |||
| 53 | +5x |
- #'+ ~ARM, ~CATCD, ~CAT, ~LAMBDA, ~CNSR_P, |
||
| 444 | -+ | |||
| 54 | +5x |
- #' @return The random numbers. If neither `l` nor `r` are provided then the usual Exponential+ "ARM A", "1", "any adverse event", 1 / 80, 0.4, |
||
| 445 | -+ | |||
| 55 | +5x |
- #' distribution is used.+ "ARM B", "1", "any adverse event", 1 / 100, 0.2, |
||
| 446 | -+ | |||
| 56 | +5x |
- #' @export+ "ARM C", "1", "any adverse event", 1 / 60, 0.42, |
||
| 447 | -+ | |||
| 57 | +5x |
- #'+ "ARM A", "2", "any serious adverse event", 1 / 100, 0.3, |
||
| 448 | -+ | |||
| 58 | +5x |
- #' @examples+ "ARM B", "2", "any serious adverse event", 1 / 150, 0.1, |
||
| 449 | -+ | |||
| 59 | +5x |
- #' x <- stats::rexp(1e6, rate = 5)+ "ARM C", "2", "any serious adverse event", 1 / 80, 0.32, |
||
| 450 | -+ | |||
| 60 | +5x |
- #' x <- x[x > 0.5]+ "ARM A", "3", "a grade 3-5 adverse event", 1 / 80, 0.2, |
||
| 451 | -+ | |||
| 61 | +5x |
- #' hist(x)+ "ARM B", "3", "a grade 3-5 adverse event", 1 / 100, 0.08, |
||
| 452 | -+ | |||
| 62 | +5x |
- #'+ "ARM C", "3", "a grade 3-5 adverse event", 1 / 60, 0.23 |
||
| 453 | +63 |
- #' y <- rtexp(1e6, rate = 5, l = 0.5)+ ) |
||
| 454 | +64 |
- #' hist(y)+ } |
||
| 455 | +65 |
- #'+ |
||
| 456 | -+ | |||
| 66 | +5x |
- #' z <- rtexp(1e6, rate = 5, r = 0.5)+ if (!is.null(seed)) {
|
||
| 457 | -+ | |||
| 67 | +5x |
- #' hist(z)+ set.seed(seed) |
||
| 458 | +68 |
- rtexp <- function(n, rate, l = NULL, r = NULL) {
+ } |
||
| 459 | -123x | +69 | +5x |
- if (!is.null(l)) {
+ study_duration_secs <- lubridate::seconds(attr(adsl, "study_duration_secs")) |
| 460 | -1x | +|||
| 70 | +
- l - log(1 - stats::runif(n)) / rate+ |
|||
| 461 | -122x | +71 | +5x |
- } else if (!is.null(r)) {
+ evntdescr_sel <- if (!is.null(event_descr)) {
|
| 462 | -121x | +|||
| 72 | +! |
- -log(1 - stats::runif(n) * (1 - exp(-r * rate))) / rate+ event_descr |
||
| 463 | +73 |
} else {
|
||
| 464 | -1x | +74 | +5x |
- stats::rexp(n, rate)+ "Preferred Term" |
| 465 | +75 |
} |
||
| 466 | +76 |
- }+ |
| 1 | -+ | |||
| 77 | +5x |
- #' EORTC QLQ-C30 V3 Analysis Dataset (ADQLQC)+ cnsdtdscr_sel <- if (!is.null(censor_descr)) {
|
||
| 2 | -+ | |||
| 78 | +! |
- #'+ censor_descr |
||
| 3 | +79 |
- #' @description `r lifecycle::badge("stable")`
- |
- ||
| 4 | -- |
- #'- |
- ||
| 5 | -- |
- #' Function for generating a random EORTC QLQ-C30 V3 Analysis Dataset for a given+ } else {
|
||
| 6 | -+ | |||
| 80 | +5x |
- #' Subject-Level Analysis Dataset.+ c( |
||
| 7 | -+ | |||
| 81 | +5x |
- #'+ "Clinical Cut Off", |
||
| 8 | -+ | |||
| 82 | +5x |
- #' @details+ "Completion or Discontinuation", |
||
| 9 | -+ | |||
| 83 | +5x |
- #'+ "End of AE Reporting Period" |
||
| 10 | +84 |
- #' Keys: `STUDYID`, `USUBJID`, `PARCAT1N`, `PARAMCD`, `BASETYPE`, `AVISITN`, `ATPTN`, `ADTM`, `QSSEQ`+ ) |
||
| 11 | +85 |
- #'+ } |
||
| 12 | +86 |
- #' @inheritParams argument_convention+ |
||
| 13 | -+ | |||
| 87 | +5x |
- #' @param percent (`numeric`)\cr Completion - Completed at least y percent of questions, 1 record per visit+ random_patient_data <- function(patient_info) {
|
||
| 14 | -+ | |||
| 88 | +50x |
- #' @param number (`numeric`)\cr Completion - Completed at least x question(s), 1 record per visit+ startdt <- lubridate::date(patient_info$TRTSDTM) |
||
| 15 | -+ | |||
| 89 | +50x |
- #' @template param_cached+ trtedtm <- lubridate::floor_date(dplyr::case_when( |
||
| 16 | -+ | |||
| 90 | +50x |
- #' @templateVar data adqlqc+ is.na(patient_info$TRTEDTM) ~ lubridate::date(patient_info$TRTSDTM) + study_duration_secs, |
||
| 17 | -+ | |||
| 91 | +50x |
- #'+ TRUE ~ lubridate::date(patient_info$TRTEDTM) |
||
| 18 | -+ | |||
| 92 | +50x |
- #' @return `data.frame`+ ), unit = "day") |
||
| 19 | -+ | |||
| 93 | +50x |
- #' @export+ enddts <- c(patient_info$EOSDT, lubridate::date(trtedtm)) |
||
| 20 | -+ | |||
| 94 | +50x |
- #'+ enddts_min_index <- which.min(enddts) |
||
| 21 | -+ | |||
| 95 | +50x |
- #' @examples+ adt <- enddts[enddts_min_index] |
||
| 22 | -+ | |||
| 96 | +50x |
- #' adsl <- radsl(N = 10, study_duration = 2, seed = 1)+ adtm <- lubridate::as_datetime(adt) |
||
| 23 | -+ | |||
| 97 | +50x |
- #'+ ady <- as.numeric(adt - startdt + 1) |
||
| 24 | -+ | |||
| 98 | +50x |
- #' adqlqc <- radqlqc(adsl, seed = 1, percent = 80, number = 2)+ data.frame( |
||
| 25 | -+ | |||
| 99 | +50x |
- #' adqlqc+ ARM = patient_info$ARM, |
||
| 26 | -+ | |||
| 100 | +50x |
- radqlqc <- function(adsl,+ STUDYID = patient_info$STUDYID, |
||
| 27 | -+ | |||
| 101 | +50x |
- percent,+ SITEID = patient_info$SITEID, |
||
| 28 | -+ | |||
| 102 | +50x |
- number,+ USUBJID = patient_info$USUBJID, |
||
| 29 | -+ | |||
| 103 | +50x |
- seed = NULL,+ PARAMCD = "AEREPTTE", |
||
| 30 | -+ | |||
| 104 | +50x |
- cached = FALSE) {
+ PARAM = "Time to end of AE reporting period", |
||
| 31 | -4x | +105 | +50x |
- checkmate::assert_flag(cached)+ CNSR = 0, |
| 32 | -4x | +106 | +50x |
- if (cached) {
+ AVAL = lubridate::days(ady) / lubridate::years(1), |
| 33 | -1x | +107 | +50x |
- return(get_cached_data("cadqlqc"))
+ AVALU = "YEARS", |
| 34 | -+ | |||
| 108 | +50x |
- }+ EVNTDESC = ifelse(enddts_min_index == 1, "Completion or Discontinuation", "End of AE Reporting Period"), |
||
| 35 | -+ | |||
| 109 | +50x |
-
+ CNSDTDSC = NA, |
||
| 36 | -3x | +110 | +50x |
- checkmate::assert_data_frame(adsl)+ ADTM = adtm, |
| 37 | -3x | +111 | +50x |
- checkmate::assert_number(percent, lower = 1, upper = 100)+ ADY = ady, |
| 38 | -3x | +112 | +50x |
- checkmate::assert_number(number, lower = 1)+ stringsAsFactors = FALSE |
| 39 | +113 | - - | -||
| 40 | -3x | -
- if (!is.null(seed)) {
- |
- ||
| 41 | -3x | -
- set.seed(seed)+ ) |
||
| 42 | +114 |
} |
||
| 43 | +115 | |||
| 44 | +116 |
- # ADQLQC data -------------------------------------------------------------+ # validate and initialize related variables for Hy's law |
||
| 45 | -3x | -
- qs <- get_qs_data(adsl, n_assessments = 5L, seed = seed, na_percentage = 0.1)- |
- ||
| 46 | -+ | 117 | +5x |
- # prepare ADaM ADQLQC data+ paramcd_hy <- c("HYSTTEUL", "HYSTTEBL")
|
| 47 | -3x | -
- adqlqc1 <- prep_adqlqc(df = qs)- |
- ||
| 48 | -+ | 118 | +5x |
- # derive AVAL and AVALC+ param_hy <- c("Time to Hy's Law Elevation in relation to ULN", "Time to Hy's Law Elevation in relation to Baseline")
|
| 49 | -3x | +119 | +5x |
- adqlqc1 <- mutate(+ param_init_list <- relvar_init(param_hy, paramcd_hy) |
| 50 | -3x | +120 | +5x |
- adqlqc1,+ adsl_hy <- dplyr::select(adsl, "STUDYID", "USUBJID", "TRTSDTM", "SITEID", "ARM") |
| 51 | -3x | +|||
| 121 | +
- AVAL = as.numeric(QSSTRESC),+ |
|||
| 52 | -3x | +|||
| 122 | +
- AVALC = case_when(+ # create all combinations of unique values in STUDYID, USUBJID, PARAM, AVISIT |
|||
| 53 | -3x | +123 | +5x |
- QSTESTCD == "QSALL" ~ QSREASND,+ adaette_hy <- expand.grid( |
| 54 | -3x | -
- TRUE ~ QSORRES- |
- ||
| 55 | -+ | 124 | +5x |
- ),+ STUDYID = unique(adsl$STUDYID), |
| 56 | -3x | +125 | +5x |
- AVISIT = VISIT,+ USUBJID = adsl$USUBJID, |
| 57 | -3x | +126 | +5x |
- AVISITN = VISITNUM,+ PARAM = as.factor(param_init_list$relvar1), |
| 58 | -3x | +127 | +5x |
- ADTM = QSDTC+ stringsAsFactors = FALSE |
| 59 | +128 |
) |
||
| 60 | +129 |
- # include scale calculation- |
- ||
| 61 | -3x | -
- adqlqc_tmp <- calc_scales(adqlqc1)+ |
||
| 62 | +130 |
- # order to prepare for change from screening and baseline values+ # Add other variables to adaette_hy |
||
| 63 | -3x | +131 | +5x |
- adqlqc_tmp <- adqlqc_tmp[order(adqlqc_tmp$STUDYID, adqlqc_tmp$USUBJID, adqlqc_tmp$PARAMCD, adqlqc_tmp$AVISITN), ]+ adaette_hy <- dplyr::left_join(adaette_hy, adsl_hy, by = c("STUDYID", "USUBJID")) %>%
|
| 64 | -+ | |||
| 132 | +5x |
-
+ rel_var( |
||
| 65 | -3x | +133 | +5x |
- adqlqc_tmp <- Reduce(+ var_name = "PARAMCD", |
| 66 | -3x | +134 | +5x |
- rbind,+ related_var = "PARAM", |
| 67 | -3x | +135 | +5x |
- lapply(+ var_values = param_init_list$relvar2 |
| 68 | -3x | +|||
| 136 | +
- split(adqlqc_tmp, adqlqc_tmp$USUBJID),+ ) %>% |
|||
| 69 | -3x | +137 | +5x |
- function(x) {
+ dplyr::mutate( |
| 70 | -30x | +138 | +5x |
- x$STUDYID <- adsl$STUDYID[which(adsl$USUBJID == x$USUBJID[1])]+ CNSR = sample(c(0, 1), prob = c(0.1, 0.9), size = dplyr::n(), replace = TRUE), |
| 71 | -30x | +139 | +5x |
- x$ABLFL2 <- ifelse(x$AVISIT == "SCREENING", "Y", "")+ EVNTDESC = dplyr::if_else( |
| 72 | -30x | +140 | +5x |
- x$ABLFL <- ifelse(+ CNSR == 0, |
| 73 | -30x | +141 | +5x |
- x$AVISIT == "BASELINE" &+ "First Post-Baseline Raised ALT or AST Elevation Result", |
| 74 | -30x | +142 | +5x |
- x$PARAMCD != "EX028",+ NA_character_ |
| 75 | -30x | +|||
| 143 | +
- "Y",+ ), |
|||
| 76 | -30x | +144 | +5x |
- ifelse(+ CNSDTDSC = dplyr::if_else(CNSR == 0, NA_character_, |
| 77 | -30x | +145 | +5x |
- x$AVISIT == "CYCLE 1 DAY 1" &+ sample(c("Last Post-Baseline ALT or AST Result", "Treatment Start"),
|
| 78 | -30x | +146 | +5x |
- x$PARAMCD != "EX028",+ prob = c(0.9, 0.1), |
| 79 | -30x | +147 | +5x |
- "Y",+ size = dplyr::n(), replace = TRUE |
| 80 | +148 |
- ""+ ) |
||
| 81 | +149 |
- )+ ) |
||
| 82 | +150 |
- )+ ) %>% |
||
| 83 | -30x | +151 | +5x |
- x+ dplyr::rowwise() %>% |
| 84 | -+ | |||
| 152 | +5x |
- }+ dplyr::mutate(ADTM = dplyr::case_when( |
||
| 85 | -+ | |||
| 153 | +5x |
- )+ CNSDTDSC == "Treatment Start" ~ TRTSDTM, |
||
| 86 | -+ | |||
| 154 | +5x |
- )+ TRUE ~ TRTSDTM + sample(seq(0, study_duration_secs), size = dplyr::n(), replace = TRUE) |
||
| 87 | +155 | - - | -||
| 88 | -3x | -
- adqlqc_tmp$BASE2 <- ifelse(+ )) %>% |
||
| 89 | -3x | +156 | +5x |
- str_detect(adqlqc_tmp$PARCAT2, "Completion", negate = TRUE),+ dplyr::mutate( |
| 90 | -3x | +157 | +5x |
- retain(+ ADY_int = lubridate::date(ADTM) - lubridate::date(TRTSDTM) + 1, |
| 91 | -3x | +158 | +5x |
- df = adqlqc_tmp,+ ADY = as.numeric(ADY_int), |
| 92 | -3x | +159 | +5x |
- value_var = adqlqc_tmp$AVAL,+ AVAL = lubridate::days(ADY_int) / lubridate::weeks(1), |
| 93 | -3x | +160 | +5x |
- event = adqlqc_tmp$ABLFL2 == "Y"+ AVALU = "WEEKS" |
| 94 | +161 |
- ),+ ) %>% |
||
| 95 | -3x | +162 | +5x |
- NA+ dplyr::select(-TRTSDTM, -ADY_int) |
| 96 | +163 |
- )+ |
||
| 97 | -+ | |||
| 164 | +5x |
-
+ random_ae_data <- function(lookup_info, patient_info, patient_data) {
|
||
| 98 | -3x | +165 | +150x |
- adqlqc_tmp$BASE <- ifelse(+ cnsr <- sample(c(0, 1), 1, prob = c(1 - lookup_info$CNSR_P, lookup_info$CNSR_P)) |
| 99 | -3x | +166 | +150x |
- adqlqc_tmp$ABLFL2 != "Y" &+ ae_rep_tte <- patient_data$AVAL[patient_data$PARAMCD == "AEREPTTE"] |
| 100 | -3x | +167 | +150x |
- str_detect(adqlqc_tmp$PARCAT2, "Completion", negate = TRUE),+ data.frame( |
| 101 | -3x | +168 | +150x |
- retain(+ ARM = rep(patient_data$ARM, 2), |
| 102 | -3x | +169 | +150x |
- adqlqc_tmp,+ STUDYID = rep(patient_data$STUDYID, 2), |
| 103 | -3x | +170 | +150x |
- adqlqc_tmp$AVAL,+ SITEID = rep(patient_data$SITEID, 2), |
| 104 | -3x | +171 | +150x |
- adqlqc_tmp$ABLFL == "Y"+ USUBJID = rep(patient_data$USUBJID, 2), |
| 105 | -+ | |||
| 172 | +150x |
- ),+ PARAMCD = c( |
||
| 106 | -3x | +173 | +150x |
- NA+ paste0("AETTE", lookup_info$CATCD),
|
| 107 | -+ | |||
| 174 | +150x |
- )+ paste0("AETOT", lookup_info$CATCD)
|
||
| 108 | +175 |
-
+ ), |
||
| 109 | -3x | +176 | +150x |
- adqlqc_tmp <- adqlqc_tmp %>%+ PARAM = c( |
| 110 | -3x | +177 | +150x |
- dplyr::mutate(CHG2 = AVAL - BASE2) %>%+ paste("Time to first occurrence of", lookup_info$CAT),
|
| 111 | -3x | +178 | +150x |
- dplyr::mutate(PCHG2 = 100 * (CHG2 / BASE2)) %>%+ paste("Number of occurrences of", lookup_info$CAT)
|
| 112 | -3x | +|||
| 179 | +
- dplyr::mutate(CHG = AVAL - BASE) %>%+ ), |
|||
| 113 | -3x | +180 | +150x |
- dplyr::mutate(PCHG = 100 * (CHG / BASE)) %>%+ CNSR = c( |
| 114 | -3x | +181 | +150x |
- var_relabel(+ cnsr, |
| 115 | -3x | +182 | +150x |
- STUDYID = attr(adsl$STUDYID, "label"),+ NA+ |
+
| 183 | ++ |
+ ), |
||
| 116 | -3x | +184 | +150x |
- USUBJID = attr(adsl$USUBJID, "label")+ AVAL = c( |
| 117 | +185 |
- )+ # We generate these values conditional on the censoring information. |
||
| 118 | +186 |
- # derive CHGCAT1 ----------------------------------------------------------+ # If this time to event is censored, then there were no AEs reported and the time is set |
||
| 119 | -3x | +|||
| 187 | +
- adqlqc_tmp <- derv_chgcat1(dataset = adqlqc_tmp)+ # to the AE reporting period time. Otherwise we draw from truncated distributions to make |
|||
| 120 | +188 |
-
+ # sure that we are within the AE reporting time and above 0 AEs. |
||
| 121 | -3x | +189 | +150x |
- adqlqc_tmp <- var_relabel(+ ifelse(cnsr == 1, ae_rep_tte, rtexp(1, lookup_info$LAMBDA * 365.25, r = ae_rep_tte)), |
| 122 | -3x | +190 | +150x |
- adqlqc_tmp,+ ifelse(cnsr == 1, 0, rtpois(1, lookup_info$LAMBDA * 365.25))+ |
+
| 191 | ++ |
+ ), |
||
| 123 | -3x | +192 | +150x |
- STUDYID = "Study Identifier",+ AVALU = c( |
| 124 | -3x | +193 | +150x |
- USUBJID = "Unique Subject Identifier"+ "YEARS", |
| 125 | -+ | |||
| 194 | +150x |
- )+ NA |
||
| 126 | +195 |
-
+ ), |
||
| 127 | -3x | +196 | +150x |
- adqlqc_tmp <- arrange(+ EVNTDESC = c( |
| 128 | -3x | +197 | +150x |
- adqlqc_tmp,+ ifelse(cnsr == 0, sample(evntdescr_sel, 1), ""), |
| 129 | -3x | +198 | +150x |
- USUBJID,+ NA+ |
+
| 199 | ++ |
+ ), |
||
| 130 | -3x | +200 | +150x |
- AVISITN+ CNSDTDSC = c( |
| 131 | -+ | |||
| 201 | +150x |
- )+ ifelse(cnsr == 1, sample(cnsdtdscr_sel, 1), ""), |
||
| 132 | -+ | |||
| 202 | +150x |
- # Merge ADSL --------------------------------------------------------------+ NA |
||
| 133 | +203 |
- # ADSL variables needed for ADQLQC+ ), |
||
| 134 | -3x | +204 | +150x |
- adsl_vars <- c(+ stringsAsFactors = FALSE |
| 135 | -3x | +205 | +150x |
- "STUDYID", "USUBJID", "SUBJID", "SITEID", "REGION1", "COUNTRY", "ETHNIC", "AGE",+ ) %>% dplyr::mutate( |
| 136 | -3x | +206 | +150x |
- "AGEU", "AAGE", "AAGEU", "AGEGR1", "AGEGR2", "AGEGR3", "STRATwNM", "STRATw", "STRATwV",+ ADY = dplyr::if_else(is.na(AVALU), NA_real_, ceiling(as.numeric(lubridate::dyears(AVAL), "days"))), |
| 137 | -3x | +207 | +150x |
- "SEX", "RACE", "ITTFL", "SAFFL", "PPROTFL", "TRT01P", "TRT01A",+ ADTM = dplyr::if_else( |
| 138 | -3x | +208 | +150x |
- "TRTSEQP", "TRTSEQA", "TRTSDTM", "TRTSDT", "TRTEDTM", "TRTEDT", "DCUTDT"+ is.na(AVALU), |
| 139 | -+ | |||
| 209 | +150x |
- )+ lubridate::as_datetime(NA), |
||
| 140 | -3x | +210 | +150x |
- adsl <- select(+ patient_info$TRTSDTM + lubridate::days(ADY) |
| 141 | -3x | +|||
| 211 | +
- adsl,+ ) |
|||
| 142 | -3x | +|||
| 212 | +
- any_of(adsl_vars)+ ) |
|||
| 143 | +213 |
- )+ } |
||
| 144 | -3x | +|||
| 214 | +
- adqlqc <- dplyr::inner_join(+ |
|||
| 145 | -3x | +215 | +5x |
- adqlqc_tmp,+ adaette <- split(adsl, adsl$USUBJID) %>% |
| 146 | -3x | +216 | +5x |
- adsl,+ lapply(function(patient_info) {
|
| 147 | -3x | +217 | +50x |
- by = c("STUDYID", "USUBJID")
+ patient_data <- random_patient_data(patient_info) |
| 148 | -+ | |||
| 218 | +50x |
- ) %>%+ lookup_arm <- lookup_adaette %>% |
||
| 149 | -3x | +219 | +50x |
- dplyr::mutate(+ dplyr::filter(ARM == as.character(patient_info$ARMCD)) |
| 150 | -3x | +220 | +50x |
- ADY_der = ceiling(difftime(ADTM, TRTSDTM, units = "days")),+ ae_data <- split(lookup_arm, lookup_arm$CATCD) %>% |
| 151 | -3x | +221 | +50x |
- ADY = case_when(+ lapply(random_ae_data, patient_data = patient_data, patient_info = patient_info) %>% |
| 152 | -3x | +222 | +50x |
- ADY_der >= 0 ~ ADY_der + 1,+ Reduce(rbind, .) |
| 153 | -3x | +223 | +50x |
- TRUE ~ ADY_der+ dplyr::bind_rows(patient_data, ae_data) |
| 154 | +224 |
- )+ }) %>% |
||
| 155 | -+ | |||
| 225 | +5x |
- ) %>%+ Reduce(rbind, .) %>% |
||
| 156 | -3x | +226 | +5x |
- select(-ADY_der)+ var_relabel(+ |
+
| 227 | +5x | +
+ STUDYID = "Study Identifier",+ |
+ ||
| 228 | +5x | +
+ USUBJID = "Unique Subject Identifier" |
||
| 157 | +229 |
-
+ ) |
||
| 158 | +230 |
- # get compliance data ---------------------------------------------------+ |
||
| 159 | -3x | +231 | +5x |
- compliance_data <- comp_derv(+ adaette <- var_relabel( |
| 160 | -3x | +232 | +5x |
- dataset = adqlqc,+ adaette, |
| 161 | -3x | +233 | +5x |
- percent = percent,+ STUDYID = "Study Identifier", |
| 162 | -3x | +234 | +5x |
- number = number+ USUBJID = "Unique Subject Identifier" |
| 163 | +235 |
) |
||
| 164 | +236 |
- # add ADSL variables+ |
||
| 165 | -3x | +237 | +5x |
- compliance_data <- left_join(+ adaette <- rbind(adaette, adaette_hy)+ |
+
| 238 | ++ | + | ||
| 166 | -3x | +239 | +5x |
- compliance_data,+ adaette <- dplyr::inner_join( |
| 167 | -3x | +240 | +5x |
- adsl,+ dplyr::select(adaette, -"SITEID", -"ARM"), |
| 168 | -3x | +241 | +5x |
- by = c("STUDYID", "USUBJID")
+ adsl, |
| 169 | -+ | |||
| 242 | +5x |
- )+ by = c("STUDYID", "USUBJID")
|
||
| 170 | +243 |
- # add completion to ADQLQC+ ) %>% |
||
| 171 | -3x | +244 | +5x |
- adqlqc <- bind_rows(+ dplyr::group_by(USUBJID) %>% |
| 172 | -3x | +245 | +5x |
- adqlqc,+ dplyr::arrange(ADTM) %>% |
| 173 | -3x | -
- compliance_data- |
- ||
| 174 | -+ | 246 | +5x |
- ) %>%+ dplyr::mutate(TTESEQ = seq_len(dplyr::n())) %>% |
| 175 | -3x | +247 | +5x |
- arrange(+ dplyr::mutate(ASEQ = TTESEQ) %>% |
| 176 | -3x | +248 | +5x |
- USUBJID,+ dplyr::mutate(PARAM = as.factor(PARAM)) %>% |
| 177 | -3x | +249 | +5x |
- AVISITN,+ dplyr::mutate(PARAMCD = as.factor(PARAMCD)) %>% |
| 178 | -3x | +250 | +5x |
- QSTESTCD+ dplyr::ungroup() %>% |
| 179 | -+ | |||
| 251 | +5x |
- )+ dplyr::arrange( |
||
| 180 | -+ | |||
| 252 | +5x |
- # find first set of questionnaire observations+ STUDYID, |
||
| 181 | -3x | +253 | +5x |
- adqlqc_x <- arrange(+ USUBJID, |
| 182 | -3x | +254 | +5x |
- adqlqc,+ PARAMCD, |
| 183 | -3x | +255 | +5x |
- USUBJID,+ ADTM, |
| 184 | -3x | +256 | +5x |
- ADTM+ TTESEQ |
| 185 | +257 |
- ) %>%+ ) |
||
| 186 | -3x | +|||
| 258 | +
- filter(+ |
|||
| 187 | -3x | +259 | +5x |
- PARAMCD != "QSALL" &+ if (length(na_vars) > 0 && na_percentage > 0) {
|
| 188 | -3x | +|||
| 260 | +! |
- !str_detect(AVISIT, "SCREENING|UNSCHEDULED")+ adaette <- dplyr::mutate(ds = adaette, na_vars = na_vars, na_percentage = na_percentage) |
||
| 189 | +261 |
- ) %>%+ } |
||
| 190 | -3x | +|||
| 262 | +
- group_by(+ |
|||
| 191 | -3x | +|||
| 263 | +
- USUBJID,+ # apply metadata |
|||
| 192 | -3x | +264 | +5x |
- ADTM+ adaette <- apply_metadata(adaette, "metadata/ADAETTE.yml") |
| 193 | +265 |
- ) %>%+ |
||
| 194 | -3x | +266 | +5x |
- summarise(first_date = first(ADTM), .groups = "drop")+ return(adaette) |
| 195 | +267 |
-
+ } |
||
| 196 | -3x | +
| 1 | +
- adqlqc <- left_join(+ #' Load Cached Data |
|||
| 197 | -3x | +|||
| 2 | +
- adqlqc,+ #' |
|||
| 198 | -3x | +|||
| 3 | +
- adqlqc_x,+ #' Return data attached to package. |
|||
| 199 | -3x | +|||
| 4 | +
- by = c("USUBJID", "ADTM")
+ #' |
|||
| 200 | +5 |
- ) %>%+ #' @keywords internal |
||
| 201 | -3x | +|||
| 6 | +
- mutate(+ #' @noRd+ |
+ |||
| 7 | ++ |
+ get_cached_data <- function(dataname) {
|
||
| 202 | -3x | +8 | +22x |
- ANL01FL = case_when(+ checkmate::assert_string(dataname) |
| 203 | -3x | +9 | +22x |
- PARAMCD != "QSALL" & ABLFL == "Y" ~ "Y",+ if (!("package:random.cdisc.data" %in% search())) {
|
| 204 | -3x | +10 | +1x |
- PARAMCD != "QSALL" &+ stop("cached data can only be loaded if the random.cdisc.data package is attached.",
|
| 205 | -3x | +11 | +1x |
- !str_detect(AVISIT, "UNSCHEDULED") &+ "Please run library(random.cdisc.data) before loading cached data.", |
| 206 | -3x | +12 | +1x |
- !is.na(first_date) ~ "Y"+ call. = FALSE |
| 207 | +13 |
- )+ ) |
||
| 208 | +14 |
- ) %>%+ } else {
|
||
| 209 | -3x | +15 | +21x |
- select(-first_date)+ get(dataname, envir = asNamespace("random.cdisc.data"))
|
| 210 | +16 |
-
+ } |
||
| 211 | +17 |
- # final dataset -----------------------------------------------------------+ } |
||
| 212 | -3x | +|||
| 18 | +
- adqlqc_final <- adqlqc %>%+ |
|||
| 213 | -3x | +|||
| 19 | +
- dplyr::group_by(USUBJID) %>%+ #' Create a Factor with Random Elements of x |
|||
| 214 | -3x | +|||
| 20 | +
- dplyr::mutate(ASEQ = row_number()) %>%+ #' |
|||
| 215 | -3x | +|||
| 21 | +
- dplyr::ungroup() %>%+ #' Sample elements from `x` with replacement to build a factor. |
|||
| 216 | -3x | +|||
| 22 | +
- dplyr::arrange(+ #' |
|||
| 217 | -3x | +|||
| 23 | +
- STUDYID,+ #' @param x (`character vector` or `factor`)\cr If character vector then it is also used |
|||
| 218 | -3x | +|||
| 24 | +
- USUBJID,+ #' as levels of the returned factor. If factor then the levels are used as the new levels. |
|||
| 219 | -3x | +|||
| 25 | +
- AVISITN+ #' @param N (`numeric`)\cr Number of items to choose. |
|||
| 220 | +26 |
- ) %>%+ #' @param ... Additional arguments to be passed to `sample`. |
||
| 221 | -3x | +|||
| 27 | +
- select(+ #' |
|||
| 222 | -3x | +|||
| 28 | +
- -c("BASE2", "CHG2", "PCHG2", "ABLFL2")
+ #' @return A factor of length `N`. |
|||
| 223 | +29 |
- ) %>%+ #' @export |
||
| 224 | -3x | +|||
| 30 | +
- ungroup()+ #' |
|||
| 225 | +31 |
-
+ #' @examples |
||
| 226 | -3x | +|||
| 32 | +
- adam_vars <- c(+ #' sample_fct(letters[1:3], 10) |
|||
| 227 | -3x | +|||
| 33 | +
- adsl_vars, "QSSEQ", "QSCAT", "QSSCAT", "QSDTC", "QSSPID", "QSSTAT", "QSSTRESN",+ #' sample_fct(iris$Species, 10) |
|||
| 228 | -3x | +|||
| 34 | +
- "QSSTRESC", "QSSTRESU", "QSORRES", "QSORRESU", "QSTEST", "QSTESTCD", "QSTPT",+ sample_fct <- function(x, N, ...) { # nolint
|
|||
| 229 | -3x | +35 | +296x |
- "QSTPTNUM", "QSTPTREF", "QSDY", "QSREASND", "QSTSTDTL", "QSEVAL", "VISIT", "VISITNUM",+ checkmate::assert_number(N) |
| 230 | -3x | +|||
| 36 | +
- "PARAM", "PARAMCD", "PARCAT1", "PARCAT1N", "PARCAT2", "AVAL", "AVALC", "AREASND",+ |
|||
| 231 | -3x | +37 | +296x |
- "BASE", "BASETYPE", "ABLFL", "CHG", "PCHG", "CHGCAT1", "CRIT1", "CRIT1FL", "DTYPE",+ factor(sample(x, N, replace = TRUE, ...), levels = if (is.factor(x)) levels(x) else x) |
| 232 | -3x | +|||
| 38 | +
- "ADTM", "ADT", "ADY", "ADTF", "ATMF", "ATPT", "ATPTN", "AVISIT", "AVISITN", "APHASE",+ } |
|||
| 233 | -3x | +|||
| 39 | +
- "APHASEN", "APERIOD", "APERIODC", "APERIODC", "ASPER", "ASPERC", "PERADY", "TRTP",+ |
|||
| 234 | -3x | +|||
| 40 | +
- "TRTA", "ONTRTFL", "LAST02FL", "FIRS02FL", "ANL01FL", "ANL02FL", "ANL03FL",+ #' Related Variables: Initialize |
|||
| 235 | -3x | +|||
| 41 | +
- "ANL04FL", "CGCAT1NX"+ #' |
|||
| 236 | +42 |
- )+ #' Verify and initialize related variable values. |
||
| 237 | +43 |
- # order variables in mapped qs by variables in adam_vars+ #' For example, `relvar_init("Alanine Aminotransferase Measurement", "ALT")`.
|
||
| 238 | -3x | +|||
| 44 | +
- adqlqc_name_ordered <- names(adqlqc_final)[order(match(names(adqlqc_final), adam_vars))]+ #' |
|||
| 239 | +45 |
- # adqlqc with variables ordered per gdsr+ #' @param relvar1 (`list` of `character`)\cr List of n elements. |
||
| 240 | -3x | +|||
| 46 | +
- adqlqc_final <- adqlqc_final %>%+ #' @param relvar2 (`list` of `character`)\cr List of n elements. |
|||
| 241 | -3x | +|||
| 47 | +
- select(+ #' |
|||
| 242 | -3x | +|||
| 48 | +
- any_of(adqlqc_name_ordered)+ #' @return A vector of n elements. |
|||
| 243 | +49 |
- )+ #' |
||
| 244 | +50 |
-
+ #' @keywords internal |
||
| 245 | -3x | +|||
| 51 | +
- adqlqc_final <- relocate(adqlqc_final, "QSEVLINT", .after = "QSTESTCD") %>%+ relvar_init <- function(relvar1, relvar2) {
|
|||
| 246 | -3x | +52 | +64x |
- arrange(+ checkmate::assert_character(relvar1, min.len = 1, any.missing = FALSE) |
| 247 | -3x | +53 | +64x |
- USUBJID,+ checkmate::assert_character(relvar2, min.len = 1, any.missing = FALSE)+ |
+
| 54 | ++ | + | ||
| 248 | -3x | +55 | +64x |
- AVISITN,+ if (length(relvar1) != length(relvar2)) {
|
| 249 | -3x | +56 | +1x |
- ASEQ,+ message(simpleError( |
| 250 | -3x | +57 | +1x |
- QSTESTCD+ "The argument value length of relvar1 and relvar2 differ. They must contain the same number of elements." |
| 251 | +58 |
- )+ )) |
||
| 252 | -+ | |||
| 59 | +! |
- # apply metadata+ return(NA) |
||
| 253 | -3x | +|||
| 60 | +
- adqlqc_final <- apply_metadata(adqlqc_final, "metadata/ADQLQC.yml")+ } |
|||
| 254 | -3x | +61 | +63x |
- return(adqlqc_final)+ return(list("relvar1" = relvar1, "relvar2" = relvar2))
|
| 255 | +62 |
} |
||
| 256 | +63 | |||
| 257 | +64 |
- #' Helper Functions for Constructing ADQLQC+ #' Related Variables: Assign |
||
| 258 | +65 |
#' |
||
| 259 | +66 |
- #' Internal functions used by `radqlqc`.+ #' Assign values to a related variable within a domain. |
||
| 260 | +67 |
#' |
||
| 261 | +68 |
- #' @inheritParams argument_convention+ #' @param df (`data.frame`)\cr Data frame containing the related variables. |
||
| 262 | +69 |
- #' @inheritParams radqlqc+ #' @param var_name (`character`)\cr Name of variable related to `rel_var` to add to `df`. |
||
| 263 | +70 |
- #'+ #' @param var_values (`any`)\cr Vector of values related to values of `related_var`. |
||
| 264 | +71 |
- #' @examples+ #' @param related_var (`character`)\cr Name of variable within `df` with values to which values |
||
| 265 | +72 |
- #' adsl <- radsl(N = 10, study_duration = 2, seed = 1)+ #' of `var_name` must relate. |
||
| 266 | +73 |
- #' adqlqc <- radqlqc(adsl, seed = 1, percent = 80, number = 2)+ #' |
||
| 267 | +74 | ++ |
+ #' @return `df` with added factor variable `var_name` containing `var_values` corresponding to `related_var`.+ |
+ |
| 75 | ++ |
+ #' @export+ |
+ ||
| 76 |
#' |
|||
| 268 | +77 |
- #' @name h_adqlqc+ #' @examples |
||
| 269 | +78 |
- NULL+ #' # Example with data.frame. |
||
| 270 | +79 |
-
+ #' params <- c("Level A", "Level B", "Level C")
|
||
| 271 | +80 |
- #' @describeIn h_adqlqc Questionnaires EORTC QLQ-C30 V3.0 SDTM (QS)+ #' adlb_df <- data.frame( |
||
| 272 | +81 |
- #'+ #' ID = 1:9, |
||
| 273 | +82 |
- #' Function for generating random Questionnaires SDTM domain+ #' PARAM = factor( |
||
| 274 | +83 |
- #'+ #' rep(c("Level A", "Level B", "Level C"), 3),
|
||
| 275 | +84 |
- #' @return a dataframe with SDTM questionnaire data+ #' levels = params |
||
| 276 | +85 |
- #' @keywords internal+ #' ) |
||
| 277 | +86 |
- #'+ #' ) |
||
| 278 | +87 |
- #' @examples+ #' rel_var( |
||
| 279 | +88 |
- #' \dontrun{
+ #' df = adlb_df, |
||
| 280 | +89 |
- #' qs <- random.cdisc.data:::get_qs_data(adsl, n_assessments = 5L, seed = 1, na_percentage = 0.1)+ #' var_name = "PARAMCD", |
||
| 281 | +90 |
- #' qs+ #' var_values = c("A", "B", "C"),
|
||
| 282 | +91 |
- #' }+ #' related_var = "PARAM" |
||
| 283 | +92 |
- get_qs_data <- function(adsl,+ #' ) |
||
| 284 | +93 |
- visit_format = "CYCLE",+ #' |
||
| 285 | +94 |
- n_assessments = 5L,+ #' # Example with tibble. |
||
| 286 | +95 |
- n_days = 1L,+ #' adlb_tbl <- tibble::tibble( |
||
| 287 | +96 |
- lookup = NULL,+ #' ID = 1:9, |
||
| 288 | +97 |
- seed = NULL,+ #' PARAM = factor( |
||
| 289 | +98 |
- na_percentage = 0,+ #' rep(c("Level A", "Level B", "Level C"), 3),
|
||
| 290 | +99 |
- na_vars = list(+ #' levels = params |
||
| 291 | +100 |
- QSORRES = c(1234, 0.2),+ #' ) |
||
| 292 | +101 |
- QSSTRESC = c(1234, 0.2)+ #' ) |
||
| 293 | +102 |
- )) {
+ #' rel_var( |
||
| 294 | -3x | +|||
| 103 | +
- load(system.file("sysdata.rda", package = "random.cdisc.data"))
+ #' df = adlb_tbl, |
|||
| 295 | -3x | +|||
| 104 | +
- checkmate::assert_string(visit_format)+ #' var_name = "PARAMCD", |
|||
| 296 | -3x | +|||
| 105 | +
- checkmate::assert_integer(n_assessments, len = 1, any.missing = FALSE)+ #' var_values = c("A", "B", "C"),
+ |
+ |||
| 106 | ++ |
+ #' related_var = "PARAM"+ |
+ ||
| 107 | ++ |
+ #' )+ |
+ ||
| 108 | ++ |
+ rel_var <- function(df, var_name, related_var, var_values = NULL) {
|
||
| 297 | -3x | +109 | +64x |
- checkmate::assert_integer(n_days, len = 1, any.missing = FALSE)+ checkmate::assert_data_frame(df) |
| 298 | -3x | +110 | +64x |
- checkmate::assert_number(seed, null.ok = TRUE)+ checkmate::assert_string(var_name) |
| 299 | -3x | +111 | +64x |
- checkmate::assert_number(na_percentage, lower = 0, upper = 1, na.ok = TRUE)+ checkmate::assert_string(related_var) |
| 300 | -3x | +112 | +64x |
- checkmate::assert_number(na_percentage, lower = 0, upper = 1)+ n_relvar1 <- length(unique(df[, related_var, drop = TRUE])) |
| 301 | -3x | +113 | +64x |
- checkmate::assert_true(na_percentage < 1)+ checkmate::assert_vector(var_values, null.ok = TRUE, len = n_relvar1, any.missing = FALSE) |
| 302 | -+ | |||
| 114 | +1x |
-
+ if (is.null(var_values)) var_values <- rep(NA, n_relvar1) |
||
| 303 | +115 |
- # get subjects for QS data from ADSL+ |
||
| 304 | -+ | |||
| 116 | +64x |
- # get studyid, subject for QS generation+ relvar1 <- unique(df[, related_var, drop = TRUE]) |
||
| 305 | -3x | +117 | +64x |
- qs <- select(+ relvar2_values <- rep(NA, nrow(df)) |
| 306 | -3x | +118 | +64x |
- adsl,+ for (r in seq_len(n_relvar1)) {
|
| 307 | -3x | +119 | +538x |
- STUDYID,+ matched <- which(df[, related_var, drop = TRUE] == relvar1[r]) |
| 308 | -3x | +120 | +538x |
- USUBJID+ relvar2_values[matched] <- var_values[r] |
| 309 | +121 |
- ) %>%+ } |
||
| 310 | -3x | +122 | +64x |
- mutate(+ df[[var_name]] <- factor(relvar2_values) |
| 311 | -3x | +123 | +64x |
- DOMAIN = "QS"+ return(df) |
| 312 | +124 |
- )+ } |
||
| 313 | +125 | |||
| 314 | +126 |
- # QS prep -----------------------------------------------------------------+ #' Create Visit Schedule |
||
| 315 | +127 |
- # get questionnaire function for QS+ #' |
||
| 316 | +128 |
- # QSTESTCD: EOR0101 to EOR0130+ #' Create a visit schedule as a factor. |
||
| 317 | -3x | +|||
| 129 | +
- eortc_qlq_c30_sub <- filter(+ #' |
|||
| 318 | -3x | +|||
| 130 | +
- eortc_qlq_c30,+ #' X number of visits, or X number of cycles and Y number of days. |
|||
| 319 | -3x | +|||
| 131 | +
- as.numeric(str_extract(QSTESTCD, "\\d+$")) >= 101 &+ #' |
|||
| 320 | -3x | +|||
| 132 | +
- as.numeric(str_extract(QSTESTCD, "\\d+$")) <= 130+ #' @inheritParams argument_convention |
|||
| 321 | +133 |
- ) %>%+ #' |
||
| 322 | -3x | +|||
| 134 | +
- select(-publication_name)+ #' @return A factor of length `n_assessments`. |
|||
| 323 | +135 |
-
+ #' @export |
||
| 324 | +136 |
- # validate and initialize QSTEST vectors+ #' |
||
| 325 | -3x | +|||
| 137 | +
- qstest_init_list <- relvar_init(+ #' @examples |
|||
| 326 | -3x | +|||
| 138 | +
- unique(eortc_qlq_c30_sub$QSTEST),+ #' visit_schedule(visit_format = "WEeK", n_assessments = 10L) |
|||
| 327 | -3x | +|||
| 139 | +
- unique(eortc_qlq_c30_sub$QSTESTCD)+ #' visit_schedule(visit_format = "CyCLE", n_assessments = 5L, n_days = 2L) |
|||
| 328 | +140 |
- )+ visit_schedule <- function(visit_format = "WEEK", |
||
| 329 | +141 |
-
+ n_assessments = 10L, |
||
| 330 | -3x | +|||
| 142 | +
- if (!is.null(seed)) {
+ n_days = 5L) {
|
|||
| 331 | -3x | +143 | +56x |
- set.seed(seed)+ checkmate::assert_string(visit_format, pattern = "^WEEK$|^CYCLE$", ignore.case = TRUE) |
| 332 | -+ | |||
| 144 | +56x |
- }+ checkmate::assert_integer(n_assessments, len = 1, any.missing = FALSE)+ |
+ ||
| 145 | +56x | +
+ checkmate::assert_integer(n_days, len = 1, any.missing = FALSE) |
||
| 333 | +146 | |||
| 334 | -3x | +147 | +56x |
- checkmate::assert_data_frame(lookup, null.ok = TRUE)+ if (toupper(visit_format) == "WEEK") {
|
| 335 | +148 |
-
+ # numeric vector of n assessments/cycles/days |
||
| 336 | -3x | +149 | +49x |
- lookup_qs <- if (!is.null(lookup)) {
+ assessments <- 1:n_assessments |
| 337 | -! | +|||
| 150 | +
- lookup+ # numeric vector for ordering including screening (-1) and baseline (0) place holders+ |
+ |||
| 151 | +49x | +
+ assessments_ord <- -1:n_assessments |
||
| 338 | +152 |
- } else {
+ # character vector of nominal visit values |
||
| 339 | -3x | +153 | +49x |
- expand.grid(+ visit_values <- c("SCREENING", "BASELINE", paste(toupper(visit_format), assessments, "DAY", (assessments * 7) + 1))
|
| 340 | -3x | +154 | +7x |
- STUDYID = unique(qs$STUDYID),+ } else if (toupper(visit_format) == "CYCLE") {
|
| 341 | -3x | +155 | +7x |
- USUBJID = qs$USUBJID,+ cycles <- sort(rep(1:n_assessments, times = 1, each = n_days)) |
| 342 | -3x | +156 | +7x |
- QSTEST = qstest_init_list$relvar1,+ days <- rep(seq(1:n_days), times = n_assessments, each = 1) |
| 343 | -3x | +157 | +7x |
- VISIT = visit_schedule(+ assessments_ord <- 0:(n_assessments * n_days) |
| 344 | -3x | +158 | +7x |
- visit_format = visit_format,+ visit_values <- c("SCREENING", paste(toupper(visit_format), cycles, "DAY", days))
|
| 345 | -3x | +|||
| 159 | +
- n_assessments = n_assessments,+ } |
|||
| 346 | -3x | +|||
| 160 | +
- n_days = n_days+ |
|||
| 347 | +161 |
- ),+ # create and order factor variable to return from function |
||
| 348 | -3x | +162 | +56x |
- stringsAsFactors = FALSE+ visit_values <- stats::reorder(factor(visit_values), assessments_ord) |
| 349 | +163 |
- )+ } |
||
| 350 | +164 |
- }+ |
||
| 351 | +165 |
-
+ #' Primary Keys: Retain Values |
||
| 352 | +166 |
- # assign related variable values: QSTESTxQSTESTCD are related+ #' |
||
| 353 | -3x | +|||
| 167 | +
- lookup_qs <- lookup_qs %>% rel_var(+ #' Retain values within primary keys. |
|||
| 354 | -3x | +|||
| 168 | +
- var_name = "QSTESTCD",+ #' |
|||
| 355 | -3x | +|||
| 169 | +
- related_var = "QSTEST",+ #' @param df (`data.frame`)\cr Data frame in which to apply the retain. |
|||
| 356 | -3x | +|||
| 170 | +
- var_values = qstest_init_list$relvar2+ #' @param value_var (`any`)\cr Variable in `df` containing the value to be retained. |
|||
| 357 | +171 |
- )+ #' @param event (`expression`)\cr Expression returning a logical value to trigger the retain. |
||
| 358 | +172 |
-
+ #' @param outside (`any`)\cr Additional value to retain. Defaults to `NA`. |
||
| 359 | -3x | +|||
| 173 | +
- lookup_qs <- left_join(+ #' @return A vector of values where expression is true. |
|||
| 360 | -3x | +|||
| 174 | +
- lookup_qs,+ #' @keywords internal |
|||
| 361 | -3x | +|||
| 175 | +
- eortc_qlq_c30_sub,+ retain <- function(df, value_var, event, outside = NA) {
|
|||
| 362 | -3x | +176 | +31x |
- by = c(+ indices <- c(1, which(event == TRUE), nrow(df) + 1) |
| 363 | -3x | +177 | +31x |
- "QSTEST",+ values <- c(outside, value_var[event == TRUE]) |
| 364 | -3x | +178 | +31x |
- "QSTESTCD"+ rep(values, diff(indices)) |
| 365 | +179 |
- ),+ } |
||
| 366 | -3x | +|||
| 180 | +
- multiple = "all",+ |
|||
| 367 | -3x | +|||
| 181 | +
- relationship = "many-to-many"+ #' Primary Keys: Labels |
|||
| 368 | +182 |
- )+ #' |
||
| 369 | +183 |
-
+ #' Relabel a subset of variables in a data set. |
||
| 370 | -3x | +|||
| 184 | +
- lookup_qs <- dplyr::mutate(+ #' |
|||
| 371 | -3x | +|||
| 185 | +
- lookup_qs,+ #' @param x (`data.frame`)\cr Data frame containing variables to which labels are applied. |
|||
| 372 | -3x | +|||
| 186 | +
- VISITNUM = dplyr::case_when(+ #' @param ... (`named character`)\cr Name-Value pairs, where name corresponds to a variable |
|||
| 373 | -3x | +|||
| 187 | +
- VISIT == "SCREENING" ~ -1,+ #' name in `x` and the value to the new variable label. |
|||
| 374 | -3x | +|||
| 188 | +
- VISIT == "BASELINE" ~ 0,+ #' @return x (`data.frame`)\cr Data frame with labels applied. |
|||
| 375 | -3x | +|||
| 189 | +
- (grepl("^WEEK", VISIT) | grepl("^CYCLE", VISIT)) ~ as.numeric(VISIT) - 2,
+ #' |
|||
| 376 | -3x | +|||
| 190 | +
- TRUE ~ NA_real_+ #' @export |
|||
| 377 | +191 |
- )+ #' |
||
| 378 | -3x | +|||
| 192 | +
- ) %>% arrange(USUBJID)+ #' @examples |
|||
| 379 | +193 |
-
+ #' adsl <- radsl() |
||
| 380 | +194 |
- # # prep QSALL --------------------------------------------------------------+ #' var_relabel(adsl, |
||
| 381 | +195 |
- # get last subject and visit for QSALL+ #' STUDYID = "Study Identifier", |
||
| 382 | -3x | +|||
| 196 | +
- last_subj_vis <- select(lookup_qs, USUBJID, VISIT) %>%+ #' USUBJID = "Unique Subject Identifier" |
|||
| 383 | -3x | +|||
| 197 | +
- distinct() %>%+ #' ) |
|||
| 384 | -3x | +|||
| 198 | +
- slice(n())+ var_relabel <- function(x, ...) {
|
|||
| 385 | -3x | +199 | +82x |
- last_subj_vis_full <- filter(+ dots <- list(...) |
| 386 | -3x | +200 | +82x |
- lookup_qs,+ varnames <- names(dots) |
| 387 | -3x | +201 | +82x |
- USUBJID == last_subj_vis$USUBJID,+ if (is.null(varnames)) {
|
| 388 | -3x | +202 | +1x |
- VISIT == last_subj_vis$VISIT+ stop("missing variable declarations")
|
| 389 | +203 |
- )+ } |
||
| 390 | -+ | |||
| 204 | +81x |
-
+ map_varnames <- match(varnames, names(x)) |
||
| 391 | -3x | +205 | +81x |
- qsall_data1 <- tibble::tibble(+ for (i in seq_along(map_varnames)) {
|
| 392 | -3x | +206 | +161x |
- STUDYID = unique(last_subj_vis_full$STUDYID),+ attr(x[[map_varnames[[i]]]], "label") <- dots[[i]] |
| 393 | -3x | +|||
| 207 | +
- USUBJID = unique(last_subj_vis_full$USUBJID),+ } |
|||
| 394 | -3x | +208 | +81x |
- VISIT = unique(last_subj_vis_full$VISIT),+ x |
| 395 | -3x | +|||
| 209 | +
- VISITNUM = unique(last_subj_vis_full$VISITNUM),+ } |
|||
| 396 | -3x | +|||
| 210 | +
- QSTESTCD = "QSALL",+ |
|||
| 397 | -3x | +|||
| 211 | +
- QSTEST = "Questionnaires",+ #' Apply Metadata |
|||
| 398 | -3x | +|||
| 212 | +
- QSSTAT = "NOT DONE",+ #' |
|||
| 399 | -3x | +|||
| 213 | +
- QSREASND = "SUBJECT REFUSED"+ #' Apply label and variable ordering attributes to domains. |
|||
| 400 | +214 |
- )+ #' |
||
| 401 | +215 |
-
+ #' @param df (`data.frame`)\cr Data frame to which metadata is applied. |
||
| 402 | +216 |
- # remove last subject and visit from main data+ #' @param filename (`yaml`)\cr File containing domain metadata. |
||
| 403 | -3x | +|||
| 217 | +
- lookup_qs_sub <- anti_join(+ #' @param add_adsl (`logical`)\cr Should ADSL data be merged to domain. |
|||
| 404 | -3x | +|||
| 218 | +
- lookup_qs,+ #' @param adsl_filename (`yaml`)\cr File containing ADSL metadata. |
|||
| 405 | -3x | +|||
| 219 | +
- last_subj_vis_full,+ #' @return Data frame with metadata applied. |
|||
| 406 | -3x | +|||
| 220 | +
- by = c("USUBJID", "VISIT")
+ #' |
|||
| 407 | +221 |
- )+ #' @export |
||
| 408 | +222 |
-
+ #' @examples |
||
| 409 | -3x | +|||
| 223 | +
- set.seed(seed)+ #' seed <- 1 |
|||
| 410 | -3x | +|||
| 224 | +
- lookup_qs_sub_x <- lookup_qs_sub %>%+ #' adsl <- radsl(seed = seed) |
|||
| 411 | -3x | -
- group_by(- |
- ||
| 412 | -3x | +|||
| 225 | +
- USUBJID,+ #' adsub <- radsub(adsl, seed = seed) |
|||
| 413 | -3x | +|||
| 226 | +
- QSTESTCD,+ #' yaml_path <- file.path(path.package("random.cdisc.data"), "inst", "metadata")
|
|||
| 414 | -3x | +|||
| 227 | +
- VISIT+ #' adsl <- apply_metadata(adsl, file.path(yaml_path, "ADSL.yml"), FALSE) |
|||
| 415 | +228 |
- ) %>%+ #' adsub <- apply_metadata( |
||
| 416 | -3x | +|||
| 229 | +
- slice_sample(n = 1) %>%+ #' adsub, file.path(yaml_path, "ADSUB.yml"), TRUE, |
|||
| 417 | -3x | +|||
| 230 | +
- ungroup() %>%+ #' file.path(yaml_path, "ADSL.yml") |
|||
| 418 | -3x | +|||
| 231 | +
- as.data.frame()+ #' ) |
|||
| 419 | +232 |
-
+ apply_metadata <- function(df, filename, add_adsl = TRUE, adsl_filename = "metadata/ADSL.yml") {
|
||
| 420 | -3x | +233 | +90x |
- lookup_qs_sub_x <- arrange(+ checkmate::assert_data_frame(df) |
| 421 | -3x | +234 | +90x |
- lookup_qs_sub_x,+ checkmate::assert_string(filename) |
| 422 | -3x | +235 | +90x |
- USUBJID,+ checkmate::assert_flag(add_adsl) |
| 423 | -3x | +236 | +90x |
- VISITNUM+ checkmate::assert_string(adsl_filename) |
| 424 | +237 |
- )+ |
||
| 425 | -+ | |||
| 238 | +90x |
-
+ apply_type <- function(df, var, type) {
+ |
+ ||
| 239 | +5986x | +
+ if (is.null(type)) {
+ |
+ ||
| 240 | +! | +
+ return() |
||
| 426 | +241 |
- # add date: QSDTC ---------------------------------------------------------+ } |
||
| 427 | +242 |
- # get treatment dates from ADSL+ |
||
| 428 | -3x | +243 | +5986x |
- adsl_trt <- select(+ if (type == "character" && !is.character(df[[var]])) {
|
| 429 | -3x | +244 | +12x |
- adsl,+ df[[var]] <- as.character(df[[var]]) |
| 430 | -3x | +245 | +5974x |
- USUBJID,+ } else if (type == "factor" && !is.factor(df[[var]])) {
|
| 431 | -3x | +246 | +730x |
- TRTSDTM,+ df[[var]] <- as.factor(df[[var]]) |
| 432 | -3x | +247 | +5244x |
- TRTEDTM+ } else if (type == "integer" && !is.integer(df[[var]])) {
|
| 433 | -+ | |||
| 248 | +225x |
- )+ df[[var]] <- as.integer(df[[var]]) |
||
| 434 | -+ | |||
| 249 | +5019x |
- # use to derive QSDTC+ } else if (type == "numeric" && !is.numeric(df[[var]])) {
|
||
| 435 | -+ | |||
| 250 | +3x |
- # if no treatment end date, create an arbituary one+ df[[var]] <- as.numeric(df[[var]]) |
||
| 436 | -3x | +251 | +5016x |
- trt_end_date <- max(adsl_trt$TRTEDTM, na.rm = TRUE)+ } else if (type == "logical" && !is.logical(df[[var]])) {
|
| 437 | -+ | |||
| 252 | +! |
-
+ df[[var]] <- as.logical(df[[var]]) |
||
| 438 | -3x | +253 | +5016x |
- lookup_qs_sub_x <- left_join(+ } else if (type == "datetime" && !lubridate::is.POSIXct(df[[var]])) {
|
| 439 | -3x | +254 | +9x |
- lookup_qs_sub_x,+ df[[var]] <- as.POSIXct(df[[var]]) |
| 440 | -3x | +255 | +5007x |
- adsl_trt,+ } else if (type == "date" && !lubridate::is.Date(df[[var]])) {
|
| 441 | -3x | +|||
| 256 | +! |
- by = "USUBJID"+ df[[var]] <- as.Date(df[[var]]) |
||
| 442 | +257 |
- ) %>%- |
- ||
| 443 | -3x | -
- group_by(+ } |
||
| 444 | -3x | +258 | +5986x |
- USUBJID+ return(df) |
| 445 | +259 |
- ) %>%+ } |
||
| 446 | -3x | +|||
| 260 | +
- mutate(QSDTC = get_random_dates_between(+ |
|||
| 447 | -3x | +|||
| 261 | +
- from = TRTSDTM,+ # remove existing attributes |
|||
| 448 | -3x | +262 | +90x |
- to = ifelse(+ for (i in base::setdiff(names(attributes(df)), names(attributes(data.frame())))) {
|
| 449 | +263 | 3x |
- is.na(TRTEDTM),+ attr(df, i) <- NULL |
|
| 450 | -3x | +|||
| 264 | +
- trt_end_date,+ } |
|||
| 451 | -3x | +|||
| 265 | +
- TRTEDTM+ |
|||
| 452 | +266 |
- ),+ # get metadata |
||
| 453 | -3x | +267 | +90x |
- visit_id = VISITNUM+ metadata <- yaml::yaml.load_file(system.file(filename, package = "random.cdisc.data")) |
| 454 | -+ | |||
| 268 | +90x |
- )) %>%+ adsl_metadata <- if (add_adsl) {
|
||
| 455 | -3x | +269 | +64x |
- select(-c("TRTSDTM", "TRTEDTM"))
+ yaml::yaml.load_file(system.file(adsl_filename, package = "random.cdisc.data")) |
| 456 | +270 |
-
+ } else {
|
||
| 457 | -+ | |||
| 271 | +26x |
- # filter out subjects with missing dates+ NULL |
||
| 458 | -3x | +|||
| 272 | +
- lookup_qs_sub_x1 <- filter(+ } |
|||
| 459 | -3x | +273 | +90x |
- lookup_qs_sub_x,+ metadata_variables <- append(adsl_metadata$variables, metadata$variables) |
| 460 | -3x | +274 | +90x |
- !is.na(QSDTC)+ metadata_varnames <- names(metadata_variables) |
| 461 | +275 |
- )+ |
||
| 462 | +276 |
-
+ # find variables that does not have labels and are not it metadata |
||
| 463 | -+ | |||
| 277 | +90x |
- # subjects with missing dates+ missing_vars_map <- vapply( |
||
| 464 | -3x | +278 | +90x |
- lookup_qs_sub_x2 <- filter(+ names(df), |
| 465 | -3x | +279 | +90x |
- lookup_qs_sub_x,+ function(x) {
|
| 466 | -3x | +280 | +5986x |
- is.na(QSDTC)+ !(x %in% c("STUDYID", "USUBJID", metadata_varnames)) && is.null(attr(df[[x]], "label"))
|
| 467 | +281 |
- ) %>%+ }, |
||
| 468 | -3x | +282 | +90x |
- select(+ logical(1) |
| 469 | -3x | +|||
| 283 | +
- STUDYID,+ ) |
|||
| 470 | -3x | +284 | +90x |
- USUBJID,+ missing_vars <- names(df)[missing_vars_map] |
| 471 | -3x | +285 | +90x |
- VISIT,+ if (length(missing_vars) > 0) {
|
| 472 | -3x | +|||
| 286 | +! |
- VISITNUM+ msg <- paste0( |
||
| 473 | -+ | |||
| 287 | +! |
- ) %>%+ "Following variables does not have label or are not found in ", |
||
| 474 | -3x | +|||
| 288 | +! |
- distinct()+ filename, |
||
| 475 | +289 |
-
+ ": ", |
||
| 476 | -+ | |||
| 290 | +! |
- # generate QSALL for subjects with missing dates+ paste0(missing_vars, collapse = ", ") |
||
| 477 | -3x | +|||
| 291 | +
- qsall_data2 <- mutate(+ ) |
|||
| 478 | -3x | +|||
| 292 | +! |
- lookup_qs_sub_x2,+ warning(msg) |
||
| 479 | -3x | +|||
| 293 | +
- QSTESTCD = "QSALL",+ } |
|||
| 480 | -3x | +|||
| 294 | +
- QSTEST = "Questionnaires",+ |
|||
| 481 | -3x | +295 | +90x |
- QSSTAT = "NOT DONE",+ if (!all(metadata_varnames %in% names(df))) {
|
| 482 | -3x | +296 | +6x |
- QSREASND = "SUBJECT REFUSED"+ metadata_varnames <- metadata_varnames[metadata_varnames %in% names(df)] |
| 483 | +297 |
- )+ } |
||
| 484 | +298 | |||
| 485 | +299 |
- # add qsall data to original item data- |
- ||
| 486 | -3x | -
- lookup_qs_sub_all <- bind_rows(+ # assign labels to variables |
||
| 487 | -3x | +300 | +90x |
- lookup_qs_sub_x1,+ for (var in metadata_varnames) {
|
| 488 | -3x | +301 | +5986x |
- qsall_data1,+ df <- apply_type(df, var, metadata_variables[[var]]$type) |
| 489 | -3x | +302 | +5986x |
- qsall_data2+ attr(df[[var]], "label") <- metadata_variables[[var]]$label |
| 490 | +303 |
- )+ } |
||
| 491 | +304 | |||
| 492 | -3x | +|||
| 305 | +
- qs_all <- lookup_qs_sub_all %>%+ # reorder data frame columns to expected BDS order |
|||
| 493 | -3x | +306 | +90x |
- arrange(+ df <- df[, unique(c("STUDYID", "USUBJID", metadata_varnames, names(df)))]
|
| 494 | -3x | +|||
| 307 | +
- STUDYID,+ |
|||
| 495 | -3x | +|||
| 308 | +
- USUBJID,+ # assign label to data frame |
|||
| 496 | -3x | +309 | +90x |
- VISITNUM+ attr(df, "label") <- metadata$domain$label |
| 497 | +310 |
- ) %>%+ |
||
| 498 | -3x | +311 | +90x |
- dplyr::group_by(USUBJID) %>%+ df |
| 499 | -3x | +|||
| 312 | +
- dplyr::ungroup()+ } |
|||
| 500 | +313 | |||
| 501 | +314 |
- # get first and second subject ids+ #' Replace Values in a Vector by NA |
||
| 502 | -3x | +|||
| 315 | +
- first_second_subj <- select(qs_all, USUBJID) %>%+ #' |
|||
| 503 | -3x | +|||
| 316 | +
- distinct() %>%+ #' @description `r lifecycle::badge("stable")`
|
|||
| 504 | -3x | +|||
| 317 | +
- slice(1:2)+ #' |
|||
| 505 | +318 |
-
+ #' Randomized replacement of values by `NA`. |
||
| 506 | -3x | +|||
| 319 | +
- qs1 <- filter(+ #' |
|||
| 507 | -3x | +|||
| 320 | +
- qs_all,+ #' @inheritParams argument_convention |
|||
| 508 | -3x | +|||
| 321 | +
- USUBJID %in% first_second_subj$USUBJID+ #' @param v (`any`)\cr Vector of any type. |
|||
| 509 | +322 |
- )+ #' @param percentage (`proportion`)\cr Value between 0 and 1 defining |
||
| 510 | +323 |
-
+ #' how much of the vector shall be replaced by `NA`. This number |
||
| 511 | -3x | +|||
| 324 | +
- if (length(na_vars) > 0 && na_percentage > 0) {
+ #' is randomized by +/- 5% to have full randomization. |
|||
| 512 | -3x | +|||
| 325 | +
- qs1 <- mutate_na(ds = qs1, na_vars = na_vars, na_percentage = na_percentage)+ #' |
|||
| 513 | +326 |
- }+ #' @return The input vector `v` where a certain number of values are replaced by `NA`. |
||
| 514 | +327 |
-
+ #' |
||
| 515 | +328 |
- # QSSTAT = NOT DONE+ #' @export |
||
| 516 | -3x | +|||
| 329 | +
- qs1 <- mutate(+ replace_na <- function(v, percentage = 0.05, seed = NULL) {
|
|||
| 517 | -3x | +330 | +9x |
- qs1,+ checkmate::assert_number(percentage, lower = 0, upper = 1)+ |
+
| 331 | ++ | + | ||
| 518 | -3x | +332 | +9x |
- QSSTAT = case_when(+ if (percentage == 0) {
|
| 519 | -3x | +333 | +1x |
- is.na(QSORRES) & is.na(QSSTRESC) ~ "NOT DONE"+ return(v) |
| 520 | +334 |
- )+ } |
||
| 521 | +335 |
- )+ + |
+ ||
| 336 | +8x | +
+ if (!is.null(seed) && !is.na(seed)) {
+ |
+ ||
| 337 | +8x | +
+ set.seed(seed) |
||
| 522 | +338 |
-
+ } |
||
| 523 | +339 |
- # remove first and second subjects from main data+ |
||
| 524 | -3x | +|||
| 340 | +
- qs2 <- anti_join(+ # randomize the percentage |
|||
| 525 | -3x | +341 | +8x |
- qs_all,+ ind <- sample(seq_along(v), round(length(v) * percentage)) |
| 526 | -3x | +|||
| 342 | +
- qs1,+ |
|||
| 527 | -3x | +343 | +8x |
- by = c("USUBJID")
+ v[ind] <- NA |
| 528 | +344 |
- )+ + |
+ ||
| 345 | +8x | +
+ return(v) |
||
| 529 | +346 |
-
+ } |
||
| 530 | -3x | +|||
| 347 | +
- final_qs <- rbind(+ |
|||
| 531 | -3x | +|||
| 348 | +
- qs1,+ #' Replace Values with NA |
|||
| 532 | -3x | +|||
| 349 | +
- qs2+ #' |
|||
| 533 | +350 |
- ) %>%+ #' @description `r lifecycle::badge("stable")`
|
||
| 534 | -3x | +|||
| 351 | +
- group_by(USUBJID) %>%+ #' |
|||
| 535 | -3x | +|||
| 352 | +
- dplyr::mutate(QSSEQ = row_number()) %>%+ #' Replace column values with `NA`s. |
|||
| 536 | -3x | +|||
| 353 | +
- arrange(+ #' |
|||
| 537 | -3x | +|||
| 354 | +
- STUDYID,+ #' @inheritParams argument_convention |
|||
| 538 | -3x | +|||
| 355 | +
- USUBJID,+ #' @param ds (`data.frame`)\cr Any data set. |
|||
| 539 | -3x | +|||
| 356 | +
- VISITNUM+ #' |
|||
| 540 | +357 |
- ) %>%+ #' @return dataframe without `NA` values. |
||
| 541 | -3x | +|||
| 358 | +
- ungroup()+ #' |
|||
| 542 | +359 |
-
+ #' @export |
||
| 543 | +360 |
- # ordered variables as per gdsr+ mutate_na <- function(ds, na_vars = NULL, na_percentage = 0.05) {
|
||
| 544 | -3x | +361 | +5x |
- final_qs <- select(+ if (!is.null(na_vars)) {
|
| 545 | -3x | +362 | +4x |
- final_qs,+ stopifnot(is.list(na_vars)) # any list is OK; as values can be left NA |
| 546 | -3x | +363 | +4x |
- STUDYID,+ stopifnot(length(names(na_vars)) == length(na_vars)) # names for all elements |
| 547 | -3x | +|||
| 364 | +
- USUBJID,+ } else {
|
|||
| 548 | -3x | +365 | +1x |
- QSSEQ,+ na_vars <- names(ds) |
| 549 | -3x | +|||
| 366 | +
- QSTESTCD,+ } |
|||
| 550 | -3x | +|||
| 367 | +
- QSTEST,+ |
|||
| 551 | -3x | +368 | +5x |
- QSCAT,+ stopifnot(is.numeric(na_percentage)) |
| 552 | -3x | +369 | +5x |
- QSSCAT,+ stopifnot(na_percentage >= 0 && na_percentage < 1) |
| 553 | -3x | +|||
| 370 | +
- QSORRES,+ |
|||
| 554 | -3x | +371 | +5x |
- QSORRESU,+ for (na_var in names(na_vars)) {
|
| 555 | -3x | +372 | +8x |
- QSSTRESC,+ if (!is.na(na_var)) {
|
| 556 | -3x | +373 | +8x |
- QSSTRESU,+ if (!na_var %in% names(ds)) {
|
| 557 | -3x | +374 | +1x |
- QSSTAT,+ warning(paste(na_var, "not in column names"))+ |
+
| 375 | ++ |
+ } else {
|
||
| 558 | -3x | +376 | +7x |
- QSREASND,+ ds <- ds %>% |
| 559 | -3x | +377 | +7x |
- VISITNUM,+ ungroup_rowwise_df() %>% |
| 560 | -3x | +378 | +7x |
- VISIT,+ dplyr::mutate( |
| 561 | -3x | +379 | +7x |
- QSDTC,+ !!na_var := ds[[na_var]] %>% |
| 562 | -3x | +380 | +7x |
- QSEVLINT+ replace_na( |
| 563 | -+ | |||
| 381 | +7x |
- )+ percentage = ifelse(is.na(na_vars[[na_var]][2]), na_percentage, na_vars[[na_var]][2]), |
||
| 564 | -3x | +382 | +7x |
- return(final_qs)+ seed = na_vars[[na_var]][1] |
| 565 | +383 |
- }+ ) |
||
| 566 | +384 |
-
+ ) |
||
| 567 | +385 |
- #' @describeIn h_adqlqc Function for generating random dates between 2 dates+ } |
||
| 568 | +386 |
- #'+ } |
||
| 569 | +387 |
- #' @param from (`datetime vector`)\cr Start date/times.+ } |
||
| 570 | -+ | |||
| 388 | +5x |
- #' @param to (`datetime vector`)\cr End date/times.+ return(ds) |
||
| 571 | +389 |
- #' @param visit_id (`vector`)\cr Visit identifiers.+ } |
||
| 572 | +390 |
- #'+ |
||
| 573 | +391 |
- #' @return Data frame with new randomly generated dates variable.+ ungroup_rowwise_df <- function(x) {
+ |
+ ||
| 392 | +7x | +
+ class(x) <- c("tbl", "tbl_df", "data.frame")
+ |
+ ||
| 393 | +7x | +
+ return(x) |
||
| 574 | +394 |
- #' @keywords internal+ } |
||
| 575 | +395 |
- #'+ |
||
| 576 | +396 |
- #' @examples+ #' Zero-Truncated Poisson Distribution |
||
| 577 | +397 |
- #' \dontrun{
+ #' |
||
| 578 | +398 |
- #' df <- dplyr::left_join(+ #' @description `r lifecycle::badge("stable")`
|
||
| 579 | +399 |
- #' adsl,+ #' |
||
| 580 | +400 |
- #' qs,+ #' This generates random numbers from a zero-truncated Poisson distribution, |
||
| 581 | +401 |
- #' by = c("STUDYID", "USUBJID"),
+ #' i.e. from `X | X > 0` when `X ~ Poisson(lambda)`. The advantage here is that |
||
| 582 | +402 |
- #' multiple = "all"+ #' we guarantee to return exactly `n` numbers and without using a loop internally. |
||
| 583 | +403 |
- #' ) |>+ #' This solution was provided in a post by |
||
| 584 | +404 |
- #' dplyr::mutate(+ #' [Peter Dalgaard](https://stat.ethz.ch/pipermail/r-help/2005-May/070680.html). |
||
| 585 | +405 |
- #' AVISIT = VISIT,+ #' |
||
| 586 | +406 |
- #' PARAMCD = QSTESTCD,+ #' @param n (`numeric`)\cr Number of random numbers. |
||
| 587 | +407 |
- #' AVISITN = VISITNUM+ #' @param lambda (`numeric`)\cr Non-negative mean(s). |
||
| 588 | +408 |
- #' ) |>+ #' |
||
| 589 | +409 |
- #' dplyr::mutate(ADTM = random.cdisc.data:::get_random_dates_between(TRTSDTM, TRTEDTM, AVISITN))+ #' @return The random numbers. |
||
| 590 | +410 |
- #' df+ #' @export |
||
| 591 | +411 |
- #' }+ #' |
||
| 592 | +412 |
- get_random_dates_between <- function(from, to, visit_id) {
+ #' @examples |
||
| 593 | -30x | +|||
| 413 | +
- min_date <- min(lubridate::as_datetime(from), na.rm = TRUE)+ #' x <- rpois(1e6, lambda = 5) |
|||
| 594 | -30x | +|||
| 414 | +
- max_date <- max(lubridate::as_datetime(to), na.rm = TRUE)+ #' x <- x[x > 0] |
|||
| 595 | -30x | +|||
| 415 | +
- date_seq <- seq(from = min_date + lubridate::days(1), to = max_date, by = "28 days")+ #' hist(x) |
|||
| 596 | +416 |
-
+ #' |
||
| 597 | -30x | +|||
| 417 | +
- visit_ids <- unique(visit_id)+ #' y <- rtpois(1e6, lambda = 5) |
|||
| 598 | -30x | +|||
| 418 | +
- out <- sapply(visit_ids, simplify = TRUE, USE.NAMES = TRUE, FUN = function(x) {
+ #' hist(y) |
|||
| 599 | -177x | +|||
| 419 | +
- if (x == -1) {
+ rtpois <- function(n, lambda) {
|
|||
| 600 | -30x | +420 | +121x |
- random_days_to_subtract <- lubridate::days(sample(1:10, size = 1))+ stats::qpois(stats::runif(n, stats::dpois(0, lambda), 1), lambda) |
| 601 | -30x | +|||
| 421 | +
- min_date - random_days_to_subtract+ } |
|||
| 602 | -147x | +|||
| 422 | +
- } else if (x == 0) {
+
|
|||
| 603 | -30x | +|||
| 423 | +
- min_date+ #' Truncated Exponential Distribution |
|||
| 604 | -117x | +|||
| 424 | +
- } else if (x > 0) {
+ #' |
|||
| 605 | -117x | +|||
| 425 | +
- if (x %in% seq_along(date_seq)) {
+ #' @description `r lifecycle::badge("stable")`
|
|||
| 606 | -117x | +|||
| 426 | +
- date_seq[[x]]+ #' |
|||
| 607 | +427 |
- } else {
+ #' This generates random numbers from a truncated Exponential distribution, |
||
| 608 | -30x | +|||
| 428 | +
- NA+ #' i.e. from `X | X > l` or `X | X < r` when `X ~ Exp(rate)`. The advantage here is that |
|||
| 609 | +429 |
- }+ #' we guarantee to return exactly `n` numbers and without using a loop internally. |
||
| 610 | +430 |
- }+ #' This can be derived from the quantile functions of the left- and right-truncated |
||
| 611 | +431 |
- })+ #' Exponential distributions. |
||
| 612 | -30x | +|||
| 432 | +
- lubridate::as_datetime(out[match(visit_id, visit_ids)])+ #' |
|||
| 613 | +433 |
- }+ #' @param n (`numeric`)\cr Number of random numbers. |
||
| 614 | +434 |
-
+ #' @param rate (`numeric`)\cr Non-negative rate. |
||
| 615 | +435 |
- #' @describeIn h_adqlqc Prepare ADaM ADQLQC data, adding PARAMCD to SDTM QS data+ #' @param l (`numeric`)\cr Positive left-hand truncation parameter. |
||
| 616 | +436 |
- #'+ #' @param r (`numeric`)\cr Positive right-hand truncation parameter. |
||
| 617 | +437 |
- #' @param df (`data.frame`)\cr SDTM QS dataset.+ #' |
||
| 618 | +438 |
- #'+ #' @return The random numbers. If neither `l` nor `r` are provided then the usual Exponential |
||
| 619 | +439 |
- #' @return `data.frame`+ #' distribution is used. |
||
| 620 | +440 |
- #' @keywords internal+ #' @export |
||
| 621 | +441 |
#' |
||
| 622 | +442 |
#' @examples |
||
| 623 | +443 |
- #' \dontrun{
+ #' x <- stats::rexp(1e6, rate = 5) |
||
| 624 | +444 |
- #' adqlqc1 <- random.cdisc.data:::prep_adqlqc(df = qs)+ #' x <- x[x > 0.5] |
||
| 625 | +445 |
- #' adqlqc1+ #' hist(x) |
||
| 626 | +446 |
- #' }+ #' |
||
| 627 | +447 |
- prep_adqlqc <- function(df) {
+ #' y <- rtexp(1e6, rate = 5, l = 0.5) |
||
| 628 | +448 |
- # create PARAMCD from QSTESTCD+ #' hist(y) |
||
| 629 | -3x | +|||
| 449 | +
- adqlqc <- dplyr::mutate(+ #' |
|||
| 630 | -3x | +|||
| 450 | +
- df,+ #' z <- rtexp(1e6, rate = 5, r = 0.5) |
|||
| 631 | -3x | +|||
| 451 | +
- PARAMCD = case_when(+ #' hist(z) |
|||
| 632 | -3x | +|||
| 452 | +
- QSTESTCD == "EOR0101" ~ "QS02801",+ rtexp <- function(n, rate, l = NULL, r = NULL) {
|
|||
| 633 | -3x | +453 | +123x |
- QSTESTCD == "EOR0102" ~ "QS02802",+ if (!is.null(l)) {
|
| 634 | -3x | +454 | +1x |
- QSTESTCD == "EOR0103" ~ "QS02803",+ l - log(1 - stats::runif(n)) / rate |
| 635 | -3x | +455 | +122x |
- QSTESTCD == "EOR0104" ~ "QS02804",+ } else if (!is.null(r)) {
|
| 636 | -3x | +456 | +121x |
- QSTESTCD == "EOR0105" ~ "QS02805",+ -log(1 - stats::runif(n) * (1 - exp(-r * rate))) / rate |
| 637 | -3x | +|||
| 457 | +
- QSTESTCD == "EOR0106" ~ "QS02806",+ } else {
|
|||
| 638 | -3x | +458 | +1x |
- QSTESTCD == "EOR0107" ~ "QS02807",+ stats::rexp(n, rate) |
| 639 | -3x | +|||
| 459 | +
- QSTESTCD == "EOR0108" ~ "QS02808",+ } |
|||
| 640 | -3x | +|||
| 460 | +
- QSTESTCD == "EOR0109" ~ "QS02809",+ } |
|||
| 641 | -3x | +
| 1 | +
- QSTESTCD == "EOR0110" ~ "QS02810",+ #' Pharmacokinetics Analysis Dataset (ADPC) |
|||
| 642 | -3x | +|||
| 2 | +
- QSTESTCD == "EOR0111" ~ "QS02811",+ #' |
|||
| 643 | -3x | +|||
| 3 | +
- QSTESTCD == "EOR0112" ~ "QS02812",+ #' @description `r lifecycle::badge("stable")`
|
|||
| 644 | -3x | +|||
| 4 | +
- QSTESTCD == "EOR0113" ~ "QS02813",+ #' |
|||
| 645 | -3x | +|||
| 5 | +
- QSTESTCD == "EOR0114" ~ "QS02814",+ #' Function for generating a random Pharmacokinetics Analysis Dataset for a given |
|||
| 646 | -3x | +|||
| 6 | +
- QSTESTCD == "EOR0115" ~ "QS02815",+ #' Subject-Level Analysis Dataset. |
|||
| 647 | -3x | +|||
| 7 | +
- QSTESTCD == "EOR0116" ~ "QS02816",+ #' |
|||
| 648 | -3x | +|||
| 8 | +
- QSTESTCD == "EOR0117" ~ "QS02817",+ #' @details One record per study, subject, parameter, and time point. |
|||
| 649 | -3x | +|||
| 9 | +
- QSTESTCD == "EOR0118" ~ "QS02818",+ #' |
|||
| 650 | -3x | +|||
| 10 | +
- QSTESTCD == "EOR0119" ~ "QS02819",+ #' @inheritParams argument_convention |
|||
| 651 | -3x | +|||
| 11 | +
- QSTESTCD == "EOR0120" ~ "QS02820",+ #' @param avalu (`character`)\cr Analysis value units. |
|||
| 652 | -3x | +|||
| 12 | +
- QSTESTCD == "EOR0121" ~ "QS02821",+ #' @param constants (`character vector`)\cr Constant parameters to be used in formulas for creating analysis values. |
|||
| 653 | -3x | +|||
| 13 | +
- QSTESTCD == "EOR0122" ~ "QS02822",+ #' @param duration (`numeric`)\cr Duration in number of days. |
|||
| 654 | -3x | +|||
| 14 | +
- QSTESTCD == "EOR0123" ~ "QS02823",+ #' @template param_cached |
|||
| 655 | -3x | +|||
| 15 | +
- QSTESTCD == "EOR0124" ~ "QS02824",+ #' @templateVar data adpc |
|||
| 656 | -3x | +|||
| 16 | +
- QSTESTCD == "EOR0125" ~ "QS02825",+ #' |
|||
| 657 | -3x | +|||
| 17 | +
- QSTESTCD == "EOR0126" ~ "QS02826",- |
- |||
| 658 | -3x | -
- QSTESTCD == "EOR0127" ~ "QS02827",- |
- ||
| 659 | -3x | -
- QSTESTCD == "EOR0128" ~ "QS02828",- |
- ||
| 660 | -3x | -
- QSTESTCD == "EOR0129" ~ "QS02829",- |
- ||
| 661 | -3x | -
- QSTESTCD == "EOR0130" ~ "QS02830",- |
- ||
| 662 | -3x | -
- TRUE ~ QSTESTCD- |
- ||
| 663 | -- |
- )- |
- ||
| 664 | -- |
- )- |
- ||
| 665 | -3x | -
- load(system.file("sysdata.rda", package = "random.cdisc.data"))
- |
- ||
| 666 | -3x | -
- adqlqc1 <- dplyr::left_join(- |
- ||
| 667 | -3x | -
- adqlqc,- |
- ||
| 668 | -3x | -
- gdsr_param_adqlqc,- |
- ||
| 669 | -3x | -
- by = "PARAMCD"+ #' @return `data.frame` |
||
| 670 | +18 |
- )- |
- ||
| 671 | -3x | -
- return(adqlqc1)+ #' @export |
||
| 672 | +19 |
- }+ #' |
||
| 673 | +20 |
-
+ #' @examples |
||
| 674 | +21 |
- #' @describeIn h_adqlqc Scale calculation for ADQLQC data+ #' adsl <- radsl(N = 10, seed = 1, study_duration = 2) |
||
| 675 | +22 |
#' |
||
| 676 | +23 |
- #' @param adqlqc1 (`data.frame`)\cr Prepared data generated from the [prep_adqlqc()] function.+ #' adpc <- radpc(adsl, seed = 2) |
||
| 677 | +24 |
- #'+ #' adpc |
||
| 678 | +25 |
- #' @return `data.frame`+ #' |
||
| 679 | +26 |
- #' @keywords internal+ #' adpc <- radpc(adsl, seed = 2, duration = 3) |
||
| 680 | +27 |
- #'+ #' adpc |
||
| 681 | +28 |
- #' @examples+ radpc <- function(adsl, |
||
| 682 | +29 |
- #' \dontrun{
+ avalu = "ug/mL", |
||
| 683 | +30 |
- #' df_scales <- random.cdisc.data:::calc_scales(df)+ constants = c(D = 100, ka = 0.8, ke = 1), |
||
| 684 | +31 |
- #' df_scales+ duration = 2, |
||
| 685 | +32 |
- #' }+ seed = NULL, |
||
| 686 | +33 |
- calc_scales <- function(adqlqc1) {
+ na_percentage = 0, |
||
| 687 | +34 |
- # Prep scale data ---------------------------------------------------------+ na_vars = list( |
||
| 688 | +35 |
- # parcat2 = scales or global health status+ AVAL = c(NA, 0.1) |
||
| 689 | +36 |
- # global health status/scales data+ ), |
||
| 690 | +37 |
- # QSTESTCD: EOR0131 to EOR0145 (global health status and scales)+ cached = FALSE) {
|
||
| 691 | -3x | +38 | +5x |
- load(system.file("sysdata.rda", package = "random.cdisc.data"))
+ checkmate::assert_flag(cached) |
| 692 | -3x | +39 | +5x |
- eortc_qlq_c30_sub <- filter(+ if (cached) {
|
| 693 | -3x | +40 | +1x |
- eortc_qlq_c30,+ return(get_cached_data("cadpc"))
|
| 694 | -3x | +|||
| 41 | +
- !(as.numeric(str_extract(QSTESTCD, "\\d+$")) >= 101 & as.numeric(str_extract(QSTESTCD, "\\d+$")) <= 130)+ } |
|||
| 695 | +42 |
- ) %>%+ |
||
| 696 | -3x | +43 | +4x |
- mutate(+ checkmate::assert_data_frame(adsl) |
| 697 | -3x | +44 | +4x |
- PARAMCD = case_when(+ checkmate::assert_character(avalu, len = 1, any.missing = FALSE) |
| 698 | -3x | +45 | +4x |
- QSTESTCD == "EOR0131" ~ "QS028QL2",+ checkmate::assert_subset(names(constants), c("D", "ka", "ke"))
|
| 699 | -3x | +46 | +4x |
- QSTESTCD == "EOR0132" ~ "QS028PF2",+ checkmate::assert_numeric(x = duration, max.len = 1) |
| 700 | -3x | +47 | +4x |
- QSTESTCD == "EOR0133" ~ "QS028RF2",+ checkmate::assert_number(seed, null.ok = TRUE) |
| 701 | -3x | +48 | +4x |
- QSTESTCD == "EOR0134" ~ "QS028EF",+ checkmate::assert_number(na_percentage, lower = 0, upper = 1) |
| 702 | -3x | +49 | +4x |
- QSTESTCD == "EOR0135" ~ "QS028CF",+ checkmate::assert_true(na_percentage < 1) |
| 703 | -3x | +50 | +4x |
- QSTESTCD == "EOR0136" ~ "QS028SF",+ checkmate::assert_list(na_vars) |
| 704 | -3x | +|||
| 51 | +
- QSTESTCD == "EOR0137" ~ "QS028FA",+ |
|||
| 705 | -3x | +52 | +4x |
- QSTESTCD == "EOR0138" ~ "QS028NV",+ if (!is.null(seed)) {
|
| 706 | -3x | +53 | +4x |
- QSTESTCD == "EOR0139" ~ "QS028PA",+ set.seed(seed) |
| 707 | -3x | +|||
| 54 | +
- QSTESTCD == "EOR0140" ~ "QS028DY",+ } |
|||
| 708 | -3x | +|||
| 55 | +
- QSTESTCD == "EOR0141" ~ "QS028SL",+ |
|||
| 709 | -3x | +56 | +4x |
- QSTESTCD == "EOR0142" ~ "QS028AP",+ radpc_core <- function(day) {
|
| 710 | -3x | +57 | +8x |
- QSTESTCD == "EOR0143" ~ "QS028CO",+ adpc_day <- tidyr::expand_grid( |
| 711 | -3x | +58 | +8x |
- QSTESTCD == "EOR0144" ~ "QS028DI",+ data.frame( |
| 712 | -3x | +59 | +8x |
- QSTESTCD == "EOR0145" ~ "QS028FI",+ STUDYID = adsl$STUDYID, |
| 713 | -3x | +60 | +8x |
- TRUE ~ QSTESTCD+ USUBJID = adsl$USUBJID, |
| 714 | -+ | |||
| 61 | +8x |
- )+ ARMCD = adsl$ARMCD, |
||
| 715 | -+ | |||
| 62 | +8x |
- ) %>%+ A0 = unname(constants["D"]), |
||
| 716 | -3x | +63 | +8x |
- select(-publication_name)+ ka = unname(constants["ka"]) - stats::runif(length(adsl$USUBJID), -0.2, 0.2), |
| 717 | -+ | |||
| 64 | +8x |
-
+ ke = unname(constants["ke"]) - stats::runif(length(adsl$USUBJID), -0.2, 0.2) |
||
| 718 | +65 |
- # ADaM global health status and scales from gdsr- |
- ||
| 719 | -3x | -
- gdsr_param_adqlqc <- gdsr_param_adqlqc %>%+ ), |
||
| 720 | -3x | +66 | +8x |
- filter(+ PCTPTNUM = if (day == 1) c(0, 0.5, 1, 1.5, 2, 3, 4, 8, 12) else 24 * (day - 1), |
| 721 | -3x | +67 | +8x |
- !str_detect(PARCAT2, "Original Items|Completion")+ PARAM = factor(c("Plasma Drug X", "Urine Drug X", "Plasma Drug Y", "Urine Drug Y"))
|
| 722 | +68 |
) |
||
| 723 | -- | - - | -||
| 724 | -3x | +69 | +8x |
- ghs_scales <- left_join(+ adpc_day <- adpc_day[!(grepl("Urine", adpc_day$PARAM) & adpc_day$PCTPTNUM %in% c(0.5, 1, 1.5, 2, 3)), ] %>%
|
| 725 | -3x | +70 | +8x |
- eortc_qlq_c30_sub,+ dplyr::arrange(USUBJID, PARAM) %>% |
| 726 | -3x | +71 | +8x |
- gdsr_param_adqlqc,+ dplyr::mutate( |
| 727 | -3x | +72 | +8x |
- by = "PARAMCD"+ VISITDY = day, |
| 728 | -+ | |||
| 73 | +8x |
- )+ VISIT = ifelse(day <= 7, paste("Day", VISITDY), paste("Week", (VISITDY - 1) / 7)),
|
||
| 729 | -+ | |||
| 74 | +8x |
- # scale data+ PCVOLU = ifelse(grepl("Urine", PARAM), "mL", ""),
|
||
| 730 | -3x | +75 | +8x |
- df <- data.frame(index = seq_len(nrow(ghs_scales)))+ ASMED = ifelse(grepl("Urine", PARAM), "URINE", "PLASMA"),
|
| 731 | -3x | +76 | +8x |
- df$previous <- list(+ PCTPT = factor(dplyr::case_when( |
| 732 | -3x | +77 | +8x |
- c("QS02826", "QS02827"),
+ PCTPTNUM == 0 ~ "Predose", |
| 733 | -3x | +78 | +8x |
- c("QS02811"),
+ (day == 1 & grepl("Urine", PARAM)) ~
|
| 734 | -3x | +79 | +8x |
- c("QS02810", "QS02812", "QS02818"),
+ paste0(lag(PCTPTNUM), "H - ", PCTPTNUM, "H"), |
| 735 | -3x | +80 | +8x |
- c("QS02806", "QS02807"),
+ (day != 1 & grepl("Urine", PARAM)) ~
|
| 736 | -3x | +81 | +8x |
- c("QS02814", "QS02815"),
+ paste0(as.numeric(PCTPTNUM) - 24, "H - ", PCTPTNUM, "H"), |
| 737 | -3x | +82 | +8x |
- c("QS02808"),
+ TRUE ~ paste0(PCTPTNUM, "H") |
| 738 | -3x | +|||
| 83 | +
- c("QS02817"),
+ )), |
|||
| 739 | -3x | +84 | +8x |
- c("QS02816"),
+ ARELTM1 = PCTPTNUM, |
| 740 | -3x | +85 | +8x |
- c("QS02821", "QS02822", "QS02823", "QS02824"),
+ NRELTM1 = PCTPTNUM, |
| 741 | -3x | +86 | +8x |
- c("QS02829", "QS02830"),
+ ARELTM2 = ARELTM1 - (24 * (day - 1)), |
| 742 | -3x | +87 | +8x |
- c("QS02813"),
+ NRELTM2 = NRELTM1 - (24 * (day - 1)), |
| 743 | -3x | +88 | +8x |
- c("QS02801", "QS02802", "QS02803", "QS02804", "QS02805"),
+ A0 = ifelse(PARAM == "Plasma Drug Y", A0, A0 / 2), |
| 744 | -3x | +89 | +8x |
- c("QS02809", "QS02819"),
+ AVAL = round( |
| 745 | -3x | +90 | +8x |
- c("QS02820", "QS02825"),
+ (A0 * ka * ( |
| 746 | -3x | +91 | +8x |
- c("QS02828")
+ exp(-ka * ARELTM1) - exp(-ke * ARELTM1) |
| 747 | +92 |
- )+ )) |
||
| 748 | -3x | +93 | +8x |
- df$newName <- list(+ / (ke - ka), |
| 749 | -3x | +94 | +8x |
- "QS028SF",+ digits = 3 |
| 750 | -3x | +|||
| 95 | +
- "QS028SL",+ ) |
|||
| 751 | -3x | +|||
| 96 | +
- "QS028FA",+ ) %>% |
|||
| 752 | -3x | +97 | +8x |
- "QS028RF2",+ dplyr::mutate( |
| 753 | -3x | +98 | +8x |
- "QS028NV",+ PCVOL = ifelse( |
| 754 | -3x | +99 | +8x |
- "QS028DY",+ ASMED == "URINE", |
| 755 | -3x | +100 | +8x |
- "QS028DI",+ round(abs(((PCTPTNUM - 1) %% 24) * A0 * ka * exp(PCTPTNUM %% 1.8 / 10)), 2), |
| 756 | -3x | +101 | +8x |
- "QS028CO",+ NA |
| 757 | -3x | +|||
| 102 | +
- "QS028EF",+ ), |
|||
| 758 | -3x | +|||
| 103 | +
- "QS028QL2",+ # PK Equation |
|||
| 759 | -3x | +104 | +8x |
- "QS028AP",+ AVALC = ifelse(AVAL == 0, "BLQ", as.character(AVAL)), |
| 760 | -3x | +105 | +8x |
- "QS028PF2",+ AVALU = avalu, |
| 761 | -3x | +106 | +8x |
- "QS028PA",+ RELTMU = "hr" |
| 762 | -3x | +|||
| 107 | +
- "QS028CF",+ ) %>% |
|||
| 763 | -3x | +108 | +8x |
- "QS028FI"+ dplyr::select(-c("A0", "ka", "ke"))
|
| 764 | +109 |
- )+ |
||
| 765 | -3x | +110 | +8x |
- df$newNamelabel <- list(+ return(adpc_day) |
| 766 | -3x | +|||
| 111 | +
- "EORTC QLQ-C30: Social functioning",+ } |
|||
| 767 | -3x | +|||
| 112 | +
- "EORTC QLQ-C30: Insomnia",+ |
|||
| 768 | -3x | +113 | +4x |
- "EORTC QLQ-C30: Fatigue",+ adpc <- list() |
| 769 | -3x | +|||
| 114 | +
- "EORTC QLQ-C30: Role functioning (revised)",+ |
|||
| 770 | -3x | +115 | +4x |
- "EORTC QLQ-C30: Nausea and vomiting",+ for (day in seq(duration)[seq(duration) <= 7 | ((seq(duration) - 1) %% 7 == 0)]) {
|
| 771 | -3x | +116 | +8x |
- "EORTC QLQ-C30: Dyspnoea",+ adpc[[day]] <- radpc_core(day = day) |
| 772 | -3x | +|||
| 117 | +
- "EORTC QLQ-C30: Diarrhoea",+ } |
|||
| 773 | -3x | +|||
| 118 | +
- "EORTC QLQ-C30: Constipation",+ |
|||
| 774 | -3x | +119 | +4x |
- "EORTC QLQ-C30: Emotional functioning",+ adpc <- do.call(rbind, adpc) |
| 775 | -3x | +|||
| 120 | +
- "EORTC QLQ-C30: Global health status/QoL (revised)",+ |
|||
| 776 | -3x | +121 | +4x |
- "EORTC QLQ-C30: Appetite loss",+ adpc <- dplyr::inner_join(adpc, adsl, by = c("STUDYID", "USUBJID", "ARMCD")) %>%
|
| 777 | -3x | +122 | +4x |
- "EORTC QLQ-C30: Physical functioning (revised)",+ dplyr::filter(ACTARM != "B: Placebo", !(ACTARM == "A: Drug X" & PARAM == "Plasma Drug Y")) |
| 778 | -3x | +|||
| 123 | +
- "EORTC QLQ-C30: Pain",+ |
|||
| 779 | -3x | +124 | +4x |
- "EORTC QLQ-C30: Cognitive functioning",+ if (length(na_vars) > 0 && na_percentage > 0) {
|
| 780 | -3x | +|||
| 125 | +! |
- "EORTC QLQ-C30: Financial difficulties"+ adpc <- mutate_na(ds = adpc, na_vars = na_vars, na_percentage = na_percentage) |
||
| 781 | +126 |
- )+ } |
||
| 782 | -3x | +|||
| 127 | +
- df$newNameCategory <- list(+ |
|||
| 783 | -3x | +128 | +4x |
- "Functional Scales",+ adpc <- adpc %>% |
| 784 | -3x | +129 | +4x |
- "Symptom Scales",+ rename( |
| 785 | -3x | +130 | +4x |
- "Symptom Scales",+ AVALCAT1 = AVALC, |
| 786 | -3x | +131 | +4x |
- "Functional Scales",+ NFRLT = NRELTM1, |
| 787 | -3x | +132 | +4x |
- "Symptom Scales",+ AFRLT = ARELTM1, |
| 788 | -3x | +133 | +4x |
- "Symptom Scales",+ NRRLT = NRELTM2, |
| 789 | -3x | +134 | +4x |
- "Symptom Scales",+ ARRLT = ARELTM2 |
| 790 | -3x | +|||
| 135 | +
- "Symptom Scales",+ ) %>% |
|||
| 791 | -3x | +136 | +4x |
- "Functional Scales",+ mutate(ANL02FL = "Y") |
| 792 | -3x | +|||
| 137 | +
- "Global Health Status",+ |
|||
| 793 | -3x | +138 | +4x |
- "Symptom Scales",+ adpc <- apply_metadata(adpc, "metadata/ADPC.yml") |
| 794 | -3x | +|||
| 139 | +
- "Functional Scales",+ } |
|||
| 795 | -3x | +
| 1 | +
- "Symptom Scales",+ #' Generate Anthropometric Measurements for Males and Females. |
|||
| 796 | -3x | +|||
| 2 | +
- "Functional Scales",+ #' |
|||
| 797 | -3x | +|||
| 3 | +
- "Symptom Scales"+ #' Anthropometric measurements are randomly generated using normal approximation. |
|||
| 798 | +4 |
- )+ #' The default mean and standard deviation values used are based on US National Health |
||
| 799 | -3x | +|||
| 5 | +
- df$num_param <- list(+ #' Statistics for adults aged 20 years or over. The measurements are generated in same units |
|||
| 800 | -3x | +|||
| 6 | +
- "1",+ #' as provided to the function. |
|||
| 801 | -3x | +|||
| 7 | +
- "1",+ #' |
|||
| 802 | -3x | +|||
| 8 | +
- "2",+ #' @details One record per subject. |
|||
| 803 | -3x | +|||
| 9 | +
- "1",+ #' |
|||
| 804 | -3x | +|||
| 10 | +
- "1",+ #' @inheritParams argument_convention |
|||
| 805 | -3x | +|||
| 11 | +
- "1",+ #' @param df (`data.frame`)\cr Analysis dataset. |
|||
| 806 | -3x | +|||
| 12 | +
- "1",+ #' @param id_var (`character`)\cr Patient identifier variable name. |
|||
| 807 | -3x | +|||
| 13 | +
- "1",+ #' @param sex_var (`character`)\cr Name of variable representing sex of patient. |
|||
| 808 | -3x | +|||
| 14 | +
- "2",+ #' @param sex_var_level_male (`character`)\cr Level of `sex_var` representing males. |
|||
| 809 | -3x | +|||
| 15 | +
- "1",+ #' @param male_weight_in_kg (named `list`)\cr List of means and SDs of male weights in kilograms. |
|||
| 810 | -3x | +|||
| 16 | +
- "1",+ #' @param female_weight_in_kg (named `list`)\cr List of means and SDs of female weights in kilograms. |
|||
| 811 | -3x | +|||
| 17 | +
- "3",+ #' @param male_height_in_m (named `list`)\cr List of means and SDs of male heights in metres. |
|||
| 812 | -3x | +|||
| 18 | +
- "1",+ #' @param female_height_in_m (named `list`)\cr list of means and SDs of female heights in metres. |
|||
| 813 | -3x | +|||
| 19 | +
- "1",+ #' |
|||
| 814 | -3x | +|||
| 20 | +
- "1"+ #' @return a dataframe with anthropometric measurements for each subject in analysis dataset. |
|||
| 815 | +21 |
- )+ #' @keywords internal |
||
| 816 | -3x | +|||
| 22 | +
- df$equation <- list(+ h_anthropometrics_by_sex <- function(df, |
|||
| 817 | -3x | +|||
| 23 | +
- "new_value = (1 - ((temp_val/var_length)-1)/3)*100.0",+ seed = 1, |
|||
| 818 | -3x | +|||
| 24 | +
- "new_value = ((temp_val/var_length-1)/3)*100.0",+ id_var = "USUBJID", |
|||
| 819 | -3x | +|||
| 25 | +
- "new_value = ((temp_val/var_length-1)/3)*100.0",+ sex_var = "SEX",+ |
+ |||
| 26 | ++ |
+ sex_var_level_male = "M",+ |
+ ||
| 27 | ++ |
+ male_weight_in_kg = list(mean = 90.6, sd = 44.9),+ |
+ ||
| 28 | ++ |
+ female_weight_in_kg = list(mean = 77.5, sd = 46.2),+ |
+ ||
| 29 | ++ |
+ male_height_in_m = list(mean = 1.75, sd = 0.14),+ |
+ ||
| 30 | ++ |
+ female_height_in_m = list(mean = 1.61, sd = 0.24)) {
|
||
| 820 | +31 | 3x |
- "new_value = (1 - ((temp_val/var_length)-1)/3)*100.0",+ checkmate::assert_data_frame(df) |
|
| 821 | +32 | 3x |
- "new_value = ((temp_val/var_length-1)/3)*100.0",+ checkmate::assert_string(id_var) |
|
| 822 | +33 | 3x |
- "new_value = ((temp_val/var_length-1)/3)*100.0",+ checkmate::assert_string(sex_var) |
|
| 823 | +34 | 3x |
- "new_value = ((temp_val/var_length-1)/3)*100.0",+ checkmate::assert_string(sex_var_level_male) |
|
| 824 | +35 | 3x |
- "new_value = ((temp_val/var_length-1)/3)*100.0",+ checkmate::assert_list(male_weight_in_kg, types = "numeric") |
|
| 825 | +36 | 3x |
- "new_value = (1 - ((temp_val/var_length)-1)/3)*100.0",+ checkmate::assert_subset(names(male_weight_in_kg), choices = c("mean", "sd"))
|
|
| 826 | +37 | 3x |
- "new_value = ((temp_val/var_length-1)/6)*100.0",+ checkmate::assert_list(female_weight_in_kg, types = "numeric") |
|
| 827 | +38 | 3x |
- "new_value = ((temp_val/var_length-1)/3)*100.0",+ checkmate::assert_subset(names(female_weight_in_kg), choices = c("mean", "sd"))
|
|
| 828 | +39 | 3x |
- "new_value = (1 - ((temp_val/var_length)-1)/3)*100.0",+ checkmate::assert_list(male_height_in_m, types = "numeric") |
|
| 829 | +40 | 3x |
- "new_value = ((temp_val/var_length-1)/3)*100.0",+ checkmate::assert_subset(names(male_height_in_m), choices = c("mean", "sd"))
|
|
| 830 | +41 | 3x |
- "new_value = (1 - ((temp_val/var_length)-1)/3)*100.0",+ checkmate::assert_list(female_height_in_m, types = "numeric") |
|
| 831 | +42 | 3x |
- "new_value = ((temp_val/var_length-1)/3)*100.0"+ checkmate::assert_subset(names(female_height_in_m), choices = c("mean", "sd"))
|
|
| 832 | +43 |
- )+ |
||
| 833 | +44 | |||
| 834 | +45 | 3x |
- expect_data <- data.frame(+ n <- length(unique(df[[id_var]])) |
|
| 835 | +46 | 3x |
- PARAM = expect$PARAM,+ set.seed(seed) |
|
| 836 | -3x | +|||
| 47 | +
- PARAMCD = expect$PARAMCD,+ |
|||
| 837 | +48 | 3x |
- PARCAT2 = expect$PARCAT2,+ df_by_sex <- unique(subset(df, select = c(id_var, sex_var)))+ |
+ |
| 49 | ++ | + | ||
| 838 | +50 | 3x |
- PARCAT1N = expect$PARCAT1N,+ df_with_measurements <- df_by_sex %>% |
|
| 839 | +51 | 3x |
- AVAL = c(0, 1),+ dplyr::mutate( |
|
| 840 | +52 | 3x |
- AVALC = c(+ WEIGHT = ifelse( |
|
| 841 | +53 | 3x |
- "Not expected to complete questionnaire",+ .data[[sex_var]] == sex_var_level_male, |
|
| 842 | +54 | 3x |
- "Expected to complete questionnaire"+ stats::rnorm(n = n, mean = male_weight_in_kg$mean, sd = male_weight_in_kg$sd), |
|
| 843 | -+ | |||
| 55 | +3x |
- )+ stats::rnorm(n = n, mean = female_weight_in_kg$mean, sd = female_weight_in_kg$sd) |
||
| 844 | +56 |
- )+ ) |
||
| 845 | +57 |
-
+ ) %>% |
||
| 846 | +58 | 3x |
- df_saved <- data.frame()+ dplyr::mutate( |
|
| 847 | -+ | |||
| 59 | +3x |
-
+ HEIGHT = ifelse( |
||
| 848 | +60 | 3x |
- unique_id <- unique(adqlqc1$USUBJID)+ .data[[sex_var]] == sex_var_level_male, |
|
| 849 | -+ | |||
| 61 | +3x |
-
+ stats::rnorm(n = n, mean = male_height_in_m$mean, sd = male_height_in_m$sd), |
||
| 850 | +62 | 3x |
- for (id in unique_id) {
+ stats::rnorm(n = n, mean = female_height_in_m$mean, sd = female_height_in_m$sd) |
|
| 851 | -30x | +|||
| 63 | +
- id_data <- adqlqc1[adqlqc1$USUBJID == id, ]+ ) |
|||
| 852 | -30x | +|||
| 64 | +
- unique_avisit <- unique(id_data$AVISIT)+ ) %>% |
|||
| 853 | -30x | +65 | +3x |
- for (visit in unique_avisit) {
+ dplyr::mutate( |
| 854 | -180x | +66 | +3x |
- if (is.na(visit)) {
+ BMI = WEIGHT / ((HEIGHT)^2) |
| 855 | -! | +|||
| 67 | +
- next+ ) |
|||
| 856 | +68 |
- }+ |
||
| 857 | -180x | +69 | +3x |
- id_data_at_visit <- id_data[id_data$AVISIT == visit, ]+ return(df_with_measurements) |
| 858 | +70 |
-
+ } |
||
| 859 | -180x | +|||
| 71 | +
- if (any(id_data_at_visit$PARAMCD != "QSALL")) {
+
|
|||
| 860 | -177x | +|||
| 72 | +
- for (idx in seq_along(df$index)) {
+ #' Subcategory Analysis Dataset (ADSUB) |
|||
| 861 | -2655x | +|||
| 73 | +
- previous_names <- df$previous[idx]+ #' |
|||
| 862 | -2655x | +|||
| 74 | +
- current_name <- df$newName[idx]+ #' @description `r lifecycle::badge("stable")`
|
|||
| 863 | -2655x | +|||
| 75 | +
- current_name_label <- df$newNamelabel[idx]+ #' |
|||
| 864 | -2655x | +|||
| 76 | +
- current_name_category <- df$newNameCategory[idx]+ #' Function for generating a random Subcategory Analysis Dataset for a given |
|||
| 865 | -2655x | +|||
| 77 | +
- eqn <- df$equation[idx]+ #' Subject-Level Analysis Dataset. |
|||
| 866 | -2655x | +|||
| 78 | +
- temp_val <- 0+ #' |
|||
| 867 | -2655x | +|||
| 79 | +
- var_length <- 0+ #' @details One record per subject. |
|||
| 868 | -2655x | +|||
| 80 | +
- for (param_name in previous_names[[1]]) {
+ #' |
|||
| 869 | -5310x | +|||
| 81 | +
- if (param_name %in% id_data_at_visit$PARAMCD) { ####
+ #' Keys: `STUDYID`, `USUBJID`, `PARAMCD`, `AVISITN`, `ADTM`, `SRCSEQ` |
|||
| 870 | -5310x | +|||
| 82 | +
- current_val <- as.numeric(as.character(id_data_at_visit$AVAL[id_data_at_visit$PARAMCD == param_name]))+ #' |
|||
| 871 | -5310x | +|||
| 83 | +
- if (!is.na(current_val)) {
+ #' @inheritParams argument_convention |
|||
| 872 | -5094x | +|||
| 84 | +
- temp_val <- temp_val + current_val ###+ #' @template param_cached |
|||
| 873 | -5094x | +|||
| 85 | +
- var_length <- var_length + 1+ #' @templateVar data adsub |
|||
| 874 | +86 |
- }+ #' |
||
| 875 | +87 |
- } # if+ #' @return `data.frame` |
||
| 876 | +88 |
- } # param_name+ #' @export |
||
| 877 | +89 |
- # eval+ #' |
||
| 878 | -2655x | +|||
| 90 | +
- if (var_length >= as.numeric(df$num_param[idx])) {
+ #' @author tomlinsj, npaszty, Xuefeng Hou, dipietrc |
|||
| 879 | -2604x | +|||
| 91 | +
- eval(parse(text = eqn)) #####+ #' |
|||
| 880 | +92 |
- } else {
+ #' @examples |
||
| 881 | -51x | +|||
| 93 | +
- new_value <- NA+ #' adsl <- radsl(N = 10, seed = 1, study_duration = 2) |
|||
| 882 | +94 |
- }+ #' |
||
| 883 | +95 |
-
+ #' adsub <- radsub(adsl, seed = 2) |
||
| 884 | -2655x | +|||
| 96 | +
- new_data_row <- data.frame(+ #' adsub |
|||
| 885 | -2655x | +|||
| 97 | +
- study = str_extract(id, "[A-Z]+[0-9]+"),+ radsub <- function(adsl, |
|||
| 886 | -2655x | +|||
| 98 | +
- id,+ param = c( |
|||
| 887 | -2655x | +|||
| 99 | +
- visit,+ "Baseline Weight", |
|||
| 888 | -2655x | +|||
| 100 | +
- id_data_at_visit$AVISITN[1],+ "Baseline Height", |
|||
| 889 | -2655x | +|||
| 101 | +
- id_data_at_visit$QSDTC[1],+ "Baseline BMI", |
|||
| 890 | -2655x | +|||
| 102 | +
- current_name_category,+ "Baseline ECOG", |
|||
| 891 | -2655x | +|||
| 103 | +
- current_name_label,+ "Baseline Biomarker Mutation" |
|||
| 892 | -2655x | +|||
| 104 | +
- current_name,+ ), |
|||
| 893 | -2655x | +|||
| 105 | +
- new_value,+ paramcd = c("BWGHTSI", "BHGHTSI", "BBMISI", "BECOG", "BBMRKR1"),
|
|||
| 894 | -2655x | +|||
| 106 | +
- NA,+ seed = NULL, |
|||
| 895 | -2655x | +|||
| 107 | +
- stringsAsFactors = FALSE+ na_percentage = 0, |
|||
| 896 | +108 |
- )+ na_vars = list(), |
||
| 897 | -2655x | +|||
| 109 | +
- colnames(new_data_row) <- c(+ cached = FALSE) {
|
|||
| 898 | -2655x | -
- "STUDYID", "USUBJID", "AVISIT", "AVISITN",- |
- ||
| 899 | -2655x | +110 | +4x |
- "ADTM", "PARCAT2", "PARAM", "PARAMCD",+ checkmate::assert_flag(cached) |
| 900 | -2655x | -
- "AVAL", "AVALC"- |
- ||
| 901 | -+ | 111 | +4x |
- ) ###+ if (cached) {
|
| 902 | -2655x | -
- df_saved <- rbind(df_saved, new_data_row) #####- |
- ||
| 903 | -+ | 112 | +1x |
- } # idx+ return(get_cached_data("cadsub"))
|
| 904 | +113 |
- }+ } |
||
| 905 | +114 |
- # add expect data- |
- ||
| 906 | -180x | -
- expect_value <- sample(expect_data$AVAL, 1, prob = c(0.10, 0.90))+ |
||
| 907 | -180x | -
- expect_valuec <- expect_data$AVALC[expect_data$AVAL == expect_value]- |
- ||
| 908 | -+ | 115 | +3x |
-
+ checkmate::assert_data_frame(adsl) |
| 909 | -180x | +116 | +3x |
- new_data_row <- data.frame(+ checkmate::assert_character(param, min.len = 1, any.missing = FALSE) |
| 910 | -180x | +117 | +3x |
- study = str_extract(id, "[A-Z]+[0-9]+"),+ checkmate::assert_character(paramcd, min.len = 1, any.missing = FALSE) |
| 911 | -180x | +118 | +3x |
- id,+ checkmate::assert_number(seed, null.ok = TRUE) |
| 912 | -180x | +119 | +3x |
- visit,+ checkmate::assert_number(na_percentage, lower = 0, upper = 1) |
| 913 | -180x | +120 | +3x |
- id_data_at_visit$AVISITN[1],+ checkmate::assert_true(na_percentage < 1) |
| 914 | -180x | +|||
| 121 | +
- datetime = NA,+ |
|||
| 915 | -180x | +|||
| 122 | +
- expect_data$PARCAT2[1],+ # Validate and initialize related variables. |
|||
| 916 | -180x | +123 | +3x |
- expect_data$PARAM[1],+ param_init_list <- relvar_init(param, paramcd) |
| 917 | -180x | +|||
| 124 | +
- expect_data$PARAMCD[1],+ |
|||
| 918 | -180x | +125 | +3x |
- expect_value,+ if (!is.null(seed)) {
|
| 919 | -180x | +126 | +3x |
- expect_valuec,+ set.seed(seed) |
| 920 | -180x | +|||
| 127 | +
- stringsAsFactors = FALSE+ } |
|||
| 921 | +128 |
- )+ |
||
| 922 | -180x | +129 | +3x |
- colnames(new_data_row) <- c(+ adsub <- expand.grid( |
| 923 | -180x | +130 | +3x |
- "STUDYID", "USUBJID", "AVISIT", "AVISITN",+ STUDYID = unique(adsl$STUDYID), |
| 924 | -180x | +131 | +3x |
- "ADTM", "PARCAT2", "PARAM", "PARAMCD", "AVAL",+ USUBJID = adsl$USUBJID, |
| 925 | -180x | +132 | +3x |
- "AVALC"+ PARAM = as.factor(param_init_list$relvar1), |
| 926 | -+ | |||
| 133 | +3x |
- ) ###+ AVISIT = "BASELINE", |
||
| 927 | -180x | +134 | +3x |
- df_saved <- rbind(df_saved, new_data_row)+ stringsAsFactors = FALSE |
| 928 | +135 |
- } # visit+ ) |
||
| 929 | +136 |
- } # id+ |
||
| 930 | +137 |
-
+ # Assign related variable values: PARAM and PARAMCD are related. |
||
| 931 | +138 | 3x |
- df_saved1 <- left_join(+ adsub <- adsub %>% rel_var( |
|
| 932 | +139 | 3x |
- df_saved,+ var_name = "PARAMCD", |
|
| 933 | +140 | 3x |
- ghs_scales,+ related_var = "PARAM", |
|
| 934 | +141 | 3x |
- by = c(+ var_values = param_init_list$relvar2 |
|
| 935 | -3x | +|||
| 142 | +
- "PARAM",+ ) |
|||
| 936 | -3x | +|||
| 143 | +
- "PARAMCD",+ |
|||
| 937 | +144 | 3x |
- "PARCAT2"- |
- |
| 938 | -- |
- )+ adsub <- adsub[order(adsub$STUDYID, adsub$USUBJID, adsub$PARAMCD), ] |
||
| 939 | +145 |
- ) %>%+ |
||
| 940 | +146 | 3x |
- mutate(+ adsub <- var_relabel( |
|
| 941 | +147 | 3x |
- AVALC = ifelse(is.na(AVALC), as.character(AVAL), AVALC),+ adsub, |
|
| 942 | +148 | 3x |
- PARCAT1 = ifelse(PARAMCD == "EX028", expect$PARCAT1, PARCAT1),+ STUDYID = "Study Identifier", |
|
| 943 | +149 | 3x |
- PARCAT1N = ifelse(PARAMCD == "EX028", expect$PARCAT1N, PARCAT1N)+ USUBJID = "Unique Subject Identifier" |
|
| 944 | +150 |
- )+ ) |
||
| 945 | +151 | |||
| 946 | -3x | +|||
| 152 | +
- adqlqc_tmp <- bind_rows(adqlqc1, df_saved1) %>%+ # Merge ADSL to be able to add EG date and study day variables.+ |
+ |||
| 153 | ++ |
+ # Sample ADTM to be a few days before TRTSDTM. |
||
| 947 | +154 | 3x |
- arrange(+ adsub <- dplyr::inner_join( |
|
| 948 | +155 | 3x |
- USUBJID,+ adsub, |
|
| 949 | +156 | 3x |
- AVISITN,+ adsl, |
|
| 950 | +157 | 3x |
- QSTESTCD+ by = c("STUDYID", "USUBJID")
|
|
| 951 | +158 |
- )+ ) %>% |
||
| 952 | +159 | 3x |
- return(adqlqc_tmp)+ dplyr::group_by(USUBJID) %>% |
|
| 953 | -+ | |||
| 160 | +3x |
- }+ dplyr::mutate(ADTM = rep( |
||
| 954 | -+ | |||
| 161 | +3x |
-
+ lubridate::date(TRTSDTM)[1] - lubridate::days(sample(1:10, size = 1)), |
||
| 955 | -+ | |||
| 162 | +3x |
- #' @describeIn h_adqlqc Calculate Change from Baseline Category 1+ each = n() |
||
| 956 | +163 |
- #'+ )) %>% |
||
| 957 | -+ | |||
| 164 | +3x |
- #' @param dataset (`data.frame`)\cr ADaM dataset.+ dplyr::ungroup() %>% |
||
| 958 | -+ | |||
| 165 | +3x |
- #'+ dplyr::arrange(STUDYID, USUBJID, ADTM) |
||
| 959 | +166 |
- #' @return `data.frame`+ |
||
| 960 | +167 |
- #' @keywords internal+ # Generate a dataset with height, weight and BMI measurements for each subject. |
||
| 961 | -+ | |||
| 168 | +3x |
- #'+ if (!is.null(seed)) {
|
||
| 962 | -+ | |||
| 169 | +3x |
- #' @examples+ df_with_measurements <- h_anthropometrics_by_sex(adsub, seed = seed) |
||
| 963 | +170 |
- #' \dontrun{
+ } else {
|
||
| 964 | -+ | |||
| 171 | +! |
- #' adqlqc <- random.cdisc.data:::derv_chgcat1(dataset = adqlqc |> dplyr::select(-CHGCAT1))+ df_with_measurements <- h_anthropometrics_by_sex(adsub) |
||
| 965 | +172 |
- #' adqlqc+ } |
||
| 966 | +173 |
- #' }+ |
||
| 967 | +174 |
- derv_chgcat1 <- function(dataset) {
+ # Add this to adsub and create other measurements. |
||
| 968 | -+ | |||
| 175 | +3x |
- # derivation of CHGCAT1+ adsub <- adsub %>% |
||
| 969 | +176 | 3x |
- check_vars <- c("PARCAT2", "CHG")
+ dplyr::group_by(USUBJID) %>% |
|
| 970 | -+ | |||
| 177 | +3x |
-
+ dplyr::mutate( |
||
| 971 | +178 | 3x |
- if (all(check_vars %in% names(dataset))) {
+ AVAL = dplyr::case_when( |
|
| 972 | +179 | 3x |
- dataset$CHGCAT1 <- ifelse(+ PARAMCD == |
|
| 973 | +180 | 3x |
- dataset$PARCAT2 == "Symptom Scales" & !is.na(dataset$CHG) & dataset$CHG <= -10,+ "BWGHTSI" ~ df_with_measurements$WEIGHT[df_with_measurements$USUBJID == USUBJID], |
|
| 974 | +181 | 3x |
- "Improved", ""+ PARAMCD == |
|
| 975 | -+ | |||
| 182 | +3x |
- )+ "BHGHTSI" ~ df_with_measurements$HEIGHT[df_with_measurements$USUBJID == USUBJID], |
||
| 976 | +183 | 3x |
- dataset$CHGCAT1 <- ifelse(+ PARAMCD == |
|
| 977 | +184 | 3x |
- dataset$PARCAT2 == "Symptom Scales" & !is.na(dataset$CHG) & dataset$CHG >= 10,+ "BBMISI" ~ df_with_measurements$BMI[df_with_measurements$USUBJID == USUBJID], |
|
| 978 | +185 | 3x |
- "Worsened", dataset$CHGCAT1+ PARAMCD == "BECOG" ~ sample(c(0, 1, 2, 3, 4, 5), 1),+ |
+ |
| 186 | +3x | +
+ PARAMCD == "BBMRKR1" ~ sample(c(1, 2), prob = c(0.5, 0.5), 1) |
||
| 979 | +187 |
- )+ )+ |
+ ||
| 188 | ++ |
+ ) %>% |
||
| 980 | +189 | 3x |
- dataset$CHGCAT1 <- ifelse(+ dplyr::arrange(PARAMCD) %>% |
|
| 981 | +190 | 3x |
- dataset$PARCAT2 == "Symptom Scales" &+ dplyr::ungroup() %>% |
|
| 982 | +191 | 3x |
- !is.na(dataset$CHG) & dataset$CHG > -10 &+ dplyr::mutate(AVAL = dplyr::case_when( |
|
| 983 | +192 | 3x |
- dataset$CHG < 10,+ PARAMCD != "BBMRKR1" | PARAMCD != "BECOG" ~ round(AVAL, 1), |
|
| 984 | +193 | 3x |
- "No change", dataset$CHGCAT1+ TRUE ~ round(AVAL) |
|
| 985 | +194 |
- )+ )) |
||
| 986 | +195 | |||
| 987 | +196 | 3x |
- dataset$CHGCAT1 <- ifelse(+ adsub <- adsub %>% |
|
| 988 | +197 | 3x |
- dataset$PARCAT2 %in% c("Functional Scales", "Global Health Status") &
+ dplyr::mutate( |
|
| 989 | +198 | 3x |
- !is.na(dataset$CHG) & dataset$CHG >= 10,+ AVALC = dplyr::case_when( |
|
| 990 | +199 | 3x |
- "Improved", dataset$CHGCAT1+ PARAMCD == "BBMRKR1" ~ dplyr::case_when( |
|
| 991 | -+ | |||
| 200 | +3x |
- )+ AVAL == "1" ~ "WILD TYPE", |
||
| 992 | +201 | 3x |
- dataset$CHGCAT1 <- ifelse(+ AVAL == "2" ~ "MUTANT", |
|
| 993 | +202 | 3x |
- dataset$PARCAT2 %in% c("Functional Scales", "Global Health Status") &
+ TRUE ~ "" |
|
| 994 | -3x | +|||
| 203 | +
- !is.na(dataset$CHG) & dataset$CHG <= -10,+ ), |
|||
| 995 | +204 | 3x |
- "Worsened", dataset$CHGCAT1+ TRUE ~ as.character(AVAL) |
|
| 996 | +205 |
- )+ ), |
||
| 997 | +206 | 3x |
- dataset$CHGCAT1 <- ifelse(+ AVALU = dplyr::case_when( |
|
| 998 | +207 | 3x |
- dataset$PARCAT2 %in% c("Functional Scales", "Global Health Status") &
+ PARAMCD == "BWGHTSI" ~ "kg", |
|
| 999 | +208 | 3x |
- !is.na(dataset$CHG) &+ PARAMCD == "BHGHTSI" ~ "m", |
|
| 1000 | +209 | 3x |
- dataset$CHG > -10 & dataset$CHG < 10,+ PARAMCD == "BBMISI" ~ "kg/m2", |
|
| 1001 | +210 | 3x |
- "No change", dataset$CHGCAT1- |
- |
| 1002 | -- |
- )+ TRUE ~ "" |
||
| 1003 | +211 |
-
+ ), |
||
| 1004 | +212 | 3x |
- dataset$CHGCAT1 <- ifelse(+ AVALCAT1 = dplyr::case_when( |
|
| 1005 | +213 | 3x |
- dataset$PARAMCD %in% c("QS02829", "QS02830") & dataset$CHG == 6,
+ PARAMCD == "BBMISI" ~ dplyr::case_when( |
|
| 1006 | +214 | 3x |
- "Improved by six levels", dataset$CHGCAT1- |
- |
| 1007 | -- |
- )+ AVAL < 18.5 ~ "<18.5", |
||
| 1008 | +215 | 3x |
- dataset$CHGCAT1 <- ifelse(+ AVAL >= 18.5 & AVAL < 25 ~ "18.5 - 24.9", |
|
| 1009 | +216 | 3x |
- dataset$PARAMCD %in% c("QS02829", "QS02830") & dataset$CHG == 5,
+ AVAL >= 25 & AVAL < 30 ~ "25 - 29.9", |
|
| 1010 | +217 | 3x |
- "Improved by five levels", dataset$CHGCAT1+ TRUE ~ ">30" |
|
| 1011 | +218 |
- )+ ), |
||
| 1012 | +219 | 3x |
- dataset$CHGCAT1 <- ifelse(+ PARAMCD == "BECOG" ~ dplyr::case_when( |
|
| 1013 | +220 | 3x |
- dataset$PARAMCD %in% c("QS02829", "QS02830") & dataset$CHG == 4,
+ AVAL <= 1 ~ "0-1", |
|
| 1014 | +221 | 3x |
- "Improved by four levels", dataset$CHGCAT1- |
- |
| 1015 | -- |
- )+ AVAL > 1 & AVAL <= 3 ~ "2-3", |
||
| 1016 | +222 | 3x |
- dataset$CHGCAT1 <- ifelse(+ TRUE ~ "4-5" |
|
| 1017 | -3x | +|||
| 223 | +
- dataset$PARAMCD %in% c("QS02829", "QS02830") & dataset$CHG == 3,
+ ), |
|||
| 1018 | +224 | 3x |
- "Improved by three levels", dataset$CHGCAT1+ TRUE ~ "" |
|
| 1019 | +225 |
- )- |
- ||
| 1020 | -3x | -
- dataset$CHGCAT1 <- ifelse(+ ), |
||
| 1021 | +226 | 3x |
- dataset$PARAMCD %in% c("QS02829", "QS02830") & dataset$CHG == 2,
+ AVISITN = "0", |
|
| 1022 | +227 | 3x |
- "Improved by two levels", dataset$CHGCAT1+ SRCSEQ = "1" |
|
| 1023 | +228 |
- )+ ) %>% |
||
| 1024 | +229 | 3x |
- dataset$CHGCAT1 <- ifelse(+ dplyr::arrange( |
|
| 1025 | +230 | 3x |
- dataset$PARAMCD %in% c("QS02829", "QS02830") & dataset$CHG == 1,
+ USUBJID, |
|
| 1026 | +231 | 3x |
- "Improved by one level", dataset$CHGCAT1+ factor(PARAMCD, levels = c("BWGHTSI", "BHGHTSI", "BBMISI", "BECOG", "BBMRKR1"))
|
|
| 1027 | +232 |
) |
||
| 1028 | -3x | +|||
| 233 | +
- dataset$CHGCAT1 <- ifelse(+ |
|||
| 1029 | +234 | 3x |
- dataset$PARAMCD %in% c("QS02829", "QS02830") & dataset$CHG == 0,
+ if (length(na_vars) > 0 && na_percentage > 0) {
|
|
| 1030 | -3x | +|||
| 235 | +! |
- "No change", dataset$CHGCAT1+ adsub <- mutate_na(ds = adsub, na_vars = na_vars, na_percentage = na_percentage) |
||
| 1031 | +236 |
- )+ } |
||
| 1032 | -3x | +|||
| 237 | +
- dataset$CHGCAT1 <- ifelse(+ |
|||
| 1033 | -3x | +|||
| 238 | +
- dataset$PARAMCD %in% c("QS02829", "QS02830") & dataset$CHG == -1,
+ # Apply metadata. |
|||
| 1034 | +239 | 3x |
- "Worsened by one level", dataset$CHGCAT1+ adsub <- apply_metadata(adsub, "metadata/ADSUB.yml") |
|
| 1035 | +240 |
- )+ |
||
| 1036 | +241 | 3x |
- dataset$CHGCAT1 <- ifelse(+ return(adsub) |
|
| 1037 | -3x | +|||
| 242 | +
- dataset$PARAMCD %in% c("QS02829", "QS02830") & dataset$CHG == -2,
+ } |
|||
| 1038 | -3x | +
| 1 | +
- "Worsened by two levels", dataset$CHGCAT1+ #' Vital Signs Analysis Dataset (ADVS) |
|||
| 1039 | +2 |
- )+ #' |
||
| 1040 | -3x | +|||
| 3 | +
- dataset$CHGCAT1 <- ifelse(+ #' @description `r lifecycle::badge("stable")`
|
|||
| 1041 | -3x | +|||
| 4 | +
- dataset$PARAMCD %in% c("QS02829", "QS02830") & dataset$CHG == -3,
+ #' |
|||
| 1042 | -3x | +|||
| 5 | +
- "Worsened by three levels", dataset$CHGCAT1+ #' Function for generating a random Vital Signs Analysis Dataset for a given |
|||
| 1043 | +6 |
- )+ #' Subject-Level Analysis Dataset. |
||
| 1044 | -3x | +|||
| 7 | +
- dataset$CHGCAT1 <- ifelse(+ #' |
|||
| 1045 | -3x | +|||
| 8 | +
- dataset$PARAMCD %in% c("QS02829", "QS02830") & dataset$CHG == -4,
+ #' @details One record per subject per parameter per analysis visit per analysis date. |
|||
| 1046 | -3x | +|||
| 9 | +
- "Worsened by four levels", dataset$CHGCAT1+ #' |
|||
| 1047 | +10 |
- )+ #' Keys: `STUDYID`, `USUBJID`, `PARAMCD`, `BASETYPE`, `AVISITN`, `ATPTN`, `DTYPE`, `ADTM`, `VSSEQ`, `ASPID` |
||
| 1048 | -3x | +|||
| 11 | +
- dataset$CHGCAT1 <- ifelse(+ #' |
|||
| 1049 | -3x | +|||
| 12 | +
- dataset$PARAMCD %in% c("QS02829", "QS02830") & dataset$CHG == -5,
+ #' @inheritParams argument_convention |
|||
| 1050 | -3x | +|||
| 13 | +
- "Worsened by five levels", dataset$CHGCAT1+ #' @template param_cached |
|||
| 1051 | +14 |
- )+ #' @templateVar data advs |
||
| 1052 | -3x | +|||
| 15 | +
- dataset$CHGCAT1 <- ifelse(+ #' |
|||
| 1053 | -3x | +|||
| 16 | +
- dataset$PARAMCD %in% c("QS02829", "QS02830") & dataset$CHG == -6,
+ #' @return `data.frame` |
|||
| 1054 | -3x | +|||
| 17 | +
- "Worsened by six levels", dataset$CHGCAT1+ #' @export |
|||
| 1055 | +18 |
- )+ #' |
||
| 1056 | +19 |
-
+ #' @author npaszty |
||
| 1057 | -3x | +|||
| 20 | +
- dataset$CHGCAT1 <- ifelse(+ #' |
|||
| 1058 | -3x | +|||
| 21 | +
- dataset$PARAMCD %in% c("QS02802", "QS02806") & dataset$CHG == -3,
+ #' @examples |
|||
| 1059 | -3x | +|||
| 22 | +
- "Improved by three levels", dataset$CHGCAT1+ #' adsl <- radsl(N = 10, seed = 1, study_duration = 2) |
|||
| 1060 | +23 |
- )+ #' |
||
| 1061 | -3x | +|||
| 24 | +
- dataset$CHGCAT1 <- ifelse(+ #' advs <- radvs(adsl, visit_format = "WEEK", n_assessments = 7L, seed = 2) |
|||
| 1062 | -3x | +|||
| 25 | +
- dataset$PARAMCD %in% c("QS02802", "QS02806") & dataset$CHG == -2,
+ #' advs |
|||
| 1063 | -3x | +|||
| 26 | +
- "Improved by two levels", dataset$CHGCAT1+ #' |
|||
| 1064 | +27 |
- )+ #' advs <- radvs(adsl, visit_format = "CYCLE", n_assessments = 3L, seed = 2) |
||
| 1065 | -3x | +|||
| 28 | +
- dataset$CHGCAT1 <- ifelse(+ #' advs |
|||
| 1066 | -3x | +|||
| 29 | +
- dataset$PARAMCD %in% c("QS02802", "QS02806") & dataset$CHG == -1,
+ radvs <- function(adsl, |
|||
| 1067 | -3x | +|||
| 30 | +
- "Improved by one level", dataset$CHGCAT1+ param = c( |
|||
| 1068 | +31 |
- )+ "Diastolic Blood Pressure", |
||
| 1069 | -3x | +|||
| 32 | +
- dataset$CHGCAT1 <- ifelse(+ "Pulse Rate", |
|||
| 1070 | -3x | +|||
| 33 | +
- dataset$PARAMCD %in% c("QS02802", "QS02806") & dataset$CHG == 0,
+ "Respiratory Rate", |
|||
| 1071 | -3x | +|||
| 34 | +
- "No change", dataset$CHGCAT1+ "Systolic Blood Pressure", |
|||
| 1072 | +35 |
- )+ "Temperature", "Weight" |
||
| 1073 | -3x | +|||
| 36 | +
- dataset$CHGCAT1 <- ifelse(+ ), |
|||
| 1074 | -3x | +|||
| 37 | +
- dataset$PARAMCD %in% c("QS02802", "QS02806") & dataset$CHG == 1,
+ paramcd = c("DIABP", "PULSE", "RESP", "SYSBP", "TEMP", "WEIGHT"),
|
|||
| 1075 | -3x | +|||
| 38 | +
- "Worsened by one level", dataset$CHGCAT1+ paramu = c("Pa", "beats/min", "breaths/min", "Pa", "C", "Kg"),
|
|||
| 1076 | +39 |
- )+ visit_format = "WEEK", |
||
| 1077 | -3x | +|||
| 40 | +
- dataset$CHGCAT1 <- ifelse(+ n_assessments = 5L, |
|||
| 1078 | -3x | +|||
| 41 | +
- dataset$PARAMCD %in% c("QS02802", "QS02806") & dataset$CHG == 2,
+ n_days = 5L, |
|||
| 1079 | -3x | +|||
| 42 | +
- "Worsened by two levels", dataset$CHGCAT1+ seed = NULL, |
|||
| 1080 | +43 |
- )+ na_percentage = 0,+ |
+ ||
| 44 | ++ |
+ na_vars = list(+ |
+ ||
| 45 | ++ |
+ CHG2 = c(1235, 0.1), PCHG2 = c(1235, 0.1), CHG = c(1234, 0.1), PCHG = c(1234, 0.1),+ |
+ ||
| 46 | ++ |
+ AVAL = c(123, 0.1), AVALU = c(123, 0.1)+ |
+ ||
| 47 | ++ |
+ ),+ |
+ ||
| 48 | ++ |
+ cached = FALSE) {
|
||
| 1081 | -3x | +49 | +4x |
- dataset$CHGCAT1 <- ifelse(+ checkmate::assert_flag(cached) |
| 1082 | -3x | +50 | +4x |
- dataset$PARAMCD %in% c("QS02802", "QS02806") & dataset$CHG == 3,
+ if (cached) {
|
| 1083 | -3x | +51 | +1x |
- "Worsened by three levels", dataset$CHGCAT1+ return(get_cached_data("cadvs"))
|
| 1084 | +52 |
- )+ } |
||
| 1085 | +53 | |||
| 1086 | +54 | 3x |
- dataset$CHGCAT1 <- ifelse(+ checkmate::assert_data_frame(adsl) |
|
| 1087 | +55 | 3x |
- dataset$PARAMCD == "QS02801" & dataset$CHG == -3,+ checkmate::assert_character(param, min.len = 1, any.missing = FALSE) |
|
| 1088 | +56 | 3x |
- "Improved by three levels", dataset$CHGCAT1- |
- |
| 1089 | -- |
- )+ checkmate::assert_character(paramcd, min.len = 1, any.missing = FALSE) |
||
| 1090 | +57 | 3x |
- dataset$CHGCAT1 <- ifelse(+ checkmate::assert_character(paramu, min.len = 1, any.missing = FALSE) |
|
| 1091 | +58 | 3x |
- dataset$PARAMCD == "QS02801" & dataset$CHG == -2,+ checkmate::assert_string(visit_format) |
|
| 1092 | +59 | 3x |
- "Improved by two levels", dataset$CHGCAT1+ checkmate::assert_integer(n_assessments, len = 1, any.missing = FALSE) |
|
| 1093 | -+ | |||
| 60 | +3x |
- )+ checkmate::assert_integer(n_days, len = 1, any.missing = FALSE) |
||
| 1094 | +61 | 3x |
- dataset$CHGCAT1 <- ifelse(+ checkmate::assert_number(seed, null.ok = TRUE) |
|
| 1095 | +62 | 3x |
- dataset$PARAMCD == "QS02801" & dataset$CHG == -1,+ checkmate::assert_number(na_percentage, lower = 0, upper = 1) |
|
| 1096 | +63 | 3x |
- "Improved by one level", dataset$CHGCAT1+ checkmate::assert_true(na_percentage < 1) |
|
| 1097 | +64 |
- )+ |
||
| 1098 | -3x | +|||
| 65 | +
- dataset$CHGCAT1 <- ifelse(+ # validate and initialize param vectors |
|||
| 1099 | +66 | 3x |
- dataset$PARAMCD == "QS02801" & dataset$CHG == 0,+ param_init_list <- relvar_init(param, paramcd) |
|
| 1100 | +67 | 3x |
- "No changed", dataset$CHGCAT1+ unit_init_list <- relvar_init(param, paramu) |
|
| 1101 | +68 |
- )+ |
||
| 1102 | +69 | 3x |
- dataset$CHGCAT1 <- ifelse(+ if (!is.null(seed)) {
|
|
| 1103 | +70 | 3x |
- dataset$PARAMCD == "QS02801" & dataset$CHG == 1,+ set.seed(seed)+ |
+ |
| 71 | ++ |
+ } |
||
| 1104 | +72 | 3x |
- "Worsened by one level", dataset$CHGCAT1+ study_duration_secs <- lubridate::seconds(attr(adsl, "study_duration_secs")) |
|
| 1105 | +73 |
- )+ |
||
| 1106 | +74 | 3x |
- dataset$CHGCAT1 <- ifelse(+ advs <- expand.grid( |
|
| 1107 | +75 | 3x |
- dataset$PARAMCD == "QS02801" & dataset$CHG == 2,+ STUDYID = unique(adsl$STUDYID), |
|
| 1108 | +76 | 3x |
- "Worsened by two levels", dataset$CHGCAT1- |
- |
| 1109 | -- |
- )+ USUBJID = adsl$USUBJID, |
||
| 1110 | +77 | 3x |
- dataset$CHGCAT1 <- ifelse(+ PARAM = as.factor(param_init_list$relvar1), |
|
| 1111 | +78 | 3x |
- dataset$PARAMCD == "QS02801" & dataset$CHG == 3,+ AVISIT = visit_schedule(visit_format = visit_format, n_assessments = n_assessments), |
|
| 1112 | +79 | 3x |
- "Worsened by three levels", dataset$CHGCAT1+ stringsAsFactors = FALSE |
|
| 1113 | +80 |
- )+ ) |
||
| 1114 | +81 | |||
| 1115 | +82 | 3x |
- paramcd_vec <- c(+ advs <- dplyr::mutate( |
|
| 1116 | +83 | 3x |
- "QS02803", "QS02804", "QS02805", "QS02807", "QS02808", "QS02809", "QS02810",+ advs, |
|
| 1117 | +84 | 3x |
- "QS02811", "QS02812", "QS02813", "QS02814", "QS02815", "QS02816", "QS02817",+ AVISITN = dplyr::case_when( |
|
| 1118 | +85 | 3x |
- "QS02818", "QS02819", "QS02820", "QS02821", "QS02822", "QS02823", "QS02824",+ AVISIT == "SCREENING" ~ -1, |
|
| 1119 | +86 | 3x |
- "QS02825", "QS02826", "QS02827", "QS02828"+ AVISIT == "BASELINE" ~ 0,+ |
+ |
| 87 | +3x | +
+ (grepl("^WEEK", AVISIT) | grepl("^CYCLE", AVISIT)) ~ as.numeric(AVISIT) - 2,
+ |
+ ||
| 88 | +3x | +
+ TRUE ~ NA_real_ |
||
| 1120 | +89 |
) |
||
| 1121 | +90 |
-
+ ) |
||
| 1122 | -3x | +|||
| 91 | +
- dataset$CHGCAT1 <- ifelse(+ |
|||
| 1123 | +92 | 3x |
- dataset$PARAMCD %in% paramcd_vec & dataset$CHG == -3,+ advs$VSCAT <- "VITAL SIGNS" |
|
| 1124 | -3x | +|||
| 93 | +
- "Improved by three levels", dataset$CHGCAT1+ |
|||
| 1125 | +94 |
- )+ # assign related variable values: PARAMxPARAMCD are related |
||
| 1126 | +95 | 3x |
- dataset$CHGCAT1 <- ifelse(+ advs <- advs %>% rel_var( |
|
| 1127 | +96 | 3x |
- dataset$PARAMCD %in% paramcd_vec & dataset$CHG == -2,+ var_name = "PARAMCD", |
|
| 1128 | +97 | 3x |
- "Improved by two levels", dataset$CHGCAT1+ related_var = "PARAM",+ |
+ |
| 98 | +3x | +
+ var_values = param_init_list$relvar2 |
||
| 1129 | +99 |
- )+ ) |
||
| 1130 | -3x | +|||
| 100 | +
- dataset$CHGCAT1 <- ifelse(+ |
|||
| 1131 | -3x | +|||
| 101 | +
- dataset$PARAMCD %in% paramcd_vec & dataset$CHG == -1,+ # assign related variable values: PARAMxAVALU are related |
|||
| 1132 | +102 | 3x |
- "Improved by one level", dataset$CHGCAT1+ advs <- advs %>% rel_var( |
|
| 1133 | -+ | |||
| 103 | +3x |
- )+ var_name = "AVALU", |
||
| 1134 | +104 | 3x |
- dataset$CHGCAT1 <- ifelse(+ related_var = "PARAM", |
|
| 1135 | +105 | 3x |
- dataset$PARAMCD %in% paramcd_vec & dataset$CHG == 0,+ var_values = unit_init_list$relvar2 |
|
| 1136 | -3x | +|||
| 106 | +
- "No change", dataset$CHGCAT1+ ) |
|||
| 1137 | +107 |
- )+ |
||
| 1138 | +108 | 3x |
- dataset$CHGCAT1 <- ifelse(+ advs <- advs %>% |
|
| 1139 | +109 | 3x |
- dataset$PARAMCD %in% paramcd_vec & dataset$CHG == 1,+ dplyr::mutate(VSTESTCD = PARAMCD) %>% |
|
| 1140 | +110 | 3x |
- "Worsened by one level", dataset$CHGCAT1+ dplyr::mutate(VSTEST = PARAM) |
|
| 1141 | +111 |
- )+ |
||
| 1142 | +112 | 3x |
- dataset$CHGCAT1 <- ifelse(+ advs <- advs %>% dplyr::mutate(AVAL = dplyr::case_when( |
|
| 1143 | +113 | 3x |
- dataset$PARAMCD %in% paramcd_vec & dataset$CHG == 2,+ PARAMCD == paramcd[1] ~ stats::rnorm(nrow(advs), mean = 100, sd = 20), |
|
| 1144 | +114 | 3x |
- "Worsened by two levels", dataset$CHGCAT1+ PARAMCD == paramcd[2] ~ stats::rnorm(nrow(advs), mean = 80, sd = 15), |
|
| 1145 | -+ | |||
| 115 | +3x |
- )+ PARAMCD == paramcd[3] ~ stats::rnorm(nrow(advs), mean = 16, sd = 5), |
||
| 1146 | +116 | 3x |
- dataset$CHGCAT1 <- ifelse(+ PARAMCD == paramcd[4] ~ stats::rnorm(nrow(advs), mean = 150, sd = 30), |
|
| 1147 | +117 | 3x |
- dataset$PARAMCD %in% paramcd_vec & dataset$CHG == 3,+ PARAMCD == paramcd[5] ~ stats::rnorm(nrow(advs), mean = 36.65, sd = 1), |
|
| 1148 | +118 | 3x |
- "Worsened by three levels", dataset$CHGCAT1+ PARAMCD == paramcd[6] ~ stats::rnorm(nrow(advs), mean = 70, sd = 20) |
|
| 1149 | +119 |
- )+ )) |
||
| 1150 | +120 | |||
| 121 | ++ |
+ # order to prepare for change from screening and baseline values+ |
+ ||
| 1151 | +122 | 3x |
- return(dataset)+ advs <- advs[order(advs$STUDYID, advs$USUBJID, advs$PARAMCD, advs$AVISITN), ] |
|
| 1152 | +123 |
- } else {
+
|
||
| 1153 | -! | +|||
| 124 | +3x |
- collapse_vars <- paste(check_vars, collapse = ", ")+ advs <- Reduce(rbind, lapply(split(advs, advs$USUBJID), function(x) {
|
||
| 1154 | -! | +|||
| 125 | +30x |
- stop(sprintf(+ x$STUDYID <- adsl$STUDYID[which(adsl$USUBJID == x$USUBJID[1])] |
||
| 1155 | -! | +|||
| 126 | +30x |
- "%s: one or both variables is/are missing, needed for derivation",+ x$ABLFL2 <- ifelse(x$AVISIT == "SCREENING", "Y", "") |
||
| 1156 | -! | +|||
| 127 | +30x |
- collapse_vars+ x$ABLFL <- ifelse( |
||
| 1157 | -+ | |||
| 128 | +30x |
- ))+ toupper(visit_format) == "WEEK" & x$AVISIT == "BASELINE", |
||
| 1158 | -+ | |||
| 129 | +30x |
- }+ "Y", |
||
| 1159 | -+ | |||
| 130 | +30x |
- }+ ifelse( |
||
| 1160 | -+ | |||
| 131 | +30x |
-
+ toupper(visit_format) == "CYCLE" & x$AVISIT == "CYCLE 1 DAY 1", |
||
| 1161 | -+ | |||
| 132 | +30x |
- #' @describeIn h_adqlqc Completion/Compliance Data Calculation+ "Y", |
||
| 1162 | +133 |
- #'+ "" |
||
| 1163 | +134 |
- #' @param dataset (`data.frame`)\cr Dataset.+ ) |
||
| 1164 | +135 |
- #'+ ) |
||
| 1165 | -+ | |||
| 136 | +30x |
- #' @return `data.frame`+ x |
||
| 1166 | +137 |
- #' @keywords internal+ })) |
||
| 1167 | +138 |
- #'+ |
||
| 1168 | -+ | |||
| 139 | +3x |
- #' @examples+ advs$BASE2 <- retain(advs, advs$AVAL, advs$ABLFL2 == "Y") |
||
| 1169 | -+ | |||
| 140 | +3x |
- #' \dontrun{
+ advs$BASE <- ifelse(advs$ABLFL2 != "Y", retain(advs, advs$AVAL, advs$ABLFL == "Y"), NA) |
||
| 1170 | +141 |
- #' compliance_data <- random.cdisc.data:::comp_derv(adqlqc, 80, 2)+ |
||
| 1171 | -+ | |||
| 142 | +3x |
- #' compliance_data+ advs <- advs %>% |
||
| 1172 | -+ | |||
| 143 | +3x |
- #' }+ dplyr::mutate(CHG2 = AVAL - BASE2) %>% |
||
| 1173 | -+ | |||
| 144 | +3x |
- comp_derv <- function(dataset, percent, number) {
+ dplyr::mutate(PCHG2 = 100 * (CHG2 / BASE2)) %>% |
||
| 1174 | -+ | |||
| 145 | +3x |
- # original items data+ dplyr::mutate(CHG = AVAL - BASE) %>% |
||
| 1175 | +146 | 3x |
- orig_data <- filter(+ dplyr::mutate(PCHG = 100 * (CHG / BASE)) %>% |
|
| 1176 | +147 | 3x |
- dataset,+ dplyr::mutate(ANRLO = dplyr::case_when( |
|
| 1177 | +148 | 3x |
- PARCAT2 == "Original Items"+ PARAMCD == "DIABP" ~ 80, |
|
| 1178 | -+ | |||
| 149 | +3x |
- )+ PARAMCD == "PULSE" ~ 60, |
||
| 1179 | -+ | |||
| 150 | +3x |
- # total number of questionnaires+ PARAMCD == "RESP" ~ 12, |
||
| 1180 | +151 | 3x |
- comp_count_all <- select(+ PARAMCD == "SYSBP" ~ 120, |
|
| 1181 | +152 | 3x |
- orig_data,+ PARAMCD == "TEMP" ~ 36.1, |
|
| 1182 | +153 | 3x |
- PARAMCD+ PARAMCD == "WEIGHT" ~ 40 |
|
| 1183 | +154 |
- ) %>%+ )) %>% |
||
| 1184 | +155 | 3x |
- distinct() %>%+ dplyr::mutate(ANRHI = dplyr::case_when( |
|
| 1185 | +156 | 3x |
- count()+ PARAMCD == "DIABP" ~ 120, |
|
| 1186 | +157 | 3x |
- comp_count_all <- comp_count_all$n- |
- |
| 1187 | -- |
- # original items data count of questions answered+ PARAMCD == "PULSE" ~ 100, |
||
| 1188 | +158 | 3x |
- orig_data_summ <- group_by(+ PARAMCD == "RESP" ~ 20, |
|
| 1189 | +159 | 3x |
- orig_data,+ PARAMCD == "SYSBP" ~ 180, |
|
| 1190 | +160 | 3x |
- STUDYID,+ PARAMCD == "TEMP" ~ 37.2, |
|
| 1191 | +161 | 3x |
- USUBJID,+ PARAMCD == "WEIGHT" ~ 100 |
|
| 1192 | -3x | +|||
| 162 | +
- PARCAT1,+ )) %>% |
|||
| 1193 | +163 | 3x |
- AVISIT,+ dplyr::mutate(ANRIND = factor(dplyr::case_when( |
|
| 1194 | +164 | 3x |
- AVISITN,+ AVAL < ANRLO ~ "LOW", |
|
| 1195 | +165 | 3x |
- ADTM,+ AVAL > ANRHI ~ "HIGH", |
|
| 1196 | +166 | 3x |
- ADY+ TRUE ~ "NORMAL" |
|
| 1197 | +167 |
- ) %>%+ ))) %>% |
||
| 1198 | +168 | 3x |
- summarise(+ dplyr::mutate(VSSTRESC = dplyr::case_when( |
|
| 1199 | +169 | 3x |
- comp_count = sum(!is.na(AVAL)),+ PARAMCD == "DIABP" ~ "<80", |
|
| 1200 | +170 | 3x |
- comp_count_all = comp_count_all,+ PARAMCD == "PULSE" ~ "<60", |
|
| 1201 | +171 | 3x |
- .groups = "drop"+ PARAMCD == "RESP" ~ ">20", |
|
| 1202 | -+ | |||
| 172 | +3x |
- ) %>%+ PARAMCD == "SYSBP" ~ ">180", |
||
| 1203 | +173 | 3x |
- mutate(+ PARAMCD == "TEMP" ~ "<36.1", |
|
| 1204 | +174 | 3x |
- per_comp = trunc((comp_count / comp_count_all) * 100)+ PARAMCD == "WEIGHT" ~ "<40" |
|
| 1205 | +175 |
- )+ )) %>% |
||
| 1206 | -+ | |||
| 176 | +3x |
- # expected data+ dplyr::rowwise() %>% |
||
| 1207 | +177 | 3x |
- ex028_data <- filter(+ dplyr::mutate(LOQFL = factor( |
|
| 1208 | +178 | 3x |
- dataset,+ ifelse(eval(parse(text = paste(AVAL, VSSTRESC))), "Y", "N") |
|
| 1209 | -3x | +|||
| 179 | +
- PARAMCD == "EX028",+ )) %>% |
|||
| 1210 | +180 | 3x |
- AVAL == 1+ dplyr::ungroup() %>% |
|
| 1211 | -+ | |||
| 181 | +3x |
- ) %>%+ dplyr::mutate(BASETYPE = "LAST") %>% |
||
| 1212 | +182 | 3x |
- select(+ dplyr::group_by(USUBJID, PARAMCD, BASETYPE) %>% |
|
| 1213 | +183 | 3x |
- STUDYID,+ dplyr::mutate(BNRIND = ANRIND[ABLFL == "Y"]) %>% |
|
| 1214 | +184 | 3x |
- USUBJID,+ dplyr::ungroup() %>% |
|
| 1215 | +185 | 3x |
- PARCAT1,+ dplyr::mutate(ATPTN = 1) %>% |
|
| 1216 | +186 | 3x |
- AVISIT,+ dplyr::mutate(DTYPE = NA) %>% |
|
| 1217 | +187 | 3x |
- AVISITN,+ var_relabel( |
|
| 1218 | +188 | 3x |
- ADTM,+ USUBJID = attr(adsl$USUBJID, "label"), |
|
| 1219 | +189 | 3x |
- ADY,+ STUDYID = attr(adsl$STUDYID, "label") |
|
| 1220 | -3x | +|||
| 190 | +
- AVAL_ex028 = AVAL+ ) |
|||
| 1221 | +191 |
- ) %>%+ |
||
| 1222 | +192 | 3x |
- mutate(+ advs <- var_relabel( |
|
| 1223 | +193 | 3x |
- comp_count_all = comp_count_all+ advs,+ |
+ |
| 194 | +3x | +
+ STUDYID = "Study Identifier",+ |
+ ||
| 195 | +3x | +
+ USUBJID = "Unique Subject Identifier" |
||
| 1224 | +196 |
- )+ ) |
||
| 1225 | +197 | |||
| 1226 | -3x | +|||
| 198 | +
- joined <- left_join(+ # merge ADSL to be able to add LB date and study day variables |
|||
| 1227 | +199 | 3x |
- ex028_data,+ advs <- dplyr::inner_join( |
|
| 1228 | +200 | 3x |
- orig_data_summ,+ advs, |
|
| 1229 | +201 | 3x |
- by = c(+ adsl, |
|
| 1230 | +202 | 3x |
- "STUDYID",+ by = c("STUDYID", "USUBJID")
|
|
| 1231 | -3x | +|||
| 203 | +
- "USUBJID",+ ) %>% |
|||
| 1232 | +204 | 3x |
- "PARCAT1",+ dplyr::rowwise() %>% |
|
| 1233 | +205 | 3x |
- "AVISIT",+ dplyr::mutate(TRTENDT = lubridate::date(dplyr::case_when( |
|
| 1234 | +206 | 3x |
- "AVISITN",+ is.na(TRTEDTM) ~ lubridate::floor_date(lubridate::date(TRTSDTM) + study_duration_secs, unit = "day"), |
|
| 1235 | +207 | 3x |
- "comp_count_all"- |
- |
| 1236 | -- |
- )+ TRUE ~ TRTEDTM |
||
| 1237 | +208 |
- ) %>%+ ))) %>% |
||
| 1238 | +209 | 3x |
- select(-c("ADTM.x", "ADY.x"))
+ dplyr::ungroup() |
|
| 1239 | +210 | |||
| 1240 | +211 | 3x |
- joined <- rename(+ advs <- advs %>% |
|
| 1241 | +212 | 3x |
- joined,+ dplyr::group_by(USUBJID) %>% |
|
| 1242 | +213 | 3x |
- ADTM = ADTM.y,+ dplyr::arrange(USUBJID, AVISITN) %>% |
|
| 1243 | +214 | 3x |
- ADY = ADY.y+ dplyr::mutate(ADTM = rep( |
|
| 1244 | -+ | |||
| 215 | +3x |
- )+ sort(sample( |
||
| 1245 | -+ | |||
| 216 | +3x |
- # CO028ALL+ seq(lubridate::as_datetime(TRTSDTM[1]), lubridate::as_datetime(TRTENDT[1]), by = "day"), |
||
| 1246 | +217 | 3x |
- co028all <- mutate(+ size = nlevels(AVISIT) |
|
| 1247 | -3x | +|||
| 218 | +
- joined,+ )), |
|||
| 1248 | +219 | 3x |
- PARAMCD = "CO028ALL",+ each = n() / nlevels(AVISIT) |
|
| 1249 | -3x | +|||
| 220 | +
- PARAM = "EORTC QLQ-C30: Completion - Completed all questions",+ )) %>% |
|||
| 1250 | +221 | 3x |
- PARCAT2 = "Completion",+ dplyr::ungroup() %>% |
|
| 1251 | +222 | 3x |
- AVAL = case_when(+ dplyr::mutate(ADY = ceiling(difftime(ADTM, TRTSDTM, units = "days"))) %>% |
|
| 1252 | +223 | 3x |
- AVAL_ex028 == 1 & comp_count == comp_count_all ~ 1,+ dplyr::select(-TRTENDT) %>% |
|
| 1253 | +224 | 3x |
- AVAL_ex028 == 1 & (is.na(comp_count) | comp_count < comp_count_all) ~ 0+ dplyr::arrange(STUDYID, USUBJID, ADTM) |
|
| 1254 | +225 |
- ),+ |
||
| 1255 | +226 | 3x |
- AVALC = case_when(+ advs <- advs %>% dplyr::mutate(ONTRTFL = factor(dplyr::case_when( |
|
| 1256 | +227 | 3x |
- AVAL == 1 ~ "Completed all questions",+ !AVISIT %in% c("SCREENING", "BASELINE") ~ "Y",
|
|
| 1257 | +228 | 3x |
- AVAL == 0 ~ "Did not complete all questions"+ TRUE ~ "" |
|
| 1258 | +229 |
- )+ ))) |
||
| 1259 | +230 |
- )+ |
||
| 1260 | -+ | |||
| 231 | +3x |
- # CO028<y>P+ advs <- advs %>% |
||
| 1261 | +232 | 3x |
- co028p <- mutate(+ dplyr::mutate(ASPID = sample(seq_len(dplyr::n()))) %>% |
|
| 1262 | +233 | 3x |
- joined,+ dplyr::group_by(USUBJID) %>% |
|
| 1263 | +234 | 3x |
- PARAMCD = paste0("CO028", as.character(percent), "P"),
+ dplyr::mutate(VSSEQ = seq_len(dplyr::n())) %>% |
|
| 1264 | +235 | 3x |
- PARAM = sprintf(+ dplyr::mutate(ASEQ = VSSEQ) %>% |
|
| 1265 | +236 | 3x |
- "EORTC QLQ-C30: Completion - Completed at least %s%% of questions",+ dplyr::ungroup() %>% |
|
| 1266 | +237 | 3x |
- as.character(percent)+ dplyr::arrange( |
|
| 1267 | -+ | |||
| 238 | +3x |
- ),+ STUDYID, |
||
| 1268 | +239 | 3x |
- PARCAT2 = "Completion",+ USUBJID, |
|
| 1269 | -3x | -
- AVAL = case_when(- |
- ||
| 1270 | -3x | -
- AVAL_ex028 == 1 & per_comp >= percent ~ 1,- |
- ||
| 1271 | +240 | 3x |
- AVAL_ex028 == 1 & (is.na(per_comp) | per_comp < percent) ~ 0- |
- |
| 1272 | -- |
- ),+ PARAMCD, |
||
| 1273 | +241 | 3x |
- AVALC = case_when(+ BASETYPE, |
|
| 1274 | +242 | 3x |
- AVAL == 1 ~ sprintf(+ AVISITN, |
|
| 1275 | +243 | 3x |
- "Completed at least %s%% of questions",+ ATPTN, |
|
| 1276 | +244 | 3x |
- as.character(percent)- |
- |
| 1277 | -- |
- ),+ DTYPE, |
||
| 1278 | +245 | 3x |
- AVAL == 0 ~ sprintf(+ ADTM, |
|
| 1279 | +246 | 3x |
- "Did not complete at least %s%% of questions",+ VSSEQ, |
|
| 1280 | +247 | 3x |
- as.character(percent)- |
- |
| 1281 | -- |
- )+ ASPID |
||
| 1282 | +248 |
) |
||
| 1283 | -- |
- )- |
- ||
| 1284 | -- |
- # CO028<x>Q- |
- ||
| 1285 | -3x | -
- co028q <- mutate(- |
- ||
| 1286 | -3x | -
- joined,- |
- ||
| 1287 | -3x | -
- PARAMCD = paste0("CO028", as.character(number), "Q"),
- |
- ||
| 1288 | -3x | -
- PARAM = sprintf(- |
- ||
| 1289 | -3x | -
- "EORTC QLQ-C30: Completion - Completed at least %s question(s)",- |
- ||
| 1290 | -3x | -
- as.character(number)- |
- ||
| 1291 | -- |
- ),- |
- ||
| 1292 | -3x | -
- PARCAT2 = "Completion",- |
- ||
| 1293 | -3x | -
- AVAL = case_when(- |
- ||
| 1294 | -3x | -
- AVAL_ex028 == 1 & comp_count >= number ~ 1,- |
- ||
| 1295 | -3x | -
- AVAL_ex028 == 1 & (comp_count < number | is.na(comp_count)) ~ 0- |
- ||
| 1296 | -- |
- ),- |
- ||
| 1297 | -3x | -
- AVALC = case_when(- |
- ||
| 1298 | -3x | -
- AVAL == 1 ~ sprintf(- |
- ||
| 1299 | -3x | -
- "Completed at least %s questions",- |
- ||
| 1300 | -3x | -
- as.character(number)- |
- ||
| 1301 | +249 |
- ),- |
- ||
| 1302 | -3x | -
- AVAL == 0 ~ sprintf(- |
- ||
| 1303 | -3x | -
- "Did not complete at least %s question(s)",+ |
||
| 1304 | +250 | 3x |
- as.character(number)- |
- |
| 1305 | -- |
- )+ if (length(na_vars) > 0 && na_percentage > 0) {
|
||
| 1306 | -+ | |||
| 251 | +! |
- )+ advs <- mutate_na(ds = advs, na_vars = na_vars, na_percentage = na_percentage) |
||
| 1307 | +252 |
- )+ } |
||
| 1308 | +253 | |||
| 1309 | -3x | -
- co028_bind <- rbind(- |
- ||
| 1310 | -3x | -
- co028all,- |
- ||
| 1311 | -3x | -
- co028p,- |
- ||
| 1312 | -3x | -
- co028q- |
- ||
| 1313 | +254 |
- ) %>%- |
- ||
| 1314 | -3x | -
- select(+ # apply metadata |
||
| 1315 | +255 | 3x |
- -c("AVAL_ex028", "comp_count", "comp_count_all", "per_comp")
+ advs <- apply_metadata(advs, "metadata/ADVS.yml") |
|
| 1316 | +256 |
- )+ |
||
| 1317 | +257 | 3x |
- return(co028_bind)+ return(advs) |
|
| 1318 | +258 |
}@@ -30417,14 +29647,14 @@ random.cdisc.data coverage - 98.86% |
| 1 |
- #' Pharmacokinetics Analysis Dataset (ADPC)+ #' Hy's Law Analysis Dataset (ADHY) |
||
| 5 |
- #' Function for generating a random Pharmacokinetics Analysis Dataset for a given+ #' Function for generating a random Hy's Law Analysis Dataset for a given |
||
| 8 |
- #' @details One record per study, subject, parameter, and time point.+ #' @details One record per subject per parameter per analysis visit per analysis date. |
||
| 10 |
- #' @inheritParams argument_convention+ #' Keys: `STUDYID`, `USUBJID`, `PARAMCD`, `AVISITN`, `ADTM`, `SRCSEQ` |
||
| 11 |
- #' @param avalu (`character`)\cr Analysis value units.+ # |
||
| 12 |
- #' @param constants (`character vector`)\cr Constant parameters to be used in formulas for creating analysis values.+ #' @inheritParams argument_convention |
||
| 13 |
- #' @param duration (`numeric`)\cr Duration in number of days.+ #' @template param_cached |
||
| 14 |
- #' @template param_cached+ #' @templateVar data adhy |
||
| 15 |
- #' @templateVar data adpc+ #' |
||
| 16 |
- #'+ #' @return `data.frame` |
||
| 17 |
- #' @return `data.frame`+ #' @export |
||
| 18 |
- #' @export+ #' |
||
| 19 |
- #'+ #' @author wojciakw |
||
| 20 |
- #' @examples+ #' |
||
| 21 |
- #' adsl <- radsl(N = 10, seed = 1, study_duration = 2)+ #' @examples |
||
| 22 |
- #'+ #' adsl <- radsl(N = 10, seed = 1, study_duration = 2) |
||
| 23 |
- #' adpc <- radpc(adsl, seed = 2)+ #' |
||
| 24 |
- #' adpc+ #' adhy <- radhy(adsl, seed = 2) |
||
| 25 |
- #'+ #' adhy |
||
| 26 |
- #' adpc <- radpc(adsl, seed = 2, duration = 3)+ radhy <- function(adsl, |
||
| 27 |
- #' adpc+ param = c( |
||
| 28 |
- radpc <- function(adsl,+ "TBILI <= 2 times ULN and ALT value category", |
||
| 29 |
- avalu = "ug/mL",+ "TBILI > 2 times ULN and AST value category", |
||
| 30 |
- constants = c(D = 100, ka = 0.8, ke = 1),+ "TBILI > 2 times ULN and ALT value category", |
||
| 31 |
- duration = 2,+ "TBILI <= 2 times ULN and AST value category", |
||
| 32 |
- seed = NULL,+ "TBILI > 2 times ULN and ALKPH <= 2 times ULN and ALT value category", |
||
| 33 |
- na_percentage = 0,+ "TBILI > 2 times ULN and ALKPH <= 2 times ULN and AST value category", |
||
| 34 |
- na_vars = list(+ "TBILI > 2 times ULN and ALKPH <= 5 times ULN and ALT value category", |
||
| 35 |
- AVAL = c(NA, 0.1)+ "TBILI > 2 times ULN and ALKPH <= 5 times ULN and AST value category", |
||
| 36 |
- ),+ "TBILI <= 2 times ULN and two consecutive elevations of ALT in relation to ULN", |
||
| 37 |
- cached = FALSE) {
+ "TBILI > 2 times ULN and two consecutive elevations of AST in relation to ULN", |
||
| 38 | -5x | +
- checkmate::assert_flag(cached)+ "TBILI <= 2 times ULN and two consecutive elevations of AST in relation to ULN", |
|
| 39 | -5x | +
- if (cached) {
+ "TBILI > 2 times ULN and two consecutive elevations of ALT in relation to ULN", |
|
| 40 | -1x | +
- return(get_cached_data("cadpc"))
+ "TBILI > 2 times ULN and two consecutive elevations of ALT in relation to Baseline", |
|
| 41 |
- }+ "TBILI <= 2 times ULN and two consecutive elevations of ALT in relation to Baseline", |
||
| 42 |
-
+ "TBILI > 2 times ULN and two consecutive elevations of AST in relation to Baseline", |
||
| 43 | -4x | +
- checkmate::assert_data_frame(adsl)+ "TBILI <= 2 times ULN and two consecutive elevations of AST in relation to Baseline", |
|
| 44 | -4x | +
- checkmate::assert_character(avalu, len = 1, any.missing = FALSE)+ "ALT > 3 times ULN by Period", |
|
| 45 | -4x | +
- checkmate::assert_subset(names(constants), c("D", "ka", "ke"))
+ "AST > 3 times ULN by Period", |
|
| 46 | -4x | +
- checkmate::assert_numeric(x = duration, max.len = 1)+ "ALT or AST > 3 times ULN by Period", |
|
| 47 | -4x | +
- checkmate::assert_number(seed, null.ok = TRUE)+ "ALT > 3 times Baseline by Period", |
|
| 48 | -4x | +
- checkmate::assert_number(na_percentage, lower = 0, upper = 1)+ "AST > 3 times Baseline by Period", |
|
| 49 | -4x | +
- checkmate::assert_true(na_percentage < 1)+ "ALT or AST > 3 times Baseline by Period" |
|
| 50 | -4x | +
- checkmate::assert_list(na_vars)+ ), |
|
| 51 |
-
+ paramcd = c( |
||
| 52 | -4x | +
- if (!is.null(seed)) {
+ "BLAL", |
|
| 53 | -4x | +
- set.seed(seed)+ "BGAS", |
|
| 54 |
- }+ "BGAL", |
||
| 55 |
-
+ "BLAS", |
||
| 56 | -4x | +
- radpc_core <- function(day) {
+ "BA2AL", |
|
| 57 | -8x | +
- adpc_day <- tidyr::expand_grid(+ "BA2AS", |
|
| 58 | -8x | +
- data.frame(+ "BA5AL", |
|
| 59 | -8x | +
- STUDYID = adsl$STUDYID,+ "BA5AS", |
|
| 60 | -8x | +
- USUBJID = adsl$USUBJID,+ "BL2AL2CU", |
|
| 61 | -8x | +
- ARMCD = adsl$ARMCD,+ "BG2AS2CU", |
|
| 62 | -8x | +
- A0 = unname(constants["D"]),+ "BL2AS2CU", |
|
| 63 | -8x | +
- ka = unname(constants["ka"]) - stats::runif(length(adsl$USUBJID), -0.2, 0.2),+ "BG2AL2CU", |
|
| 64 | -8x | +
- ke = unname(constants["ke"]) - stats::runif(length(adsl$USUBJID), -0.2, 0.2)+ "BG2AL2CB", |
|
| 65 |
- ),+ "BL2AL2CB", |
||
| 66 | -8x | +
- PCTPTNUM = if (day == 1) c(0, 0.5, 1, 1.5, 2, 3, 4, 8, 12) else 24 * (day - 1),+ "BG2AS2CB", |
|
| 67 | -8x | +
- PARAM = factor(c("Plasma Drug X", "Urine Drug X", "Plasma Drug Y", "Urine Drug Y"))
+ "BL2AS2CB", |
|
| 68 |
- )+ "ALTPULN", |
||
| 69 | -8x | +
- adpc_day <- adpc_day[!(grepl("Urine", adpc_day$PARAM) & adpc_day$PCTPTNUM %in% c(0.5, 1, 1.5, 2, 3)), ] %>%
+ "ASTPULN", |
|
| 70 | -8x | +
- dplyr::arrange(USUBJID, PARAM) %>%+ "ALTASTPU", |
|
| 71 | -8x | +
- dplyr::mutate(+ "ALTPBASE", |
|
| 72 | -8x | +
- VISITDY = day,+ "ASTPBASE", |
|
| 73 | -8x | +
- VISIT = ifelse(day <= 7, paste("Day", VISITDY), paste("Week", (VISITDY - 1) / 7)),
+ "ALTASTPB" |
|
| 74 | -8x | +
- PCVOLU = ifelse(grepl("Urine", PARAM), "mL", ""),
+ ), |
|
| 75 | -8x | +
- ASMED = ifelse(grepl("Urine", PARAM), "URINE", "PLASMA"),
+ seed = NULL, |
|
| 76 | -8x | +
- PCTPT = factor(dplyr::case_when(+ cached = FALSE) {
|
|
| 77 | -8x | +4x |
- PCTPTNUM == 0 ~ "Predose",+ checkmate::assert_flag(cached) |
| 78 | -8x | +
- (day == 1 & grepl("Urine", PARAM)) ~
+
|
|
| 79 | -8x | +4x |
- paste0(lag(PCTPTNUM), "H - ", PCTPTNUM, "H"),+ if (cached) {
|
| 80 | -8x | +1x |
- (day != 1 & grepl("Urine", PARAM)) ~
+ return(get_cached_data("cadhy"))
|
| 81 | -8x | +
- paste0(as.numeric(PCTPTNUM) - 24, "H - ", PCTPTNUM, "H"),+ } |
|
| 82 | -8x | +
- TRUE ~ paste0(PCTPTNUM, "H")+ |
|
| 83 | -+ | 3x |
- )),+ checkmate::assert_data_frame(adsl) |
| 84 | -8x | +3x |
- ARELTM1 = PCTPTNUM,+ checkmate::assert_character(param, min.len = 1, any.missing = FALSE) |
| 85 | -8x | +3x |
- NRELTM1 = PCTPTNUM,+ checkmate::assert_character(paramcd, min.len = 1, any.missing = FALSE) |
| 86 | -8x | +3x |
- ARELTM2 = ARELTM1 - (24 * (day - 1)),+ checkmate::assert_number(seed, null.ok = TRUE) |
| 87 | -8x | +
- NRELTM2 = NRELTM1 - (24 * (day - 1)),+ |
|
| 88 | -8x | +
- A0 = ifelse(PARAM == "Plasma Drug Y", A0, A0 / 2),+ # validate and initialize related variables |
|
| 89 | -8x | +3x |
- AVAL = round(+ param_init_list <- relvar_init(param, paramcd) |
| 90 | -8x | +
- (A0 * ka * (+ |
|
| 91 | -8x | +3x |
- exp(-ka * ARELTM1) - exp(-ke * ARELTM1)+ if (!is.null(seed)) {
|
| 92 | -+ | 3x |
- ))+ set.seed(seed) |
| 93 | -8x | +
- / (ke - ka),+ } |
|
| 94 | -8x | +3x |
- digits = 3+ study_duration_secs <- lubridate::seconds(attr(adsl, "study_duration_secs")) |
| 95 |
- )+ |
||
| 96 |
- ) %>%+ # create all combinations of unique values in STUDYID, USUBJID, PARAM, AVISIT |
||
| 97 | -8x | +3x |
- dplyr::mutate(+ adhy <- expand.grid( |
| 98 | -8x | +3x |
- PCVOL = ifelse(+ STUDYID = unique(adsl$STUDYID), |
| 99 | -8x | +3x |
- ASMED == "URINE",+ USUBJID = adsl$USUBJID, |
| 100 | -8x | +3x |
- round(abs(((PCTPTNUM - 1) %% 24) * A0 * ka * exp(PCTPTNUM %% 1.8 / 10)), 2),+ PARAM = as.factor(param_init_list$relvar1), |
| 101 | -8x | +3x |
- NA+ AVISIT = as.factor(c("BASELINE", "POST-BASELINE")),
|
| 102 | -+ | 3x |
- ),+ APERIODC = as.factor(c("PERIOD 1", "PERIOD 2")),
|
| 103 | -+ | 3x |
- # PK Equation+ stringsAsFactors = FALSE |
| 104 | -8x | +
- AVALC = ifelse(AVAL == 0, "BLQ", as.character(AVAL)),+ ) |
|
| 105 | -8x | +
- AVALU = avalu,+ |
|
| 106 | -8x | +
- RELTMU = "hr"+ # remove records that are not needed and were created as a side product of expand.grid above |
|
| 107 | -+ | 3x |
- ) %>%+ adhy <- dplyr::filter(adhy, !(AVISIT == "BASELINE" & APERIODC == "PERIOD 2")) |
| 108 | -8x | +
- dplyr::select(-c("A0", "ka", "ke"))
+
|
|
| 109 |
-
+ # define TBILI ALT/AST params, period dependent parameters and the parameters that will be assigned values "Y" or "N" |
||
| 110 | -8x | +3x |
- return(adpc_day)+ paramcd_tbilialtast <- c("BLAL", "BGAS", "BGAL", "BLAS", "BA2AL", "BA2AS", "BA5AL", "BA5AS")
|
| 111 | -+ | 3x |
- }+ paramcd_by_period <- c("ALTPULN", "ASTPULN", "ALTASTPU", "ALTPBASE", "ASTPBASE", "ALTASTPB")
|
| 112 | -+ | 3x |
-
+ paramcd_yn <- c( |
| 113 | -4x | +3x |
- adpc <- list()+ "BL2AL2CU", "BG2AS2CU", "BL2AS2CU", "BG2AL2CU", "BG2AL2CB", "BL2AL2CB", "BG2AS2CB", "BL2AS2CB", |
| 114 | -+ | 3x |
-
+ paramcd_by_period |
| 115 | -4x | +
- for (day in seq(duration)[seq(duration) <= 7 | ((seq(duration) - 1) %% 7 == 0)]) {
+ ) |
|
| 116 | -8x | +
- adpc[[day]] <- radpc_core(day = day)+ |
|
| 117 |
- }+ # add other variables to adhy |
||
| 118 | -+ | 3x |
-
+ adhy <- adhy %>% |
| 119 | -4x | +3x |
- adpc <- do.call(rbind, adpc)+ rel_var( |
| 120 | -+ | 3x |
-
+ var_name = "PARAMCD", |
| 121 | -4x | +3x |
- adpc <- dplyr::inner_join(adpc, adsl, by = c("STUDYID", "USUBJID", "ARMCD")) %>%
+ related_var = "PARAM", |
| 122 | -4x | +3x |
- dplyr::filter(ACTARM != "B: Placebo", !(ACTARM == "A: Drug X" & PARAM == "Plasma Drug Y"))+ var_values = param_init_list$relvar2 |
| 123 |
-
+ ) %>% |
||
| 124 | -4x | +3x |
- if (length(na_vars) > 0 && na_percentage > 0) {
+ dplyr::mutate( |
| 125 | -! | +3x |
- adpc <- mutate_na(ds = adpc, na_vars = na_vars, na_percentage = na_percentage)+ AVALC = dplyr::case_when( |
| 126 | -+ | 3x |
- }+ PARAMCD %in% paramcd_tbilialtast ~ sample( |
| 127 | -+ | 3x |
-
+ x = c(">3-5ULN", ">5-10ULN", ">10-20ULN", ">20ULN", "Criteria not met"), size = dplyr::n(), replace = TRUE
|
| 128 | -4x | +
- adpc <- adpc %>%+ ), |
|
| 129 | -4x | +3x |
- rename(+ PARAMCD %in% paramcd_yn ~ sample( |
| 130 | -4x | +3x |
- AVALCAT1 = AVALC,+ x = c("Y", "N"), prob = c(0.1, 0.9), size = dplyr::n(), replace = TRUE
|
| 131 | -4x | +
- NFRLT = NRELTM1,+ ) |
|
| 132 | -4x | +
- AFRLT = ARELTM1,+ ), |
|
| 133 | -4x | +3x |
- NRRLT = NRELTM2,+ AVAL = dplyr::case_when( |
| 134 | -4x | +3x |
- ARRLT = ARELTM2+ AVALC == ">3-5ULN" ~ 1, |
| 135 | -+ | 3x |
- ) %>%+ AVALC == ">5-10ULN" ~ 2, |
| 136 | -4x | +3x |
- mutate(ANL02FL = "Y")+ AVALC == ">10-20ULN" ~ 3, |
| 137 | -+ | 3x |
-
+ AVALC == ">20ULN" ~ 4, |
| 138 | -4x | +3x |
- adpc <- apply_metadata(adpc, "metadata/ADPC.yml")+ AVALC == "Y" ~ 1, |
| 139 | -+ | 3x |
- }+ AVALC == "N" ~ 0, |
| 1 | -+ | |||
| 140 | +3x |
- #' Time-to-Event Analysis Dataset (ADTTE)+ AVALC == "Criteria not met" ~ 0 |
||
| 2 | +141 |
- #'+ ), |
||
| 3 | -+ | |||
| 142 | +3x |
- #' @description `r lifecycle::badge("stable")`
+ AVISITN = dplyr::case_when( |
||
| 4 | -+ | |||
| 143 | +3x |
- #'+ AVISIT == "BASELINE" ~ 0L, |
||
| 5 | -+ | |||
| 144 | +3x |
- #' Function for generating a random Time-to-Event Analysis Dataset for a given+ AVISIT == "POST-BASELINE" ~ 9995L, |
||
| 6 | -+ | |||
| 145 | +3x |
- #' Subject-Level Analysis Dataset.+ TRUE ~ NA_integer_ |
||
| 7 | +146 |
- #'+ ), |
||
| 8 | -+ | |||
| 147 | +3x |
- #' @details+ APERIOD = dplyr::case_when( |
||
| 9 | -+ | |||
| 148 | +3x |
- #'+ APERIODC == "PERIOD 1" ~ 1L, |
||
| 10 | -+ | |||
| 149 | +3x |
- #' Keys: `STUDYID`, `USUBJID`, `PARAMCD`+ APERIODC == "PERIOD 2" ~ 2L, |
||
| 11 | -+ | |||
| 150 | +3x |
- #'+ TRUE ~ NA_integer_ |
||
| 12 | +151 |
- #' @inheritParams argument_convention+ ), |
||
| 13 | -+ | |||
| 152 | +3x |
- #' @inheritParams radaette+ ABLFL = dplyr::if_else(AVISIT == "BASELINE", "Y", NA_character_), |
||
| 14 | -+ | |||
| 153 | +3x |
- #' @template param_cached+ ONTRTFL = dplyr::if_else(AVISIT == "POST-BASELINE", "Y", NA_character_), |
||
| 15 | -+ | |||
| 154 | +3x |
- #' @templateVar data adtte+ ANL01FL = "Y", |
||
| 16 | -+ | |||
| 155 | +3x |
- #'+ SRCSEQ = NA_integer_ |
||
| 17 | +156 |
- #' @return `data.frame`+ ) |
||
| 18 | +157 |
- #' @export+ |
||
| 19 | +158 |
- #'+ # remove records for parameters with period 2 and not in paramcd_by_period |
||
| 20 | -+ | |||
| 159 | +3x |
- #' @examples+ adhy <- dplyr::filter(adhy, PARAMCD %in% paramcd_by_period | APERIODC == "PERIOD 1") |
||
| 21 | +160 |
- #' adsl <- radsl(N = 10, seed = 1, study_duration = 2)+ |
||
| 22 | +161 |
- #'+ # add baseline variables |
||
| 23 | -+ | |||
| 162 | +3x |
- #' adtte <- radtte(adsl, seed = 2)+ adhy <- adhy %>% |
||
| 24 | -+ | |||
| 163 | +3x |
- #' adtte+ dplyr::group_by(USUBJID, PARAMCD) %>% |
||
| 25 | -+ | |||
| 164 | +3x |
- radtte <- function(adsl,+ dplyr::mutate( |
||
| 26 | -+ | |||
| 165 | +3x |
- event_descr = NULL,+ BASEC = AVALC[AVISIT == "BASELINE"], |
||
| 27 | -+ | |||
| 166 | +3x |
- censor_descr = NULL,+ BASE = AVAL[AVISIT == "BASELINE"] |
||
| 28 | +167 |
- lookup = NULL,+ ) %>% |
||
| 29 | -+ | |||
| 168 | +3x |
- seed = NULL,+ dplyr::ungroup() |
||
| 30 | +169 |
- na_percentage = 0,+ |
||
| 31 | -+ | |||
| 170 | +3x |
- na_vars = list(CNSR = c(NA, 0.1), AVAL = c(1234, 0.1), AVALU = c(1234, 0.1)),+ adhy <- adhy %>% |
||
| 32 | -+ | |||
| 171 | +3x |
- cached = FALSE) {
+ var_relabel( |
||
| 33 | -4x | +172 | +3x |
- checkmate::assert_flag(cached)+ STUDYID = attr(adsl$STUDYID, "label"), |
| 34 | -4x | +173 | +3x |
- if (cached) {
+ USUBJID = attr(adsl$USUBJID, "label") |
| 35 | -1x | +|||
| 174 | +
- return(get_cached_data("cadtte"))
+ ) |
|||
| 36 | +175 |
- }+ |
||
| 37 | +176 |
-
+ # merge ADSL to be able to add analysis datetime and analysis relative day variables |
||
| 38 | +177 | 3x |
- checkmate::assert_data_frame(adsl)+ adhy <- dplyr::inner_join(adhy, adsl, by = c("STUDYID", "USUBJID"))
+ |
+ |
| 178 | ++ | + + | +||
| 179 | ++ |
+ # define a simple helper function to create ADY variable |
||
| 39 | +180 | 3x |
- checkmate::assert_character(censor_descr, null.ok = TRUE, min.len = 1, any.missing = FALSE)+ add_ady <- function(x, avisit) {
|
|
| 40 | -3x | +181 | +6x |
- checkmate::assert_character(event_descr, null.ok = TRUE, min.len = 1, any.missing = FALSE)+ if (avisit == "BASELINE") {
|
| 41 | +182 | 3x |
- checkmate::assert_number(seed, null.ok = TRUE)+ dplyr::mutate( |
|
| 42 | +183 | 3x |
- checkmate::assert_number(na_percentage, lower = 0, upper = 1)+ x, |
|
| 43 | +184 | 3x |
- checkmate::assert_true(na_percentage < 1)+ ADY = sample(x = -(1:14), size = dplyr::n(), replace = TRUE) |
|
| 44 | +185 |
-
+ ) |
||
| 45 | +186 | 3x |
- if (!is.null(seed)) {
+ } else if (avisit == "POST-BASELINE") {
|
|
| 46 | +187 | 3x |
- set.seed(seed)- |
- |
| 47 | -- |
- }+ dplyr::rowwise(x) %>% |
||
| 48 | +188 | 3x |
- study_duration_secs <- lubridate::seconds(attr(adsl, "study_duration_secs"))+ dplyr::mutate(ADY = as.integer(sample( |
|
| 49 | -+ | |||
| 189 | +3x |
-
+ dplyr::if_else( |
||
| 50 | +190 | 3x |
- checkmate::assert_data_frame(lookup, null.ok = TRUE)+ !is.na(TRTEDTM), |
|
| 51 | +191 | 3x |
- lookup_tte <- if (!is.null(lookup)) {
+ as.numeric(difftime(TRTEDTM, TRTSDTM, units = "days")), |
|
| 52 | -! | +|||
| 192 | +3x |
- lookup+ as.numeric(study_duration_secs, "days") |
||
| 53 | +193 |
- } else {
+ ), |
||
| 54 | +194 | 3x |
- tibble::tribble(+ size = 1, |
|
| 55 | +195 | 3x |
- ~ARM, ~PARAMCD, ~PARAM, ~LAMBDA, ~CNSR_P,+ replace = TRUE |
|
| 56 | -3x | +|||
| 196 | +
- "ARM A", "EFS", "Event Free Survival", log(2) / 365, 0.4,+ ))) |
|||
| 57 | -3x | +|||
| 197 | +
- "ARM B", "EFS", "Event Free Survival", log(2) / 305, 0.3,+ } else {
|
|||
| 58 | -3x | +|||
| 198 | +! |
- "ARM C", "EFS", "Event Free Survival", log(2) / 243, 0.2,+ dplyr::mutate(x, ADY = NA_integer_) |
||
| 59 | -3x | +|||
| 199 | +
- "ARM A", "CRSD", "Duration of Confirmed Response", log(2) / 305, 0.4,+ } |
|||
| 60 | -3x | +|||
| 200 | +
- "ARM B", "CRSD", "Duration of Confirmed Response", log(2) / 243, 0.3,+ } |
|||
| 61 | -3x | +|||
| 201 | +
- "ARM C", "CRSD", "Duration of Confirmed Response", log(2) / 182, 0.2,+ |
|||
| 62 | -3x | +|||
| 202 | +
- "ARM A", "PFS", "Progression Free Survival", log(2) / 365, 0.4,+ # add ADY and ADTM variables |
|||
| 63 | +203 | 3x |
- "ARM B", "PFS", "Progression Free Survival", log(2) / 305, 0.3,+ adhy <- adhy %>% |
|
| 64 | +204 | 3x |
- "ARM C", "PFS", "Progression Free Survival", log(2) / 243, 0.2,+ dplyr::group_by(AVISIT, .add = FALSE) %>% |
|
| 65 | +205 | 3x |
- "ARM A", "OS", "Overall Survival", log(2) / 610, 0.4,+ dplyr::group_modify(~ add_ady(.x, .y$AVISIT)) %>% |
|
| 66 | +206 | 3x |
- "ARM B", "OS", "Overall Survival", log(2) / 490, 0.3,+ dplyr::ungroup() %>% |
|
| 67 | +207 | 3x |
- "ARM C", "OS", "Overall Survival", log(2) / 365, 0.2,- |
- |
| 68 | -- |
- )+ dplyr::mutate(ADTM = TRTSDTM + lubridate::days(ADY)) |
||
| 69 | +208 |
- }+ |
||
| 70 | +209 |
-
+ # order columns and arrange rows; column order follows ADaM_1.1 specification |
||
| 71 | +210 | 3x |
- evntdescr_sel <- if (!is.null(event_descr)) {
- |
- |
| 72 | -! | -
- event_descr- |
- ||
| 73 | -- |
- } else {
+ adhy <- |
||
| 74 | +211 | 3x |
- c(+ adhy[, c( |
|
| 75 | +212 | 3x |
- "Death",+ colnames(adsl), |
|
| 76 | +213 | 3x |
- "Disease Progression",+ "PARAM", |
|
| 77 | +214 | 3x |
- "Last Tumor Assessment",+ "PARAMCD", |
|
| 78 | +215 | 3x |
- "Adverse Event",+ "AVAL", |
|
| 79 | +216 | 3x |
- "Alive"+ "AVALC", |
|
| 80 | -+ | |||
| 217 | +3x |
- )+ "BASE", |
||
| 81 | -+ | |||
| 218 | +3x |
- }+ "BASEC", |
||
| 82 | -+ | |||
| 219 | +3x |
-
+ "ABLFL", |
||
| 83 | +220 | 3x |
- cnsdtdscr_sel <- if (!is.null(censor_descr)) {
+ "ADTM", |
|
| 84 | -! | +|||
| 221 | +3x |
- censor_descr+ "ADY", |
||
| 85 | -+ | |||
| 222 | +3x |
- } else {
+ "AVISIT", |
||
| 86 | +223 | 3x |
- c(+ "AVISITN", |
|
| 87 | +224 | 3x |
- "Preferred Term",+ "APERIOD", |
|
| 88 | +225 | 3x |
- "Clinical Cut Off",+ "APERIODC", |
|
| 89 | +226 | 3x |
- "Completion or Discontinuation",+ "ONTRTFL", |
|
| 90 | +227 | 3x |
- "End of AE Reporting Period"+ "SRCSEQ", |
|
| 91 | -+ | |||
| 228 | +3x |
- )+ "ANL01FL" |
||
| 92 | +229 |
- }+ )] |
||
| 93 | +230 | |||
| 94 | +231 | 3x |
- adtte <- split(adsl, adsl$USUBJID) %>%+ adhy <- adhy %>% |
|
| 95 | +232 | 3x |
- lapply(FUN = function(pinfo) {
+ dplyr::arrange( |
|
| 96 | -30x | +233 | +3x |
- lookup_tte %>%+ STUDYID, |
| 97 | -30x | +234 | +3x |
- dplyr::filter(ARM == as.character(pinfo$ACTARMCD)) %>%+ USUBJID, |
| 98 | -30x | +235 | +3x |
- dplyr::rowwise() %>%+ PARAMCD, |
| 99 | -30x | +236 | +3x |
- dplyr::mutate(+ AVISITN, |
| 100 | -30x | +237 | +3x |
- STUDYID = pinfo$STUDYID,+ ADTM, |
| 101 | -30x | +238 | +3x |
- SITEID = pinfo$SITEID,+ SRCSEQ |
| 102 | -30x | +|||
| 239 | +
- USUBJID = pinfo$USUBJID,+ ) |
|||
| 103 | -30x | +|||
| 240 | +
- AVALU = "DAYS"+ |
|||
| 104 | +241 |
- ) %>%+ # apply metadata |
||
| 105 | -30x | +242 | +3x |
- dplyr::select(-"LAMBDA", -"CNSR_P")+ adhy <- apply_metadata(adhy, "metadata/ADHY.yml") |
| 106 | +243 |
- }) %>%+ |
||
| 107 | +244 | 3x |
- Reduce(rbind, .) %>%+ return(adhy) |
|
| 108 | -3x | +|||
| 245 | +
- var_relabel(+ } |
|||
| 109 | -3x | +
| 1 | +
- STUDYID = "Study Identifier",+ #' Tumor Response Analysis Dataset (ADTR) |
|||
| 110 | -3x | +|||
| 2 | +
- USUBJID = "Unique Subject Identifier" # )+ #' |
|||
| 111 | +3 |
- )+ #' @description `r lifecycle::badge("stable")`
|
||
| 112 | +4 |
-
+ #' |
||
| 113 | +5 |
- # Loop through each patient and randomly assign a value for EVNTDESC+ #' Function for generating a random Tumor Response Analysis Dataset for a given |
||
| 114 | -3x | +|||
| 6 | +
- adtte_split <- split(adtte, adtte$USUBJID)+ #' Subject-Level Analysis Dataset. |
|||
| 115 | +7 |
-
+ #' |
||
| 116 | +8 |
- # Add EVNTDESC column+ #' @details One record per subject per parameter per analysis visit per analysis date. |
||
| 117 | -3x | +|||
| 9 | +
- adtte_lst <- lapply(adtte_split, function(split_df) {
+ #' |
|||
| 118 | +10 |
- # First create an empty EVNTDESC variable to populate+ #' Keys: `STUDYID`, `USUBJID`, `PARAMCD`, `BASETYPE`, `AVISITN`, `DTYPE` |
||
| 119 | -30x | +|||
| 11 | +
- split_df$EVNTDESC <- NA- |
- |||
| 120 | -30x | -
- for (i in 1:nrow(split_df)) { # nolint
+ #' |
||
| 121 | +12 |
- # If this is the first row then create a random value from evntdescr_sel for EVNTDESC- |
- ||
| 122 | -120x | -
- if (i == 1) {
+ #' @inheritParams argument_convention |
||
| 123 | -30x | +|||
| 13 | +
- split_df$EVNTDESC[i] <- sample(evntdescr_sel[c(1:4)], 1, prob = c(0.1, 0.3, 0.4, 0.2))+ #' @param ... Additional arguments to be passed to `radrs`. |
|||
| 124 | -90x | +|||
| 14 | +
- } else if (i != 1 & i != nrow(split_df)) {
+ #' @template param_cached |
|||
| 125 | +15 |
- # First check to see if "Death" has been entered in as a previous value+ #' @templateVar data adtr |
||
| 126 | +16 |
- # If so we need to make the rest of the EVNTDESC values "Death" to make sense+ #' |
||
| 127 | +17 |
- # The patient cannot die and then come back to life+ #' @return `data.frame` |
||
| 128 | -60x | +|||
| 18 | +
- if (any(grepl("Death", split_df$EVNTDESC))) { # If previous value has "Death" the following need to be "Death"
+ #' @export |
|||
| 129 | -21x | +|||
| 19 | +
- split_df$EVNTDESC[i] <- "Death"+ #' |
|||
| 130 | -3x | +|||
| 20 | +
- } else { # If there are no "Death" values randomly select another value
+ #' @author tomlinsj, npaszty, Xuefeng Hou, dipietrc |
|||
| 131 | -39x | +|||
| 21 | +
- split_df$EVNTDESC[i] <- sample(evntdescr_sel[c(1:4)], 1)+ #' |
|||
| 132 | +22 |
- }+ #' @examples |
||
| 133 | -3x | +|||
| 23 | +
- } else { # This is for processing OS as this can only be "Death" or "Alive"
+ #' adsl <- radsl(N = 10, seed = 1, study_duration = 2) |
|||
| 134 | -30x | +|||
| 24 | +
- if (any(grepl("Death", split_df$EVNTDESC))) { # If previous value has "Death" the following need to be "Death"
+ #' |
|||
| 135 | -21x | +|||
| 25 | +
- split_df$EVNTDESC[i] <- "Death"+ #' adtr <- radtr(adsl, seed = 2) |
|||
| 136 | -3x | +|||
| 26 | +
- } else { # If there are no "Death" values randomly select another value
+ #' adtr |
|||
| 137 | -9x | +|||
| 27 | +
- split_df$EVNTDESC[i] <- "Alive"+ radtr <- function(adsl, |
|||
| 138 | +28 |
- }+ param = c("Sum of Longest Diameter by Investigator"),
|
||
| 139 | +29 |
- }+ paramcd = c("SLDINV"),
|
||
| 140 | +30 |
- }+ seed = NULL, |
||
| 141 | -30x | +|||
| 31 | +
- split_df+ cached = FALSE, |
|||
| 142 | +32 |
- })+ ...) {
|
||
| 143 | -+ | |||
| 33 | +4x |
-
+ checkmate::assert_flag(cached) |
||
| 144 | -+ | |||
| 34 | +4x |
- # Add CNSR column+ if (cached) {
|
||
| 145 | -3x | +35 | +1x |
- adtte_lst <- lapply(adtte_lst, function(split_df) {
+ return(get_cached_data("cadtr"))
|
| 146 | +36 |
- # First create an empty CNSR variable to populate+ } |
||
| 147 | -30x | +37 | +3x |
- split_df$CNSR <- NA+ checkmate::assert_data_frame(adsl) |
| 148 | -30x | +38 | +3x |
- for (i in 1:nrow(split_df)) { # nolint
+ checkmate::assert_character(param, min.len = 1, any.missing = FALSE) |
| 149 | -+ | |||
| 39 | +3x |
- # If this is the first row then create a random value from evntdescr_sel for EVNTDESC+ checkmate::assert_character(paramcd, min.len = 1, any.missing = FALSE) |
||
| 150 | -120x | +40 | +3x |
- if (split_df$EVNTDESC[i] == "Death" | split_df$EVNTDESC[i] == "Disease Progression") {
+ checkmate::assert_number(seed, null.ok = TRUE) |
| 151 | -81x | +41 | +3x |
- split_df$CNSR[i] <- 0+ stopifnot(length(param) == length(paramcd)) |
| 152 | +42 |
- } else {
- |
- ||
| 153 | -39x | -
- split_df$CNSR[i] <- 1+ # validate and initialize related variables |
||
| 154 | +43 |
- }+ |
||
| 155 | -+ | |||
| 44 | +3x |
- }+ if (!is.null(seed)) {
|
||
| 156 | -30x | +45 | +3x |
- split_df+ set.seed(seed) |
| 157 | +46 |
- })+ } |
||
| 158 | +47 | |||
| 159 | +48 |
- # Add AVAL column+ # Make times consistent with ADRS at ADY and ADTM. |
||
| 160 | +49 | 3x |
- adtte_lst <- lapply(adtte_lst, function(split_df) {
+ adrs <- radrs(adsl, seed = seed, ...) %>% |
|
| 161 | -+ | |||
| 50 | +3x |
- # First create an empty CNSR variable to populate+ dplyr::filter(PARAMCD == "OVRINV") %>% |
||
| 162 | -30x | +51 | +3x |
- split_df$AVAL <- NA+ dplyr::select( |
| 163 | -30x | +52 | +3x |
- for (i in 1:nrow(split_df)) { # nolint
+ "STUDYID", |
| 164 | -120x | +53 | +3x |
- if (i == 1) {
+ "USUBJID", |
| 165 | -30x | +54 | +3x |
- split_df$AVAL[i] <- stats::runif(1, 15, 100)+ "AVISIT", |
| 166 | -90x | +55 | +3x |
- } else if (i != 1 & any(grepl("Death", split_df[1:i - 1, "EVNTDESC"]))) {
+ "AVISITN", |
| 167 | -+ | |||
| 56 | +3x |
- # Check if there are any death values before the current row+ "ADTM", |
||
| 168 | -+ | |||
| 57 | +3x |
- # Set the AVAL to the value of the row that has the "Death" value+ "ADY" |
||
| 169 | +58 |
- # as the patient cannot live longer than this value+ ) |
||
| 170 | -42x | +|||
| 59 | +
- death_position <- match("Death", split_df[1:i - 1, "EVNTDESC"][[1]])
+
|
|||
| 171 | -42x | +60 | +3x |
- split_df$AVAL[i] <- split_df$AVAL[death_position]+ adtr <- Map(function(parcd, par) {
|
| 172 | -48x | +61 | +3x |
- } else if (i == 2) {
+ df <- adrs |
| 173 | -24x | +62 | +3x |
- split_df$AVAL[i] <- stats::runif(1, 100, 200)+ df$AVAL <- stats::rnorm(nrow(df), mean = 150, sd = 30) |
| 174 | -24x | +63 | +3x |
- } else if (i == 3) {
+ df$PARAMCD <- parcd |
| 175 | -15x | +64 | +3x |
- split_df$AVAL[i] <- stats::runif(1, 200, 300)+ df$PARAM <- par |
| 176 | -9x | +65 | +3x |
- } else if (i == 4) {
+ df |
| 177 | -9x | +66 | +3x |
- split_df$AVAL[i] <- stats::runif(1, 300, 500)+ }, paramcd, param) %>% |
| 178 | -+ | |||
| 67 | +3x |
- }+ Reduce(rbind, .) |
||
| 179 | +68 |
- }+ |
||
| 180 | -30x | +69 | +3x |
- split_df+ adtr_base <- adtr %>% |
| 181 | -+ | |||
| 70 | +3x |
- })+ dplyr::filter(AVISITN == 0) %>% |
||
| 182 | -+ | |||
| 71 | +3x |
-
+ dplyr::group_by(USUBJID, PARAMCD) %>% |
||
| 183 | -+ | |||
| 72 | +3x |
- # Add CNSDTDSC column+ dplyr::mutate(BASE = AVAL) %>% |
||
| 184 | +73 | 3x |
- adtte_lst <- lapply(adtte_lst, function(split_df) {
+ dplyr::select("STUDYID", "USUBJID", "BASE", "PARAMCD")
|
|
| 185 | +74 |
- # First create an empty CNSDTDSC variable to populate+ |
||
| 186 | -30x | +75 | +3x |
- split_df$CNSDTDSC <- NA+ adtr_postbase <- adtr %>% |
| 187 | -30x | +76 | +3x |
- for (i in 1:nrow(split_df)) { # nolint
+ dplyr::filter(AVISITN > 0) %>% |
| 188 | -120x | +77 | +3x |
- if (split_df$CNSR[i] == 1 & split_df$EVNTDESC[i] == "Last Tumor Assessment") {
+ dplyr::filter(!is.na(AVAL)) %>% |
| 189 | -27x | +78 | +3x |
- split_df$CNSDTDSC[i] <- "Completion or Discontinuation"+ dplyr::group_by(USUBJID, PARAMCD) %>% |
| 190 | -93x | +79 | +3x |
- } else if (split_df$CNSR[i] == 1 & split_df$EVNTDESC[i] == "Adverse Event") {
+ dplyr::filter(AVAL == min(AVAL)) %>% |
| 191 | +80 | 3x |
- split_df$CNSDTDSC[i] <- "Preferred Term"+ dplyr::slice(1) %>% |
|
| 192 | -90x | +81 | +3x |
- } else if (split_df$CNSR[i] == 1 & split_df$EVNTDESC[i] == "Alive") {
+ dplyr::mutate(AVISIT = "POST-BASELINE MINIMUM") %>% |
| 193 | -9x | -
- split_df$CNSDTDSC[i] <- "Alive During Study"- |
- ||
| 194 | -+ | 82 | +3x |
- } else {
+ dplyr::mutate(DTYPE = "MINIMUM") %>% |
| 195 | -81x | +83 | +3x |
- split_df$CNSDTDSC[i] <- ""+ dplyr::ungroup() |
| 196 | +84 |
- }+ |
||
| 197 | -+ | |||
| 85 | +3x |
- }+ adtr_lastobs <- adtr %>% |
||
| 198 | -30x | +86 | +3x |
- split_df+ dplyr::filter(AVISITN > 0) %>% |
| 199 | -+ | |||
| 87 | +3x |
- })+ dplyr::filter(!is.na(AVAL)) %>% |
||
| 200 | -+ | |||
| 88 | +3x |
-
+ dplyr::group_by(USUBJID, PARAMCD) %>% |
||
| 201 | -+ | |||
| 89 | +3x |
- # Take the split df and combine them back together+ dplyr::filter(ADTM == max(ADTM, na.rm = TRUE)) %>% |
||
| 202 | +90 | 3x |
- adtte <- do.call("rbind", adtte_lst)
+ dplyr::slice(1) %>% |
|
| 203 | +91 | 3x |
- rownames(adtte) <- NULL+ dplyr::mutate(LAST_VISIT = AVISIT) %>% |
|
| 204 | -+ | |||
| 92 | +3x |
-
+ dplyr::ungroup() %>% |
||
| 205 | +93 | 3x |
- adtte <- var_relabel(+ dplyr::select( |
|
| 206 | +94 | 3x |
- adtte,+ "STUDYID", |
|
| 207 | +95 | 3x |
- STUDYID = "Study Identifier",+ "USUBJID", |
|
| 208 | +96 | 3x |
- USUBJID = "Unique Subject Identifier"+ "PARAMCD",+ |
+ |
| 97 | +3x | +
+ "LAST_VISIT" |
||
| 209 | +98 |
- )+ ) |
||
| 210 | +99 | |||
| 100 | +3x | +
+ adtr <- rbind(adtr %>% dplyr::mutate(DTYPE = ""), adtr_postbase)+ |
+ ||
| 211 | +101 |
- # merge ADSL to be able to add TTE date and study day variables+ |
||
| 212 | +102 | 3x |
- adtte <- dplyr::inner_join(+ adtr <- merge(adtr, adtr_base, by = c("STUDYID", "USUBJID", "PARAMCD")) %>%
|
|
| 213 | +103 | 3x |
- dplyr::select(adtte, -"SITEID", -"ARM"),+ dplyr::mutate( |
|
| 214 | +104 | 3x |
- adsl,+ ABLFL = dplyr::case_when(AVISIT == "BASELINE" ~ "Y", TRUE ~ ""), |
|
| 215 | +105 | 3x |
- by = c("STUDYID", "USUBJID")
+ AVAL = dplyr::case_when(AVISIT == "BASELINE" ~ NA_real_, TRUE ~ AVAL), |
|
| 216 | -+ | |||
| 106 | +3x |
- ) %>%+ CHG = dplyr::case_when(AVISITN > 0 ~ AVAL - BASE, TRUE ~ NA_real_), |
||
| 217 | +107 | 3x |
- dplyr::rowwise() %>%+ PCHG = dplyr::case_when(AVISITN > 0 ~ CHG / BASE * 100, TRUE ~ NA_real_), |
|
| 218 | +108 | 3x |
- dplyr::mutate(TRTENDT = lubridate::date(dplyr::case_when(+ AVALC = as.character(AVAL), |
|
| 219 | +109 | 3x |
- is.na(TRTEDTM) ~ lubridate::floor_date(lubridate::date(TRTSDTM) + study_duration_secs, unit = "day"),+ AVALU = "mm" |
|
| 220 | -3x | +|||
| 110 | +
- TRUE ~ TRTEDTM+ ) |
|||
| 221 | +111 |
- ))) %>%+ |
||
| 222 | -3x | +|||
| 112 | +
- dplyr::mutate(ADTM = sample(+ # ensure PCHG does not exceed 200%, nor go below -100% (double in size, or complete remission of tumor). |
|||
| 223 | +113 | 3x |
- seq(lubridate::as_datetime(TRTSDTM), lubridate::as_datetime(TRTENDT), by = "day"),+ adtr <- adtr %>% |
|
| 224 | +114 | 3x |
- size = 1+ dplyr::mutate( |
|
| 225 | -+ | |||
| 115 | +3x |
- )) %>%+ PCHG_DUM = PCHG, |
||
| 226 | +116 | 3x |
- dplyr::mutate(ADY = ceiling(difftime(ADTM, TRTSDTM, units = "days"))) %>%+ PCHG = dplyr::case_when( |
|
| 227 | +117 | 3x |
- dplyr::select(-TRTENDT) %>%+ PCHG_DUM > 200 ~ 200, |
|
| 228 | +118 | 3x |
- dplyr::ungroup() %>%+ PCHG_DUM < -100 ~ -100, |
|
| 229 | +119 | 3x |
- dplyr::arrange(STUDYID, USUBJID, ADTM)+ TRUE ~ PCHG |
|
| 230 | +120 |
-
+ ), |
||
| 231 | +121 | 3x |
- adtte <- adtte %>%+ AVAL = dplyr::case_when( |
|
| 232 | +122 | 3x |
- dplyr::group_by(USUBJID) %>%+ PCHG_DUM > 200 ~ 3 * BASE, |
|
| 233 | +123 | 3x |
- dplyr::mutate(TTESEQ = seq_len(dplyr::n())) %>%+ PCHG_DUM < -100 ~ 0, |
|
| 234 | +124 | 3x |
- dplyr::mutate(ASEQ = TTESEQ) %>%+ TRUE ~ AVAL |
|
| 235 | -3x | +|||
| 125 | +
- dplyr::mutate(PARAM = as.factor(PARAM)) %>%+ ), |
|||
| 236 | +126 | 3x |
- dplyr::mutate(PARAMCD = as.factor(PARAMCD)) %>%+ CHG = dplyr::case_when( |
|
| 237 | +127 | 3x |
- dplyr::ungroup() %>%+ PCHG_DUM > 200 ~ 2 * BASE, |
|
| 238 | +128 | 3x |
- dplyr::arrange(+ PCHG_DUM < -100 ~ -BASE, |
|
| 239 | +129 | 3x |
- STUDYID,+ TRUE ~ CHG |
|
| 240 | -3x | +|||
| 130 | +
- USUBJID,+ )+ |
+ |||
| 131 | ++ |
+ ) %>% |
||
| 241 | +132 | 3x |
- PARAMCD,+ dplyr::select(-"PCHG_DUM")+ |
+ |
| 133 | ++ | + | ||
| 242 | +134 | 3x |
- ADTM,+ adtr <- merge(adsl, adtr, by = c("STUDYID", "USUBJID")) %>%
|
|
| 243 | +135 | 3x |
- TTESEQ+ dplyr::group_by(USUBJID, PARAMCD) %>% |
|
| 244 | -+ | |||
| 136 | +3x |
- )+ dplyr::mutate( |
||
| 245 | -+ | |||
| 137 | +3x |
-
+ ONTRTFL = factor(dplyr::case_when( |
||
| 246 | +138 | 3x |
- mod_before_adtte <- adtte+ !AVISIT %in% c("SCREENING", "BASELINE", "FOLLOW UP") ~ "Y",
|
|
| 247 | -+ | |||
| 139 | +3x |
-
+ TRUE ~ "" |
||
| 248 | +140 |
- # adding adverse event counts and log follow-up time+ )), |
||
| 249 | +141 | 3x |
- adtte <- dplyr::bind_rows(+ ANL01FL = dplyr::case_when( |
|
| 250 | +142 | 3x |
- adtte,+ DTYPE == "" & AVISITN > 0 ~ "Y", |
|
| 251 | +143 | 3x |
- data.frame(+ TRUE ~ "" |
|
| 252 | -3x | +|||
| 144 | +
- adtte %>%+ ), |
|||
| 253 | +145 | 3x |
- dplyr::group_by(USUBJID) %>%+ ANL03FL = dplyr::case_when( |
|
| 254 | +146 | 3x |
- dplyr::slice_head(n = 1) %>%+ DTYPE == "MINIMUM" ~ "Y", |
|
| 255 | +147 | 3x |
- dplyr::mutate(+ ABLFL == "Y" ~ "Y", |
|
| 256 | +148 | 3x |
- PARAMCD = "TNE",+ TRUE ~ "" |
|
| 257 | -3x | +|||
| 149 | +
- PARAM = "Total Number of Exacerbations",+ )+ |
+ |||
| 150 | ++ |
+ ) |
||
| 258 | +151 | 3x |
- AVAL = stats::rpois(1, 3),+ adtr <- merge(adtr, adtr_lastobs, by = c("STUDYID", "USUBJID", "PARAMCD")) %>%
|
|
| 259 | +152 | 3x |
- AVALU = "COUNT",+ dplyr::mutate( |
|
| 260 | +153 | 3x |
- lgTMATRSK = log(stats::rexp(1, rate = 3)),+ ANL02FL = dplyr::case_when( |
|
| 261 | +154 | 3x |
- dplyr::across(+ as.character(AVISIT) == as.character(LAST_VISIT) ~ "Y", |
|
| 262 | +155 | 3x |
- c("ASEQ", "TTESEQ", "ADY", "ADTM", "EVNTDESC"),
+ ABLFL == "Y" ~ "Y", |
|
| 263 | +156 | 3x |
- ~NA+ TRUE ~ "" |
|
| 264 | +157 |
- )+ ) |
||
| 265 | +158 |
- )+ ) %>% |
||
| 266 | -+ | |||
| 159 | +3x |
- )+ dplyr::select(-"LAST_VISIT") |
||
| 267 | +160 |
- ) %>%+ # Adding variables that are in ADTR osprey but not RCD. |
||
| 268 | +161 | 3x |
- dplyr::arrange(+ adtr <- adtr %>% |
|
| 269 | +162 | 3x |
- STUDYID,+ dplyr::mutate( |
|
| 270 | +163 | 3x |
- USUBJID,+ DCSREAS_GRP = ifelse(DCSREAS == "ADVERSE EVENT", "Safety", "Non-Safety"), |
|
| 271 | +164 | 3x |
- PARAMCD,+ TRTDURD = ifelse( |
|
| 272 | +165 | 3x |
- ADTM,+ is.na(TRTSDTM) | is.na(TRTEDTM), |
|
| 273 | +166 | 3x |
- TTESEQ- |
- |
| 274 | -- |
- )- |
- ||
| 275 | -- |
-
+ NA, |
||
| 276 | +167 | 3x |
- mod_after_adtte <- adtte+ TRTEDTM - (TRTSDTM + lubridate::days(1)) |
|
| 277 | +168 |
-
+ ), |
||
| 278 | +169 | 3x |
- if (length(na_vars) > 0 && na_percentage > 0) {
- |
- |
| 279 | -! | -
- adtte <- mutate_na(ds = adtte, na_vars = na_vars, na_percentage = na_percentage)+ AGEGR1 = ifelse(AGE < 65, "<65", ">=65") |
||
| 280 | +170 |
- }+ ) |
||
| 281 | +171 | |||
| 282 | +172 |
# apply metadata |
||
| 283 | +173 | 3x |
- adtte <- apply_metadata(adtte, "metadata/ADTTE.yml")- |
- |
| 284 | -- |
-
+ adtr <- apply_metadata(adtr, "metadata/ADTR.yml") |
||
| 285 | +174 | 3x |
- return(adtte)+ return(adtr) |
|
| 286 | +175 |
}@@ -33404,14 +32599,14 @@ random.cdisc.data coverage - 98.86% |
| 1 |
- #' Hy's Law Analysis Dataset (ADHY)+ #' Protocol Deviations Analysis Dataset (ADDV) |
||
| 5 |
- #' Function for generating a random Hy's Law Analysis Dataset for a given+ #' Function for generating random Protocol Deviations Analysis Dataset for a given |
||
| 8 |
- #' @details One record per subject per parameter per analysis visit per analysis date.+ #' @details One record per each record in the corresponding SDTM domain. |
||
| 10 |
- #' Keys: `STUDYID`, `USUBJID`, `PARAMCD`, `AVISITN`, `ADTM`, `SRCSEQ`+ #' Keys: `STUDYID`, `USUBJID`, `ASTDT`, `DVTERM`, `DVSEQ` |
||
| 11 |
- #+ #' |
||
| 13 |
- #' @template param_cached+ #' @param max_n_dv (`integer`)\cr Maximum number of deviations per patient. Defaults to 3. |
||
| 14 |
- #' @templateVar data adhy+ #' @param p_dv (`proportion`)\cr Probability of a patient having protocol deviations. |
||
| 15 |
- #'+ #' @template param_cached |
||
| 16 |
- #' @return `data.frame`+ #' @templateVar data addv |
||
| 17 |
- #' @export+ #' |
||
| 18 |
- #'+ #' @return `data.frame` |
||
| 19 |
- #' @author wojciakw+ #' @export |
||
| 24 |
- #' adhy <- radhy(adsl, seed = 2)+ #' addv <- raddv(adsl, seed = 2) |
||
| 25 |
- #' adhy+ #' addv |
||
| 26 |
- radhy <- function(adsl,+ raddv <- function(adsl, |
||
| 27 |
- param = c(+ max_n_dv = 3L, |
||
| 28 |
- "TBILI <= 2 times ULN and ALT value category",+ p_dv = 0.15, |
||
| 29 |
- "TBILI > 2 times ULN and AST value category",+ lookup = NULL, |
||
| 30 |
- "TBILI > 2 times ULN and ALT value category",+ seed = NULL, |
||
| 31 |
- "TBILI <= 2 times ULN and AST value category",+ na_percentage = 0, |
||
| 32 |
- "TBILI > 2 times ULN and ALKPH <= 2 times ULN and ALT value category",+ na_vars = list( |
||
| 33 |
- "TBILI > 2 times ULN and ALKPH <= 2 times ULN and AST value category",+ "ASTDT" = c(seed = 1234, percentage = 0.1), |
||
| 34 |
- "TBILI > 2 times ULN and ALKPH <= 5 times ULN and ALT value category",+ "DVCAT" = c(seed = 1234, percentage = 0.1) |
||
| 35 |
- "TBILI > 2 times ULN and ALKPH <= 5 times ULN and AST value category",+ ), |
||
| 36 |
- "TBILI <= 2 times ULN and two consecutive elevations of ALT in relation to ULN",+ cached = FALSE) {
|
||
| 37 | -+ | 4x |
- "TBILI > 2 times ULN and two consecutive elevations of AST in relation to ULN",+ checkmate::assert_flag(cached) |
| 38 | -+ | 4x |
- "TBILI <= 2 times ULN and two consecutive elevations of AST in relation to ULN",+ if (cached) {
|
| 39 | -+ | 1x |
- "TBILI > 2 times ULN and two consecutive elevations of ALT in relation to ULN",+ return(get_cached_data("caddv"))
|
| 40 |
- "TBILI > 2 times ULN and two consecutive elevations of ALT in relation to Baseline",+ } |
||
| 41 |
- "TBILI <= 2 times ULN and two consecutive elevations of ALT in relation to Baseline",+ |
||
| 42 | -+ | 3x |
- "TBILI > 2 times ULN and two consecutive elevations of AST in relation to Baseline",+ checkmate::assert_data_frame(adsl) |
| 43 | -+ | 3x |
- "TBILI <= 2 times ULN and two consecutive elevations of AST in relation to Baseline",+ checkmate::assert_integer(max_n_dv, len = 1, lower = 1, any.missing = FALSE) |
| 44 | -+ | 3x |
- "ALT > 3 times ULN by Period",+ checkmate::assert_number(p_dv, lower = .Machine$double.xmin, upper = 1) |
| 45 | -+ | 3x |
- "AST > 3 times ULN by Period",+ checkmate::assert_number(seed, null.ok = TRUE) |
| 46 | -+ | 3x |
- "ALT or AST > 3 times ULN by Period",+ checkmate::assert_number(na_percentage, lower = 0, upper = 1) |
| 47 | -+ | 3x |
- "ALT > 3 times Baseline by Period",+ checkmate::assert_true(na_percentage < 1) |
| 48 |
- "AST > 3 times Baseline by Period",+ |
||
| 49 | -+ | 3x |
- "ALT or AST > 3 times Baseline by Period"+ if (!is.null(seed)) set.seed(seed) |
| 50 | -+ | 3x |
- ),+ study_duration_secs <- lubridate::seconds(attr(adsl, "study_duration_secs")) |
| 51 |
- paramcd = c(+ |
||
| 52 | -+ | 3x |
- "BLAL",+ checkmate::assert_data_frame(lookup, null.ok = TRUE) |
| 53 | -+ | 3x |
- "BGAS",+ lookup_dv <- if (!is.null(lookup)) {
|
| 54 | -+ | ! |
- "BGAL",+ lookup |
| 55 |
- "BLAS",+ } else {
|
||
| 56 | -+ | 3x |
- "BA2AL",+ tibble::tribble( |
| 57 | -+ | 3x |
- "BA2AS",+ ~DOMAIN, ~DVCAT, ~DVDECOD, ~DVTERM, ~DVREAS, ~DVEPRELI, |
| 58 | -+ | 3x |
- "BA5AL",+ "DV", "MAJOR", "EXCLUSION CRITERIA", "Received prior prohibited therapy or medication", "", "N", |
| 59 | -+ | 3x |
- "BA5AS",+ "DV", "MAJOR", "EXCLUSION CRITERIA", "Active or untreated or other excluded cns metastases", "", "N", |
| 60 | -+ | 3x |
- "BL2AL2CU",+ "DV", "MAJOR", "EXCLUSION CRITERIA", "History of other malignancies within the last 5 years", "", "N", |
| 61 | -+ | 3x |
- "BG2AS2CU",+ "DV", "MAJOR", "EXCLUSION CRITERIA", "Uncontrolled concurrent condition", "", "N", |
| 62 | -+ | 3x |
- "BL2AS2CU",+ "DV", "MAJOR", "EXCLUSION CRITERIA", "Other exclusion criteria", "", "N", |
| 63 | -+ | 3x |
- "BG2AL2CU",+ "DV", "MAJOR", "EXCLUSION CRITERIA", "Pregnancy criteria", "", "N", |
| 64 | -+ | 3x |
- "BG2AL2CB",+ "DV", "MAJOR", "INCLUSION CRITERIA", "Does not meet prior therapy requirements", "", "N", |
| 65 | -+ | 3x |
- "BL2AL2CB",+ "DV", "MAJOR", "INCLUSION CRITERIA", "Inclusion lab values outside allowed limits", "", "N", |
| 66 | -+ | 3x |
- "BG2AS2CB",+ "DV", "MAJOR", "INCLUSION CRITERIA", "No signed ICF at study entry", "", "N", |
| 67 | -+ | 3x |
- "BL2AS2CB",+ "DV", "MAJOR", "INCLUSION CRITERIA", "Inclusion-related test not done/out of window", "", "N", |
| 68 | -+ | 3x |
- "ALTPULN",+ "DV", "MAJOR", "INCLUSION CRITERIA", "Ineligible cancer type or current cancer stage", "", "N", |
| 69 | -+ | 3x |
- "ASTPULN",+ "DV", "MAJOR", "MEDICATION", "Dose missed or significantly out of window", |
| 70 | -+ | 3x |
- "ALTASTPU",+ "Site action due to epidemic/pandemic", "Y", |
| 71 | -+ | 3x |
- "ALTPBASE",+ "DV", "MAJOR", "MEDICATION", "Received incorrect study medication", "", "N", |
| 72 | -+ | 3x |
- "ASTPBASE",+ "DV", "MAJOR", "MEDICATION", "Received prohibited concomitant medication", "", "N", |
| 73 | -+ | 3x |
- "ALTASTPB"+ "DV", "MAJOR", "MEDICATION", "Discontinued study drug for unspecified reason", "", "N", |
| 74 | -+ | 3x |
- ),+ "DV", "MAJOR", "MEDICATION", "Significant deviation from planned dose", |
| 75 | -+ | 3x |
- seed = NULL,+ "Site action due to epidemic/pandemic", "Y", |
| 76 | -+ | 3x |
- cached = FALSE) {
+ "DV", "MAJOR", "PROCEDURAL", "Missed assessment affecting safety/study outcomes", "", "N", |
| 77 | -4x | +3x |
- checkmate::assert_flag(cached)+ "DV", "MAJOR", "PROCEDURAL", "Eligibility-related test not done/out of window", "", "N", |
| 78 | -+ | 3x |
-
+ "DV", "MAJOR", "PROCEDURAL", "Failure to sign updated ICF within two visits", |
| 79 | -4x | +3x |
- if (cached) {
+ "Site action due to epidemic/pandemic", "Y", |
| 80 | -1x | +3x |
- return(get_cached_data("cadhy"))
+ "DV", "MAJOR", "PROCEDURAL", "Omission of complete lab panel required by protocol", "", "N", |
| 81 | -+ | 3x |
- }+ "DV", "MAJOR", "PROCEDURAL", "Omission of screening tumor assessment", "", "N", |
| 82 | -+ | 3x |
-
+ "DV", "MAJOR", "PROCEDURAL", "Missed 2 or more efficacy assessments", |
| 83 | 3x |
- checkmate::assert_data_frame(adsl)+ "Site action due to epidemic/pandemic", "Y" |
|
| 84 | -3x | +
- checkmate::assert_character(param, min.len = 1, any.missing = FALSE)+ ) |
|
| 85 | -3x | +
- checkmate::assert_character(paramcd, min.len = 1, any.missing = FALSE)+ } |
|
| 86 | -3x | +
- checkmate::assert_number(seed, null.ok = TRUE)+ |
|
| 88 | -+ | 3x |
- # validate and initialize related variables+ addv <- Map( |
| 89 | 3x |
- param_init_list <- relvar_init(param, paramcd)+ function(id, sid) {
|
|
| 90 | -+ | 30x |
-
+ n_dv <- stats::rbinom(1, 1, p_dv) * sample(c(1, seq_len(max_n_dv)), 1) |
| 91 | -3x | +30x |
- if (!is.null(seed)) {
+ i <- sample(seq_len(nrow(lookup_dv)), n_dv, TRUE) |
| 92 | -3x | +30x |
- set.seed(seed)+ dplyr::mutate( |
| 93 | -+ | 30x |
- }+ lookup_dv[i, ], |
| 94 | -3x | +30x |
- study_duration_secs <- lubridate::seconds(attr(adsl, "study_duration_secs"))+ USUBJID = id, |
| 95 | -+ | 30x |
-
+ STUDYID = sid |
| 96 |
- # create all combinations of unique values in STUDYID, USUBJID, PARAM, AVISIT+ ) |
||
| 97 | -3x | +
- adhy <- expand.grid(+ }, |
|
| 98 | 3x |
- STUDYID = unique(adsl$STUDYID),+ adsl$USUBJID, |
|
| 99 | 3x |
- USUBJID = adsl$USUBJID,+ adsl$STUDYID |
|
| 100 | -3x | +
- PARAM = as.factor(param_init_list$relvar1),+ ) %>% |
|
| 101 | 3x |
- AVISIT = as.factor(c("BASELINE", "POST-BASELINE")),
+ Reduce(rbind, .) %>% |
|
| 102 | 3x |
- APERIODC = as.factor(c("PERIOD 1", "PERIOD 2")),
+ dplyr::mutate(DVSCAT = DVCAT) |
|
| 103 | -3x | +
- stringsAsFactors = FALSE+ |
|
| 104 | -+ | 3x |
- )+ addv <- var_relabel( |
| 105 | -+ | 3x |
-
+ addv, |
| 106 | -+ | 3x |
- # remove records that are not needed and were created as a side product of expand.grid above+ STUDYID = "Study Identifier", |
| 107 | 3x |
- adhy <- dplyr::filter(adhy, !(AVISIT == "BASELINE" & APERIODC == "PERIOD 2"))+ USUBJID = "Unique Subject Identifier" |
|
| 108 |
-
+ ) |
||
| 109 |
- # define TBILI ALT/AST params, period dependent parameters and the parameters that will be assigned values "Y" or "N"+ |
||
| 110 | -3x | +
- paramcd_tbilialtast <- c("BLAL", "BGAS", "BGAL", "BLAS", "BA2AL", "BA2AS", "BA5AL", "BA5AS")
+ # merge ADSL to be able to add deviation date and study day variables |
|
| 111 | 3x |
- paramcd_by_period <- c("ALTPULN", "ASTPULN", "ALTASTPU", "ALTPBASE", "ASTPBASE", "ALTASTPB")
+ addv <- dplyr::inner_join(addv, adsl, by = c("STUDYID", "USUBJID")) %>%
|
|
| 112 | 3x |
- paramcd_yn <- c(+ dplyr::rowwise() %>% |
|
| 113 | 3x |
- "BL2AL2CU", "BG2AS2CU", "BL2AS2CU", "BG2AL2CU", "BG2AL2CB", "BL2AL2CB", "BG2AS2CB", "BL2AS2CB",+ dplyr::mutate(TRTENDT = lubridate::date(dplyr::case_when( |
|
| 114 | 3x |
- paramcd_by_period+ is.na(TRTEDTM) ~ lubridate::floor_date(lubridate::date(TRTSDTM) + study_duration_secs, unit = "day"), |
|
| 115 | -+ | 3x |
- )+ TRUE ~ TRTEDTM |
| 116 |
-
+ ))) %>% |
||
| 117 | -+ | 3x |
- # add other variables to adhy+ dplyr::mutate(ASTDTM = sample( |
| 118 | 3x |
- adhy <- adhy %>%+ seq(lubridate::as_datetime(TRTSDTM), lubridate::as_datetime(TRTENDT), by = "day"), |
|
| 119 | 3x |
- rel_var(+ size = 1 |
|
| 120 | -3x | +
- var_name = "PARAMCD",+ )) %>% |
|
| 121 | 3x |
- related_var = "PARAM",+ dplyr::mutate(ASTDT = lubridate::date(ASTDTM)) %>% |
|
| 122 | 3x |
- var_values = param_init_list$relvar2+ dplyr::mutate(ASTDY = ceiling(difftime(ASTDTM, TRTSDTM, units = "days"))) %>% |
|
| 123 | -+ | 3x |
- ) %>%+ dplyr::select(-TRTENDT, -ASTDTM) %>% |
| 124 | 3x |
- dplyr::mutate(+ dplyr::ungroup() %>% |
|
| 125 | 3x |
- AVALC = dplyr::case_when(+ dplyr::arrange(STUDYID, USUBJID, ASTDT, DVTERM) |
|
| 126 | -3x | +
- PARAMCD %in% paramcd_tbilialtast ~ sample(+ |
|
| 127 | 3x |
- x = c(">3-5ULN", ">5-10ULN", ">10-20ULN", ">20ULN", "Criteria not met"), size = dplyr::n(), replace = TRUE
+ addv <- addv %>% |
|
| 128 | -+ | 3x |
- ),+ dplyr::group_by(USUBJID) %>% |
| 129 | 3x |
- PARAMCD %in% paramcd_yn ~ sample(+ dplyr::mutate(DVSEQ = seq_len(dplyr::n())) %>% |
|
| 130 | 3x |
- x = c("Y", "N"), prob = c(0.1, 0.9), size = dplyr::n(), replace = TRUE
+ dplyr::ungroup() %>% |
|
| 131 | -+ | 3x |
- )+ dplyr::arrange(STUDYID, USUBJID, ASTDT, DVTERM, DVSEQ) |
| 132 |
- ),+ |
||
| 133 | 3x |
- AVAL = dplyr::case_when(+ addv <- addv %>% |
|
| 134 | 3x |
- AVALC == ">3-5ULN" ~ 1,+ dplyr::mutate(AEPRELFL = ifelse(DVEPRELI == "Y", DVEPRELI, "")) |
|
| 135 | -3x | +
- AVALC == ">5-10ULN" ~ 2,+ |
|
| 136 | 3x |
- AVALC == ">10-20ULN" ~ 3,+ if (length(na_vars) > 0 && na_percentage > 0) {
|
|
| 137 | -3x | +! |
- AVALC == ">20ULN" ~ 4,+ addv <- mutate_na(ds = addv, na_vars = na_vars, na_percentage = na_percentage) |
| 138 | -3x | +
- AVALC == "Y" ~ 1,+ } |
|
| 139 | -3x | +
- AVALC == "N" ~ 0,+ |
|
| 140 | -3x | +
- AVALC == "Criteria not met" ~ 0+ # apply metadata |
|
| 141 | -+ | 3x |
- ),+ addv <- apply_metadata(addv, "metadata/ADDV.yml") |
| 142 | -3x | +
- AVISITN = dplyr::case_when(+ |
|
| 143 | 3x |
- AVISIT == "BASELINE" ~ 0L,+ return(addv) |
|
| 144 | -3x | +
- AVISIT == "POST-BASELINE" ~ 9995L,+ } |
|
| 145 | -3x | +
| 1 | +
- TRUE ~ NA_integer_+ #' Time-to-Event Analysis Dataset (ADTTE) |
|||
| 146 | +2 |
- ),+ #' |
||
| 147 | -3x | +|||
| 3 | +
- APERIOD = dplyr::case_when(+ #' @description `r lifecycle::badge("stable")`
|
|||
| 148 | -3x | +|||
| 4 | +
- APERIODC == "PERIOD 1" ~ 1L,+ #' |
|||
| 149 | -3x | +|||
| 5 | +
- APERIODC == "PERIOD 2" ~ 2L,+ #' Function for generating a random Time-to-Event Analysis Dataset for a given |
|||
| 150 | -3x | +|||
| 6 | +
- TRUE ~ NA_integer_+ #' Subject-Level Analysis Dataset. |
|||
| 151 | +7 |
- ),- |
- ||
| 152 | -3x | -
- ABLFL = dplyr::if_else(AVISIT == "BASELINE", "Y", NA_character_),- |
- ||
| 153 | -3x | -
- ONTRTFL = dplyr::if_else(AVISIT == "POST-BASELINE", "Y", NA_character_),- |
- ||
| 154 | -3x | -
- ANL01FL = "Y",- |
- ||
| 155 | -3x | -
- SRCSEQ = NA_integer_+ #' |
||
| 156 | +8 |
- )+ #' @details |
||
| 157 | +9 |
-
+ #' |
||
| 158 | +10 |
- # remove records for parameters with period 2 and not in paramcd_by_period- |
- ||
| 159 | -3x | -
- adhy <- dplyr::filter(adhy, PARAMCD %in% paramcd_by_period | APERIODC == "PERIOD 1")+ #' Keys: `STUDYID`, `USUBJID`, `PARAMCD` |
||
| 160 | +11 |
-
+ #' |
||
| 161 | +12 |
- # add baseline variables+ #' @inheritParams argument_convention |
||
| 162 | -3x | +|||
| 13 | +
- adhy <- adhy %>%+ #' @inheritParams radaette |
|||
| 163 | -3x | +|||
| 14 | +
- dplyr::group_by(USUBJID, PARAMCD) %>%+ #' @template param_cached |
|||
| 164 | -3x | +|||
| 15 | +
- dplyr::mutate(+ #' @templateVar data adtte |
|||
| 165 | -3x | +|||
| 16 | +
- BASEC = AVALC[AVISIT == "BASELINE"],+ #' |
|||
| 166 | -3x | +|||
| 17 | +
- BASE = AVAL[AVISIT == "BASELINE"]+ #' @return `data.frame` |
|||
| 167 | +18 |
- ) %>%+ #' @export |
||
| 168 | -3x | +|||
| 19 | +
- dplyr::ungroup()+ #' |
|||
| 169 | +20 |
-
+ #' @examples |
||
| 170 | -3x | +|||
| 21 | +
- adhy <- adhy %>%+ #' adsl <- radsl(N = 10, seed = 1, study_duration = 2) |
|||
| 171 | -3x | +|||
| 22 | +
- var_relabel(+ #' |
|||
| 172 | -3x | +|||
| 23 | +
- STUDYID = attr(adsl$STUDYID, "label"),+ #' adtte <- radtte(adsl, seed = 2) |
|||
| 173 | -3x | +|||
| 24 | +
- USUBJID = attr(adsl$USUBJID, "label")+ #' adtte |
|||
| 174 | +25 |
- )+ radtte <- function(adsl, |
||
| 175 | +26 |
-
+ event_descr = NULL, |
||
| 176 | +27 |
- # merge ADSL to be able to add analysis datetime and analysis relative day variables+ censor_descr = NULL, |
||
| 177 | -3x | +|||
| 28 | +
- adhy <- dplyr::inner_join(adhy, adsl, by = c("STUDYID", "USUBJID"))
+ lookup = NULL, |
|||
| 178 | +29 |
-
+ seed = NULL, |
||
| 179 | +30 |
- # define a simple helper function to create ADY variable+ na_percentage = 0, |
||
| 180 | -3x | +|||
| 31 | +
- add_ady <- function(x, avisit) {
+ na_vars = list(CNSR = c(NA, 0.1), AVAL = c(1234, 0.1), AVALU = c(1234, 0.1)), |
|||
| 181 | -6x | +|||
| 32 | +
- if (avisit == "BASELINE") {
+ cached = FALSE) {
|
|||
| 182 | -3x | +33 | +4x |
- dplyr::mutate(+ checkmate::assert_flag(cached) |
| 183 | -3x | +34 | +4x |
- x,+ if (cached) {
|
| 184 | -3x | +35 | +1x |
- ADY = sample(x = -(1:14), size = dplyr::n(), replace = TRUE)+ return(get_cached_data("cadtte"))
|
| 185 | +36 |
- )+ } |
||
| 186 | -3x | +|||
| 37 | +
- } else if (avisit == "POST-BASELINE") {
+
|
|||
| 187 | +38 | 3x |
- dplyr::rowwise(x) %>%+ checkmate::assert_data_frame(adsl) |
|
| 188 | +39 | 3x |
- dplyr::mutate(ADY = as.integer(sample(+ checkmate::assert_character(censor_descr, null.ok = TRUE, min.len = 1, any.missing = FALSE) |
|
| 189 | +40 | 3x |
- dplyr::if_else(+ checkmate::assert_character(event_descr, null.ok = TRUE, min.len = 1, any.missing = FALSE) |
|
| 190 | +41 | 3x |
- !is.na(TRTEDTM),+ checkmate::assert_number(seed, null.ok = TRUE) |
|
| 191 | +42 | 3x |
- as.numeric(difftime(TRTEDTM, TRTSDTM, units = "days")),+ checkmate::assert_number(na_percentage, lower = 0, upper = 1) |
|
| 192 | +43 | 3x |
- as.numeric(study_duration_secs, "days")+ checkmate::assert_true(na_percentage < 1) |
|
| 193 | +44 |
- ),+ |
||
| 194 | +45 | 3x |
- size = 1,+ if (!is.null(seed)) {
|
|
| 195 | +46 | 3x |
- replace = TRUE+ set.seed(seed) |
|
| 196 | +47 |
- )))+ } |
||
| 197 | -+ | |||
| 48 | +3x |
- } else {
+ study_duration_secs <- lubridate::seconds(attr(adsl, "study_duration_secs")) |
||
| 198 | -! | +|||
| 49 | +
- dplyr::mutate(x, ADY = NA_integer_)+ |
|||
| 199 | -+ | |||
| 50 | +3x |
- }+ checkmate::assert_data_frame(lookup, null.ok = TRUE) |
||
| 200 | -+ | |||
| 51 | +3x |
- }+ lookup_tte <- if (!is.null(lookup)) {
|
||
| 201 | -+ | |||
| 52 | +! |
-
+ lookup |
||
| 202 | +53 |
- # add ADY and ADTM variables+ } else {
|
||
| 203 | +54 | 3x |
- adhy <- adhy %>%+ tibble::tribble( |
|
| 204 | +55 | 3x |
- dplyr::group_by(AVISIT, .add = FALSE) %>%+ ~ARM, ~PARAMCD, ~PARAM, ~LAMBDA, ~CNSR_P, |
|
| 205 | +56 | 3x |
- dplyr::group_modify(~ add_ady(.x, .y$AVISIT)) %>%+ "ARM A", "EFS", "Event Free Survival", log(2) / 365, 0.4, |
|
| 206 | +57 | 3x |
- dplyr::ungroup() %>%+ "ARM B", "EFS", "Event Free Survival", log(2) / 305, 0.3, |
|
| 207 | +58 | 3x |
- dplyr::mutate(ADTM = TRTSDTM + lubridate::days(ADY))+ "ARM C", "EFS", "Event Free Survival", log(2) / 243, 0.2, |
|
| 208 | -+ | |||
| 59 | +3x |
-
+ "ARM A", "CRSD", "Duration of Confirmed Response", log(2) / 305, 0.4, |
||
| 209 | -+ | |||
| 60 | +3x |
- # order columns and arrange rows; column order follows ADaM_1.1 specification+ "ARM B", "CRSD", "Duration of Confirmed Response", log(2) / 243, 0.3, |
||
| 210 | +61 | 3x |
- adhy <-+ "ARM C", "CRSD", "Duration of Confirmed Response", log(2) / 182, 0.2, |
|
| 211 | +62 | 3x |
- adhy[, c(+ "ARM A", "PFS", "Progression Free Survival", log(2) / 365, 0.4, |
|
| 212 | +63 | 3x |
- colnames(adsl),+ "ARM B", "PFS", "Progression Free Survival", log(2) / 305, 0.3, |
|
| 213 | +64 | 3x |
- "PARAM",+ "ARM C", "PFS", "Progression Free Survival", log(2) / 243, 0.2, |
|
| 214 | +65 | 3x |
- "PARAMCD",+ "ARM A", "OS", "Overall Survival", log(2) / 610, 0.4, |
|
| 215 | +66 | 3x |
- "AVAL",+ "ARM B", "OS", "Overall Survival", log(2) / 490, 0.3, |
|
| 216 | +67 | 3x |
- "AVALC",+ "ARM C", "OS", "Overall Survival", log(2) / 365, 0.2, |
|
| 217 | -3x | +|||
| 68 | +
- "BASE",+ ) |
|||
| 218 | -3x | +|||
| 69 | +
- "BASEC",+ } |
|||
| 219 | -3x | +|||
| 70 | +
- "ABLFL",+ |
|||
| 220 | +71 | 3x |
- "ADTM",+ evntdescr_sel <- if (!is.null(event_descr)) {
|
|
| 221 | -3x | +|||
| 72 | +! |
- "ADY",+ event_descr |
||
| 222 | -3x | +|||
| 73 | +
- "AVISIT",+ } else {
|
|||
| 223 | +74 | 3x |
- "AVISITN",+ c( |
|
| 224 | +75 | 3x |
- "APERIOD",+ "Death", |
|
| 225 | +76 | 3x |
- "APERIODC",+ "Disease Progression", |
|
| 226 | +77 | 3x |
- "ONTRTFL",+ "Last Tumor Assessment", |
|
| 227 | +78 | 3x |
- "SRCSEQ",+ "Adverse Event", |
|
| 228 | +79 | 3x |
- "ANL01FL"+ "Alive" |
|
| 229 | +80 |
- )]+ ) |
||
| 230 | +81 | ++ |
+ }+ |
+ |
| 82 | ||||
| 231 | +83 | 3x |
- adhy <- adhy %>%+ cnsdtdscr_sel <- if (!is.null(censor_descr)) {
|
|
| 232 | -3x | +|||
| 84 | +! |
- dplyr::arrange(+ censor_descr |
||
| 233 | -3x | +|||
| 85 | +
- STUDYID,+ } else {
|
|||
| 234 | +86 | 3x |
- USUBJID,+ c( |
|
| 235 | +87 | 3x |
- PARAMCD,+ "Preferred Term", |
|
| 236 | +88 | 3x |
- AVISITN,+ "Clinical Cut Off", |
|
| 237 | +89 | 3x |
- ADTM,+ "Completion or Discontinuation", |
|
| 238 | +90 | 3x |
- SRCSEQ+ "End of AE Reporting Period" |
|
| 239 | +91 |
) |
||
| 240 | +92 |
-
+ } |
||
| 241 | +93 |
- # apply metadata+ |
||
| 242 | +94 | 3x |
- adhy <- apply_metadata(adhy, "metadata/ADHY.yml")- |
- |
| 243 | -- |
-
+ adtte <- split(adsl, adsl$USUBJID) %>% |
||
| 244 | +95 | 3x |
- return(adhy)+ lapply(FUN = function(pinfo) {
|
|
| 245 | -- |
- }- |
-
| 1 | -+ | |||
| 96 | +30x |
- #' Questionnaires Analysis Dataset (ADQS)+ lookup_tte %>% |
||
| 2 | -+ | |||
| 97 | +30x |
- #'+ dplyr::filter(ARM == as.character(pinfo$ACTARMCD)) %>% |
||
| 3 | -+ | |||
| 98 | +30x |
- #' @description `r lifecycle::badge("stable")`
+ dplyr::rowwise() %>% |
||
| 4 | -+ | |||
| 99 | +30x |
- #'+ dplyr::mutate( |
||
| 5 | -+ | |||
| 100 | +30x |
- #' Function for generating a random Questionnaires Analysis Dataset for a given+ STUDYID = pinfo$STUDYID, |
||
| 6 | -+ | |||
| 101 | +30x |
- #' Subject-Level Analysis Dataset.+ SITEID = pinfo$SITEID, |
||
| 7 | -+ | |||
| 102 | +30x |
- #'+ USUBJID = pinfo$USUBJID, |
||
| 8 | -+ | |||
| 103 | +30x |
- #' @details One record per subject per parameter per analysis visit per analysis date.+ AVALU = "DAYS" |
||
| 9 | +104 |
- #'+ ) %>% |
||
| 10 | -+ | |||
| 105 | +30x |
- #' Keys: `STUDYID`, `USUBJID`, `PARAMCD`, `AVISITN`+ dplyr::select(-"LAMBDA", -"CNSR_P") |
||
| 11 | +106 |
- #'+ }) %>% |
||
| 12 | -+ | |||
| 107 | +3x |
- #' @inheritParams argument_convention+ Reduce(rbind, .) %>% |
||
| 13 | -+ | |||
| 108 | +3x |
- #' @template param_cached+ var_relabel( |
||
| 14 | -+ | |||
| 109 | +3x |
- #' @templateVar data adqs+ STUDYID = "Study Identifier", |
||
| 15 | -+ | |||
| 110 | +3x |
- #'+ USUBJID = "Unique Subject Identifier" # ) |
||
| 16 | +111 |
- #' @return `data.frame`+ ) |
||
| 17 | +112 |
- #' @export+ |
||
| 18 | +113 |
- #'+ # Loop through each patient and randomly assign a value for EVNTDESC |
||
| 19 | -+ | |||
| 114 | +3x |
- #' @author npaszty+ adtte_split <- split(adtte, adtte$USUBJID) |
||
| 20 | +115 |
- #'+ |
||
| 21 | +116 |
- #' @examples+ # Add EVNTDESC column |
||
| 22 | -+ | |||
| 117 | +3x |
- #' adsl <- radsl(N = 10, seed = 1, study_duration = 2)+ adtte_lst <- lapply(adtte_split, function(split_df) {
|
||
| 23 | +118 |
- #'+ # First create an empty EVNTDESC variable to populate |
||
| 24 | -+ | |||
| 119 | +30x |
- #' adqs <- radqs(adsl, visit_format = "WEEK", n_assessments = 7L, seed = 2)+ split_df$EVNTDESC <- NA |
||
| 25 | -+ | |||
| 120 | +30x |
- #' adqs+ for (i in 1:nrow(split_df)) { # nolint
|
||
| 26 | +121 |
- #'+ # If this is the first row then create a random value from evntdescr_sel for EVNTDESC |
||
| 27 | -+ | |||
| 122 | +120x |
- #' adqs <- radqs(adsl, visit_format = "CYCLE", n_assessments = 3L, seed = 2)+ if (i == 1) {
|
||
| 28 | -+ | |||
| 123 | +30x |
- #' adqs+ split_df$EVNTDESC[i] <- sample(evntdescr_sel[c(1:4)], 1, prob = c(0.1, 0.3, 0.4, 0.2)) |
||
| 29 | -+ | |||
| 124 | +90x |
- radqs <- function(adsl,+ } else if (i != 1 & i != nrow(split_df)) {
|
||
| 30 | +125 |
- param = c(+ # First check to see if "Death" has been entered in as a previous value |
||
| 31 | +126 |
- "BFI All Questions",+ # If so we need to make the rest of the EVNTDESC values "Death" to make sense |
||
| 32 | +127 |
- "Fatigue Interference",+ # The patient cannot die and then come back to life |
||
| 33 | -+ | |||
| 128 | +60x |
- "Function/Well-Being (GF1,GF3,GF7)",+ if (any(grepl("Death", split_df$EVNTDESC))) { # If previous value has "Death" the following need to be "Death"
|
||
| 34 | -+ | |||
| 129 | +21x |
- "Treatment Side Effects (GP2,C5,GP5)",+ split_df$EVNTDESC[i] <- "Death" |
||
| 35 | -+ | |||
| 130 | +3x |
- "FKSI-19 All Questions"+ } else { # If there are no "Death" values randomly select another value
|
||
| 36 | -+ | |||
| 131 | +39x |
- ),+ split_df$EVNTDESC[i] <- sample(evntdescr_sel[c(1:4)], 1) |
||
| 37 | +132 |
- paramcd = c("BFIALL", "FATIGI", "FKSI-FWB", "FKSI-TSE", "FKSIALL"),
+ } |
||
| 38 | -+ | |||
| 133 | +3x |
- visit_format = "WEEK",+ } else { # This is for processing OS as this can only be "Death" or "Alive"
|
||
| 39 | -+ | |||
| 134 | +30x |
- n_assessments = 5L,+ if (any(grepl("Death", split_df$EVNTDESC))) { # If previous value has "Death" the following need to be "Death"
|
||
| 40 | -+ | |||
| 135 | +21x |
- n_days = 5L,+ split_df$EVNTDESC[i] <- "Death" |
||
| 41 | -+ | |||
| 136 | +3x |
- seed = NULL,+ } else { # If there are no "Death" values randomly select another value
|
||
| 42 | -+ | |||
| 137 | +9x |
- na_percentage = 0,+ split_df$EVNTDESC[i] <- "Alive" |
||
| 43 | +138 |
- na_vars = list(+ } |
||
| 44 | +139 |
- LOQFL = c(NA, 0.1), ABLFL2 = c(1234, 0.1), ABLFL = c(1235, 0.1),+ } |
||
| 45 | +140 |
- CHG2 = c(1235, 0.1), PCHG2 = c(1235, 0.1), CHG = c(1234, 0.1), PCHG = c(1234, 0.1)+ } |
||
| 46 | -+ | |||
| 141 | +30x |
- ),+ split_df |
||
| 47 | +142 |
- cached = FALSE) {
- |
- ||
| 48 | -4x | -
- checkmate::assert_flag(cached)- |
- ||
| 49 | -4x | -
- if (cached) {
- |
- ||
| 50 | -1x | -
- return(get_cached_data("cadqs"))
+ }) |
||
| 51 | +143 |
- }+ |
||
| 52 | +144 |
-
+ # Add CNSR column |
||
| 53 | +145 | 3x |
- checkmate::assert_data_frame(adsl)+ adtte_lst <- lapply(adtte_lst, function(split_df) {
|
|
| 54 | -3x | +|||
| 146 | +
- checkmate::assert_character(param, min.len = 1, any.missing = FALSE)+ # First create an empty CNSR variable to populate |
|||
| 55 | -3x | +147 | +30x |
- checkmate::assert_character(paramcd, min.len = 1, any.missing = FALSE)+ split_df$CNSR <- NA |
| 56 | -3x | +148 | +30x |
- checkmate::assert_string(visit_format)+ for (i in 1:nrow(split_df)) { # nolint
|
| 57 | -3x | +|||
| 149 | +
- checkmate::assert_integer(n_assessments, len = 1, any.missing = FALSE)+ # If this is the first row then create a random value from evntdescr_sel for EVNTDESC |
|||
| 58 | -3x | +150 | +120x |
- checkmate::assert_integer(n_days, len = 1, any.missing = FALSE)+ if (split_df$EVNTDESC[i] == "Death" | split_df$EVNTDESC[i] == "Disease Progression") {
|
| 59 | -3x | +151 | +81x |
- checkmate::assert_number(seed, null.ok = TRUE)+ split_df$CNSR[i] <- 0 |
| 60 | -3x | +|||
| 152 | +
- checkmate::assert_number(na_percentage, lower = 0, upper = 1)+ } else {
|
|||
| 61 | -3x | +153 | +39x |
- checkmate::assert_true(na_percentage < 1)+ split_df$CNSR[i] <- 1 |
| 62 | +154 |
-
+ } |
||
| 63 | +155 |
- # validate and initialize param vectors+ } |
||
| 64 | -3x | +156 | +30x |
- param_init_list <- relvar_init(param, paramcd)+ split_df |
| 65 | +157 | - - | -||
| 66 | -3x | -
- if (!is.null(seed)) {
+ }) |
||
| 67 | -3x | +|||
| 158 | +
- set.seed(seed)+ |
|||
| 68 | +159 |
- }+ # Add AVAL column |
||
| 69 | +160 | 3x |
- study_duration_secs <- lubridate::seconds(attr(adsl, "study_duration_secs"))+ adtte_lst <- lapply(adtte_lst, function(split_df) {
|
|
| 70 | +161 |
-
+ # First create an empty CNSR variable to populate |
||
| 71 | -3x | +162 | +30x |
- adqs <- expand.grid(+ split_df$AVAL <- NA |
| 72 | -3x | +163 | +30x |
- STUDYID = unique(adsl$STUDYID),+ for (i in 1:nrow(split_df)) { # nolint
|
| 73 | -3x | +164 | +120x |
- USUBJID = adsl$USUBJID,+ if (i == 1) {
|
| 74 | -3x | +165 | +30x |
- PARAM = param_init_list$relvar1,+ split_df$AVAL[i] <- stats::runif(1, 15, 100) |
| 75 | -3x | +166 | +90x |
- AVISIT = visit_schedule(visit_format = visit_format, n_assessments = n_assessments, n_days = n_days),+ } else if (i != 1 & any(grepl("Death", split_df[1:i - 1, "EVNTDESC"]))) {
|
| 76 | -3x | +|||
| 167 | +
- stringsAsFactors = FALSE+ # Check if there are any death values before the current row |
|||
| 77 | +168 |
- )+ # Set the AVAL to the value of the row that has the "Death" value |
||
| 78 | +169 |
-
+ # as the patient cannot live longer than this value |
||
| 79 | -3x | +170 | +42x |
- adqs <- dplyr::mutate(+ death_position <- match("Death", split_df[1:i - 1, "EVNTDESC"][[1]])
|
| 80 | -3x | +171 | +42x |
- adqs,+ split_df$AVAL[i] <- split_df$AVAL[death_position] |
| 81 | -3x | +172 | +48x |
- AVISITN = dplyr::case_when(+ } else if (i == 2) {
|
| 82 | -3x | +173 | +24x |
- AVISIT == "SCREENING" ~ -1,+ split_df$AVAL[i] <- stats::runif(1, 100, 200) |
| 83 | -3x | +174 | +24x |
- AVISIT == "BASELINE" ~ 0,+ } else if (i == 3) {
|
| 84 | -3x | +175 | +15x |
- (grepl("^WEEK", AVISIT) | grepl("^CYCLE", AVISIT)) ~ as.numeric(AVISIT) - 2,
+ split_df$AVAL[i] <- stats::runif(1, 200, 300) |
| 85 | -3x | -
- TRUE ~ NA_real_- |
- ||
| 86 | -+ | 176 | +9x |
- )+ } else if (i == 4) {
|
| 87 | -+ | |||
| 177 | +9x |
- )+ split_df$AVAL[i] <- stats::runif(1, 300, 500) |
||
| 88 | +178 |
-
+ } |
||
| 89 | +179 |
- # assign related variable values: PARAMxPARAMCD are related- |
- ||
| 90 | -3x | -
- adqs <- adqs %>% rel_var(- |
- ||
| 91 | -3x | -
- var_name = "PARAMCD",- |
- ||
| 92 | -3x | -
- related_var = "PARAM",+ } |
||
| 93 | -3x | -
- var_values = param_init_list$relvar2- |
- ||
| 94 | -+ | 180 | +30x |
- )+ split_df |
| 95 | +181 | - - | -||
| 96 | -3x | -
- adqs$AVAL <- stats::rnorm(nrow(adqs), mean = 50, sd = 8) + adqs$AVISITN * stats::rnorm(nrow(adqs), mean = 5, sd = 2)+ }) |
||
| 97 | +182 | |||
| 98 | +183 |
- # order to prepare for change from screening and baseline values+ # Add CNSDTDSC column |
||
| 99 | +184 | 3x |
- adqs <- adqs[order(adqs$STUDYID, adqs$USUBJID, adqs$PARAMCD, adqs$AVISITN), ]+ adtte_lst <- lapply(adtte_lst, function(split_df) {
|
|
| 100 | +185 |
-
+ # First create an empty CNSDTDSC variable to populate |
||
| 101 | -3x | +186 | +30x |
- adqs <- Reduce(+ split_df$CNSDTDSC <- NA |
| 102 | -3x | +187 | +30x |
- rbind,+ for (i in 1:nrow(split_df)) { # nolint
|
| 103 | -3x | +188 | +120x |
- lapply(+ if (split_df$CNSR[i] == 1 & split_df$EVNTDESC[i] == "Last Tumor Assessment") {
|
| 104 | -3x | +189 | +27x |
- split(adqs, adqs$USUBJID),+ split_df$CNSDTDSC[i] <- "Completion or Discontinuation" |
| 105 | -3x | +190 | +93x |
- function(x) {
+ } else if (split_df$CNSR[i] == 1 & split_df$EVNTDESC[i] == "Adverse Event") {
|
| 106 | -30x | +191 | +3x |
- x$STUDYID <- adsl$STUDYID[which(adsl$USUBJID == x$USUBJID[1])]+ split_df$CNSDTDSC[i] <- "Preferred Term" |
| 107 | -30x | +192 | +90x |
- x$ABLFL2 <- ifelse(x$AVISIT == "SCREENING", "Y", "")+ } else if (split_df$CNSR[i] == 1 & split_df$EVNTDESC[i] == "Alive") {
|
| 108 | -30x | +193 | +9x |
- x$ABLFL <- ifelse(+ split_df$CNSDTDSC[i] <- "Alive During Study" |
| 109 | -30x | +|||
| 194 | +
- toupper(visit_format) == "WEEK" & x$AVISIT == "BASELINE",+ } else {
|
|||
| 110 | -30x | +195 | +81x |
- "Y",+ split_df$CNSDTDSC[i] <- "" |
| 111 | -30x | +|||
| 196 | +
- ifelse(+ } |
|||
| 112 | -30x | +|||
| 197 | +
- toupper(visit_format) == "CYCLE" & x$AVISIT == "CYCLE 1 DAY 1",+ } |
|||
| 113 | +198 | 30x |
- "Y",+ split_df |
|
| 114 | +199 |
- ""+ }) |
||
| 115 | +200 |
- )+ |
||
| 116 | +201 |
- )+ # Take the split df and combine them back together |
||
| 117 | -30x | +202 | +3x |
- x$LOQFL <- ifelse(x$AVAL < 32, "Y", "N")+ adtte <- do.call("rbind", adtte_lst)
|
| 118 | -30x | +203 | +3x |
- x+ rownames(adtte) <- NULL |
| 119 | +204 |
- }+ |
||
| 120 | -+ | |||
| 205 | +3x |
- )+ adtte <- var_relabel( |
||
| 121 | -+ | |||
| 206 | +3x |
- )+ adtte, |
||
| 122 | -+ | |||
| 207 | +3x |
-
+ STUDYID = "Study Identifier", |
||
| 123 | +208 | 3x |
- adqs$BASE2 <- retain(adqs, adqs$AVAL, adqs$ABLFL2 == "Y")+ USUBJID = "Unique Subject Identifier" |
|
| 124 | -3x | +|||
| 209 | +
- adqs$BASE <- ifelse(adqs$ABLFL2 != "Y", retain(adqs, adqs$AVAL, adqs$ABLFL == "Y"), NA)+ ) |
|||
| 125 | +210 | |||
| 126 | -3x | +|||
| 211 | +
- adqs <- adqs %>%+ # merge ADSL to be able to add TTE date and study day variables |
|||
| 127 | +212 | 3x |
- dplyr::mutate(CHG2 = AVAL - BASE2) %>%+ adtte <- dplyr::inner_join( |
|
| 128 | +213 | 3x |
- dplyr::mutate(PCHG2 = 100 * (CHG2 / BASE2)) %>%+ dplyr::select(adtte, -"SITEID", -"ARM"), |
|
| 129 | +214 | 3x |
- dplyr::mutate(CHG = AVAL - BASE) %>%+ adsl, |
|
| 130 | +215 | 3x |
- dplyr::mutate(PCHG = 100 * (CHG / BASE)) %>%+ by = c("STUDYID", "USUBJID")
+ |
+ |
| 216 | ++ |
+ ) %>% |
||
| 131 | +217 | 3x |
- var_relabel(+ dplyr::rowwise() %>% |
|
| 132 | +218 | 3x |
- STUDYID = attr(adsl$STUDYID, "label"),+ dplyr::mutate(TRTENDT = lubridate::date(dplyr::case_when( |
|
| 133 | +219 | 3x |
- USUBJID = attr(adsl$USUBJID, "label")+ is.na(TRTEDTM) ~ lubridate::floor_date(lubridate::date(TRTSDTM) + study_duration_secs, unit = "day"), |
|
| 134 | -+ | |||
| 220 | +3x |
- )+ TRUE ~ TRTEDTM |
||
| 135 | +221 | - - | -||
| 136 | -3x | -
- adqs <- var_relabel(+ ))) %>% |
||
| 137 | +222 | 3x |
- adqs,+ dplyr::mutate(ADTM = sample( |
|
| 138 | +223 | 3x |
- STUDYID = "Study Identifier",+ seq(lubridate::as_datetime(TRTSDTM), lubridate::as_datetime(TRTENDT), by = "day"), |
|
| 139 | +224 | 3x |
- USUBJID = "Unique Subject Identifier"- |
- |
| 140 | -- |
- )- |
- ||
| 141 | -- |
-
+ size = 1 |
||
| 142 | +225 |
- # merge ADSL to be able to add QS date and study day variables+ )) %>% |
||
| 143 | +226 | 3x |
- adqs <- dplyr::inner_join(+ dplyr::mutate(ADY = ceiling(difftime(ADTM, TRTSDTM, units = "days"))) %>% |
|
| 144 | +227 | 3x |
- adqs,+ dplyr::select(-TRTENDT) %>% |
|
| 145 | +228 | 3x |
- adsl,+ dplyr::ungroup() %>% |
|
| 146 | +229 | 3x |
- by = c("STUDYID", "USUBJID")
+ dplyr::arrange(STUDYID, USUBJID, ADTM) |
|
| 147 | +230 |
- ) %>%+ |
||
| 148 | +231 | 3x |
- dplyr::rowwise() %>%+ adtte <- adtte %>% |
|
| 149 | +232 | 3x |
- dplyr::mutate(TRTENDT = lubridate::date(dplyr::case_when(+ dplyr::group_by(USUBJID) %>% |
|
| 150 | +233 | 3x |
- is.na(TRTEDTM) ~ lubridate::floor_date(lubridate::date(TRTSDTM) + study_duration_secs, unit = "day"),+ dplyr::mutate(TTESEQ = seq_len(dplyr::n())) %>% |
|
| 151 | +234 | 3x |
- TRUE ~ TRTEDTM+ dplyr::mutate(ASEQ = TTESEQ) %>% |
|
| 152 | -+ | |||
| 235 | +3x |
- ))) %>%+ dplyr::mutate(PARAM = as.factor(PARAM)) %>% |
||
| 153 | +236 | 3x |
- ungroup()+ dplyr::mutate(PARAMCD = as.factor(PARAMCD)) %>% |
|
| 154 | -+ | |||
| 237 | +3x |
-
+ dplyr::ungroup() %>% |
||
| 155 | +238 | 3x |
- adqs <- adqs %>%+ dplyr::arrange( |
|
| 156 | +239 | 3x |
- group_by(USUBJID) %>%+ STUDYID, |
|
| 157 | +240 | 3x |
- arrange(USUBJID, AVISITN) %>%+ USUBJID, |
|
| 158 | +241 | 3x |
- dplyr::mutate(ADTM = rep(+ PARAMCD, |
|
| 159 | +242 | 3x |
- sort(sample(+ ADTM, |
|
| 160 | +243 | 3x |
- seq(lubridate::as_datetime(TRTSDTM[1]), lubridate::as_datetime(TRTENDT[1]), by = "day"),+ TTESEQ |
|
| 161 | -3x | +|||
| 244 | +
- size = nlevels(AVISIT)+ ) |
|||
| 162 | +245 |
- )),+ |
||
| 163 | +246 | 3x |
- each = n() / nlevels(AVISIT)+ mod_before_adtte <- adtte |
|
| 164 | +247 |
- )) %>%+ |
||
| 165 | -3x | +|||
| 248 | +
- dplyr::ungroup() %>%+ # adding adverse event counts and log follow-up time |
|||
| 166 | +249 | 3x |
- dplyr::mutate(ADY = ceiling(difftime(ADTM, TRTSDTM, units = "days"))) %>%+ adtte <- dplyr::bind_rows( |
|
| 167 | +250 | 3x |
- dplyr::select(-TRTENDT) %>%+ adtte, |
|
| 168 | +251 | 3x |
- dplyr::arrange(STUDYID, USUBJID, ADTM)+ data.frame( |
|
| 169 | -+ | |||
| 252 | +3x |
-
+ adtte %>% |
||
| 170 | +253 | 3x |
- adqs <- adqs %>%+ dplyr::group_by(USUBJID) %>% |
|
| 171 | +254 | 3x |
- dplyr::group_by(USUBJID) %>%+ dplyr::slice_head(n = 1) %>% |
|
| 172 | +255 | 3x |
- dplyr::mutate(QSSEQ = seq_len(dplyr::n())) %>%+ dplyr::mutate( |
|
| 173 | +256 | 3x |
- dplyr::mutate(ASEQ = QSSEQ) %>%+ PARAMCD = "TNE", |
|
| 174 | +257 | 3x |
- dplyr::ungroup() %>%+ PARAM = "Total Number of Exacerbations", |
|
| 175 | +258 | 3x |
- dplyr::arrange(+ AVAL = stats::rpois(1, 3), |
|
| 176 | +259 | 3x |
- STUDYID,+ AVALU = "COUNT", |
|
| 177 | +260 | 3x |
- USUBJID,+ lgTMATRSK = log(stats::rexp(1, rate = 3)), |
|
| 178 | +261 | 3x |
- PARAMCD,+ dplyr::across( |
|
| 179 | +262 | 3x |
- AVISITN,+ c("ASEQ", "TTESEQ", "ADY", "ADTM", "EVNTDESC"),
|
|
| 180 | +263 | +3x | +
+ ~NA+ |
+ |
| 264 | ++ |
+ )+ |
+ ||
| 265 | ++ |
+ )+ |
+ ||
| 266 | ++ |
+ )+ |
+ ||
| 267 | ++ |
+ ) %>%+ |
+ ||
| 268 | +3x | +
+ dplyr::arrange(+ |
+ ||
| 269 | +3x | +
+ STUDYID,+ |
+ ||
| 270 | +3x | +
+ USUBJID,+ |
+ ||
| 271 | +3x | +
+ PARAMCD,+ |
+ ||
| 272 | 3x |
ADTM, |
||
| 181 | +273 | 3x |
- QSSEQ+ TTESEQ |
|
| 182 | +274 |
) |
||
| 183 | +275 | |||
| 184 | +276 | +3x | +
+ mod_after_adtte <- adtte+ |
+ |
| 277 | ++ | + + | +||
| 278 | 3x |
if (length(na_vars) > 0 && na_percentage > 0) {
|
||
| 185 | +279 | ! |
- adqs <- mutate_na(ds = adqs, na_vars = na_vars, na_percentage = na_percentage)+ adtte <- mutate_na(ds = adtte, na_vars = na_vars, na_percentage = na_percentage) |
|
| 186 | +280 |
} |
||
| 187 | +281 | |||
| 188 | +282 |
# apply metadata |
||
| 189 | +283 | 3x |
- adqs <- apply_metadata(adqs, "metadata/ADQS.yml")+ adtte <- apply_metadata(adtte, "metadata/ADTTE.yml") |
|
| 190 | +284 | |||
| 191 | +285 | 3x |
- return(adqs)+ return(adtte) |
|
| 192 | +286 |
}@@ -36475,14 +35621,14 @@ random.cdisc.data coverage - 98.86% |
| 1 |
- #' Protocol Deviations Analysis Dataset (ADDV)+ #' Subject-Level Analysis Dataset (ADSL) |
||
| 5 |
- #' Function for generating random Protocol Deviations Analysis Dataset for a given+ #' The Subject-Level Analysis Dataset (ADSL) is used to provide the variables |
||
| 6 |
- #' Subject-Level Analysis Dataset.+ #' that describe attributes of a subject. ADSL is a source for subject-level |
||
| 7 |
- #'+ #' variables used in other analysis data sets, such as population flags and |
||
| 8 |
- #' @details One record per each record in the corresponding SDTM domain.+ #' treatment variables. There is only one ADSL per study. ADSL and its related |
||
| 9 |
- #'+ #' metadata are required in a CDISC-based submission of data from a clinical |
||
| 10 |
- #' Keys: `STUDYID`, `USUBJID`, `ASTDT`, `DVTERM`, `DVSEQ`+ #' trial even if no other analysis data sets are submitted. |
||
| 12 |
- #' @inheritParams argument_convention+ #' @details One record per subject. |
||
| 13 |
- #' @param max_n_dv (`integer`)\cr Maximum number of deviations per patient. Defaults to 3.+ #' |
||
| 14 |
- #' @param p_dv (`proportion`)\cr Probability of a patient having protocol deviations.+ #' Keys: `STUDYID`, `USUBJID` |
||
| 15 |
- #' @template param_cached+ #' |
||
| 16 |
- #' @templateVar data addv+ #' @inheritParams argument_convention |
||
| 17 |
- #'+ #' @param N (`numeric`)\cr Number of patients. |
||
| 18 |
- #' @return `data.frame`+ #' @param study_duration (`numeric`)\cr Duration of study in years. |
||
| 19 |
- #' @export+ #' @param with_trt02 (`logical`)\cr Should period 2 be added. |
||
| 20 |
- #'+ #' @param ae_withdrawal_prob (`proportion`)\cr Probability that there is at least one |
||
| 21 |
- #' @examples+ #' Adverse Event leading to the withdrawal of a study drug. |
||
| 22 |
- #' adsl <- radsl(N = 10, seed = 1, study_duration = 2)+ #' @template param_cached |
||
| 23 |
- #'+ #' @templateVar data adsl |
||
| 24 |
- #' addv <- raddv(adsl, seed = 2)+ #' |
||
| 25 |
- #' addv+ #' @return `data.frame` |
||
| 26 |
- raddv <- function(adsl,+ #' @export |
||
| 27 |
- max_n_dv = 3L,+ # |
||
| 28 |
- p_dv = 0.15,+ #' @examples |
||
| 29 |
- lookup = NULL,+ #' adsl <- radsl(N = 10, study_duration = 2, seed = 1) |
||
| 30 |
- seed = NULL,+ #' adsl |
||
| 31 |
- na_percentage = 0,+ #' |
||
| 32 |
- na_vars = list(+ #' adsl <- radsl( |
||
| 33 |
- "ASTDT" = c(seed = 1234, percentage = 0.1),+ #' N = 10, seed = 1, |
||
| 34 |
- "DVCAT" = c(seed = 1234, percentage = 0.1)+ #' na_percentage = 0.1, |
||
| 35 |
- ),+ #' na_vars = list( |
||
| 36 |
- cached = FALSE) {
+ #' DTHDT = c(seed = 1234, percentage = 0.1), |
||
| 37 | -4x | +
- checkmate::assert_flag(cached)+ #' LSTALVDT = c(seed = 1234, percentage = 0.1) |
|
| 38 | -4x | +
- if (cached) {
+ #' ) |
|
| 39 | -1x | +
- return(get_cached_data("caddv"))
+ #' ) |
|
| 40 |
- }+ #' adsl |
||
| 41 |
-
+ #' |
||
| 42 | -3x | +
- checkmate::assert_data_frame(adsl)+ #' adsl <- radsl(N = 10, seed = 1, na_percentage = .1) |
|
| 43 | -3x | +
- checkmate::assert_integer(max_n_dv, len = 1, lower = 1, any.missing = FALSE)+ #' adsl |
|
| 44 | -3x | +
- checkmate::assert_number(p_dv, lower = .Machine$double.xmin, upper = 1)+ radsl <- function(N = 400, # nolint |
|
| 45 | -3x | +
- checkmate::assert_number(seed, null.ok = TRUE)+ study_duration = 2, |
|
| 46 | -3x | +
- checkmate::assert_number(na_percentage, lower = 0, upper = 1)+ seed = NULL, |
|
| 47 | -3x | +
- checkmate::assert_true(na_percentage < 1)+ with_trt02 = TRUE, |
|
| 48 |
-
+ na_percentage = 0, |
||
| 49 | -3x | +
- if (!is.null(seed)) set.seed(seed)+ na_vars = list( |
|
| 50 | -3x | +
- study_duration_secs <- lubridate::seconds(attr(adsl, "study_duration_secs"))+ "AGE" = NA, "SEX" = NA, "RACE" = NA, "STRATA1" = NA, "STRATA2" = NA, |
|
| 51 |
-
+ "BMRKR1" = c(seed = 1234, percentage = 0.1), "BMRKR2" = c(1234, 0.1), "BEP01FL" = NA |
||
| 52 | -3x | +
- checkmate::assert_data_frame(lookup, null.ok = TRUE)+ ), |
|
| 53 | -3x | +
- lookup_dv <- if (!is.null(lookup)) {
+ ae_withdrawal_prob = 0.05, |
|
| 54 | -! | +
- lookup+ cached = FALSE) {
|
|
| 55 | -+ | 28x |
- } else {
+ checkmate::assert_flag(cached) |
| 56 | -3x | +28x |
- tibble::tribble(+ if (cached) {
|
| 57 | -3x | +2x |
- ~DOMAIN, ~DVCAT, ~DVDECOD, ~DVTERM, ~DVREAS, ~DVEPRELI,+ return(get_cached_data("cadsl"))
|
| 58 | -3x | +
- "DV", "MAJOR", "EXCLUSION CRITERIA", "Received prior prohibited therapy or medication", "", "N",+ } |
|
| 59 | -3x | +
- "DV", "MAJOR", "EXCLUSION CRITERIA", "Active or untreated or other excluded cns metastases", "", "N",+ |
|
| 60 | -3x | +26x |
- "DV", "MAJOR", "EXCLUSION CRITERIA", "History of other malignancies within the last 5 years", "", "N",+ checkmate::assert_number(N) |
| 61 | -3x | +26x |
- "DV", "MAJOR", "EXCLUSION CRITERIA", "Uncontrolled concurrent condition", "", "N",+ checkmate::assert_number(seed, null.ok = TRUE) |
| 62 | -3x | +26x |
- "DV", "MAJOR", "EXCLUSION CRITERIA", "Other exclusion criteria", "", "N",+ checkmate::assert_number(na_percentage, lower = 0, upper = 1, na.ok = TRUE) |
| 63 | -3x | +26x |
- "DV", "MAJOR", "EXCLUSION CRITERIA", "Pregnancy criteria", "", "N",+ checkmate::assert_number(study_duration, lower = 1) |
| 64 | -3x | +26x |
- "DV", "MAJOR", "INCLUSION CRITERIA", "Does not meet prior therapy requirements", "", "N",+ checkmate::assert_number(na_percentage, lower = 0, upper = 1) |
| 65 | -3x | +26x |
- "DV", "MAJOR", "INCLUSION CRITERIA", "Inclusion lab values outside allowed limits", "", "N",+ checkmate::assert_true(na_percentage < 1) |
| 66 | -3x | +
- "DV", "MAJOR", "INCLUSION CRITERIA", "No signed ICF at study entry", "", "N",+ |
|
| 67 | -3x | +26x |
- "DV", "MAJOR", "INCLUSION CRITERIA", "Inclusion-related test not done/out of window", "", "N",+ if (!is.null(seed)) {
|
| 68 | -3x | +26x |
- "DV", "MAJOR", "INCLUSION CRITERIA", "Ineligible cancer type or current cancer stage", "", "N",+ set.seed(seed) |
| 69 | -3x | +
- "DV", "MAJOR", "MEDICATION", "Dose missed or significantly out of window",+ } |
|
| 70 | -3x | +
- "Site action due to epidemic/pandemic", "Y",+ |
|
| 71 | -3x | +26x |
- "DV", "MAJOR", "MEDICATION", "Received incorrect study medication", "", "N",+ study_duration_secs <- lubridate::seconds(lubridate::years(study_duration)) |
| 72 | -3x | +26x |
- "DV", "MAJOR", "MEDICATION", "Received prohibited concomitant medication", "", "N",+ sys_dtm <- lubridate::fast_strptime("20/2/2019 11:16:16.683", "%d/%m/%Y %H:%M:%OS")
|
| 73 | -3x | +26x |
- "DV", "MAJOR", "MEDICATION", "Discontinued study drug for unspecified reason", "", "N",+ discons <- max(1, floor((N * .3))) |
| 74 | -3x | +26x |
- "DV", "MAJOR", "MEDICATION", "Significant deviation from planned dose",+ country_site_prob <- c(.5, .121, .077, .077, .075, .052, .046, .025, .014, .003) |
| 75 | -3x | +
- "Site action due to epidemic/pandemic", "Y",+ |
|
| 76 | -3x | +26x |
- "DV", "MAJOR", "PROCEDURAL", "Missed assessment affecting safety/study outcomes", "", "N",+ adsl <- tibble::tibble( |
| 77 | -3x | +26x |
- "DV", "MAJOR", "PROCEDURAL", "Eligibility-related test not done/out of window", "", "N",+ STUDYID = rep("AB12345", N),
|
| 78 | -3x | +26x |
- "DV", "MAJOR", "PROCEDURAL", "Failure to sign updated ICF within two visits",+ COUNTRY = sample_fct( |
| 79 | -3x | +26x |
- "Site action due to epidemic/pandemic", "Y",+ c("CHN", "USA", "BRA", "PAK", "NGA", "RUS", "JPN", "GBR", "CAN", "CHE"),
|
| 80 | -3x | +26x |
- "DV", "MAJOR", "PROCEDURAL", "Omission of complete lab panel required by protocol", "", "N",+ N, |
| 81 | -3x | +26x |
- "DV", "MAJOR", "PROCEDURAL", "Omission of screening tumor assessment", "", "N",+ prob = country_site_prob |
| 82 | -3x | +
- "DV", "MAJOR", "PROCEDURAL", "Missed 2 or more efficacy assessments",+ ), |
|
| 83 | -3x | +26x |
- "Site action due to epidemic/pandemic", "Y"+ SITEID = sample_fct(1:20, N, prob = rep(country_site_prob, times = 2)), |
| 84 | -+ | 26x |
- )+ SUBJID = paste("id", seq_len(N), sep = "-"),
|
| 85 | -+ | 26x |
- }+ AGE = sapply(stats::rchisq(N, df = 5, ncp = 10), max, 0) + 20, |
| 86 | -+ | 26x |
-
+ AGEU = "YEARS", |
| 87 | -+ | 26x |
-
+ SEX = c("F", "M") %>% sample_fct(N, prob = c(.52, .48)),
|
| 88 | -3x | +26x |
- addv <- Map(+ ARMCD = c("ARM A", "ARM B", "ARM C") %>% sample_fct(N),
|
| 89 | -3x | +26x |
- function(id, sid) {
+ RACE = c( |
| 90 | -30x | +26x |
- n_dv <- stats::rbinom(1, 1, p_dv) * sample(c(1, seq_len(max_n_dv)), 1)+ "ASIAN", "BLACK OR AFRICAN AMERICAN", "WHITE", "AMERICAN INDIAN OR ALASKA NATIVE", |
| 91 | -30x | +26x |
- i <- sample(seq_len(nrow(lookup_dv)), n_dv, TRUE)+ "MULTIPLE", "NATIVE HAWAIIAN OR OTHER PACIFIC ISLANDER", "OTHER", "UNKNOWN" |
| 92 | -30x | +
- dplyr::mutate(+ ) %>% |
|
| 93 | -30x | +26x |
- lookup_dv[i, ],+ sample_fct(N, prob = c(.55, .23, .16, .05, .004, .003, .002, .002)), |
| 94 | -30x | +26x |
- USUBJID = id,+ TRTSDTM = sys_dtm + sample(seq(0, study_duration_secs), size = N, replace = TRUE), |
| 95 | -30x | +26x |
- STUDYID = sid+ RANDDT = lubridate::date(TRTSDTM - lubridate::days(floor(stats::runif(N, min = 0, max = 5)))), |
| 96 | -+ | 26x |
- )+ TRTEDTM = TRTSDTM + study_duration_secs, |
| 97 | -+ | 26x |
- },+ STRATA1 = c("A", "B", "C") %>% sample_fct(N),
|
| 98 | -3x | +26x |
- adsl$USUBJID,+ STRATA2 = c("S1", "S2") %>% sample_fct(N),
|
| 99 | -3x | +26x |
- adsl$STUDYID+ BMRKR1 = stats::rchisq(N, 6), |
| 100 | -+ | 26x |
- ) %>%+ BMRKR2 = sample_fct(c("LOW", "MEDIUM", "HIGH"), N),
|
| 101 | -3x | +26x |
- Reduce(rbind, .) %>%+ BMEASIFL = sample_fct(c("Y", "N"), N),
|
| 102 | -3x | +26x |
- dplyr::mutate(DVSCAT = DVCAT)+ BEP01FL = sample_fct(c("Y", "N"), N),
|
| 103 | -+ | 26x |
-
+ AEWITHFL = sample_fct(c("Y", "N"), N, prob = c(ae_withdrawal_prob, 1 - ae_withdrawal_prob))
|
| 104 | -3x | +
- addv <- var_relabel(+ ) %>% |
|
| 105 | -3x | +26x |
- addv,+ dplyr::mutate(ARM = dplyr::recode( |
| 106 | -3x | +26x |
- STUDYID = "Study Identifier",+ ARMCD, |
| 107 | -3x | +26x |
- USUBJID = "Unique Subject Identifier"+ "ARM A" = "A: Drug X", "ARM B" = "B: Placebo", "ARM C" = "C: Combination" |
| 108 |
- )+ )) %>% |
||
| 109 | -+ | 26x |
-
+ dplyr::mutate(ACTARM = ARM) %>% |
| 110 | -+ | 26x |
- # merge ADSL to be able to add deviation date and study day variables+ dplyr::mutate(ACTARMCD = ARMCD) %>% |
| 111 | -3x | +26x |
- addv <- dplyr::inner_join(addv, adsl, by = c("STUDYID", "USUBJID")) %>%
+ dplyr::mutate(TRT01P = ARM) %>% |
| 112 | -3x | +26x |
- dplyr::rowwise() %>%+ dplyr::mutate(TRT01A = ACTARM) %>% |
| 113 | -3x | +26x |
- dplyr::mutate(TRTENDT = lubridate::date(dplyr::case_when(+ dplyr::mutate(ITTFL = factor("Y")) %>%
|
| 114 | -3x | +26x |
- is.na(TRTEDTM) ~ lubridate::floor_date(lubridate::date(TRTSDTM) + study_duration_secs, unit = "day"),+ dplyr::mutate(SAFFL = factor("Y")) %>%
|
| 115 | -3x | +26x |
- TRUE ~ TRTEDTM+ dplyr::arrange(TRTSDTM) |
| 116 |
- ))) %>%+ |
||
| 117 | -3x | +26x |
- dplyr::mutate(ASTDTM = sample(+ adds <- adsl[sample(nrow(adsl), discons), ] %>% |
| 118 | -3x | +26x |
- seq(lubridate::as_datetime(TRTSDTM), lubridate::as_datetime(TRTENDT), by = "day"),+ dplyr::mutate(TRTEDTM_discon = sample( |
| 119 | -3x | +26x |
- size = 1+ seq(from = max(TRTSDTM), to = sys_dtm + study_duration_secs, by = 1), |
| 120 | -+ | 26x |
- )) %>%+ size = discons, |
| 121 | -3x | +26x |
- dplyr::mutate(ASTDT = lubridate::date(ASTDTM)) %>%+ replace = TRUE |
| 122 | -3x | +
- dplyr::mutate(ASTDY = ceiling(difftime(ASTDTM, TRTSDTM, units = "days"))) %>%+ )) %>% |
|
| 123 | -3x | +26x |
- dplyr::select(-TRTENDT, -ASTDTM) %>%+ dplyr::select(SUBJID, TRTSDTM, TRTEDTM_discon) %>% |
| 124 | -3x | +26x |
- dplyr::ungroup() %>%+ dplyr::arrange(TRTSDTM) |
| 125 | -3x | +
- dplyr::arrange(STUDYID, USUBJID, ASTDT, DVTERM)+ |
|
| 126 | -+ | 26x |
-
+ adsl <- dplyr::left_join(adsl, adds, by = c("SUBJID", "TRTSDTM")) %>%
|
| 127 | -3x | +26x |
- addv <- addv %>%+ dplyr::mutate(TRTEDTM = dplyr::case_when( |
| 128 | -3x | +26x |
- dplyr::group_by(USUBJID) %>%+ !is.na(TRTEDTM_discon) ~ TRTEDTM_discon, |
| 129 | -3x | +26x |
- dplyr::mutate(DVSEQ = seq_len(dplyr::n())) %>%+ TRTSDTM >= quantile(TRTSDTM)[2] & TRTSDTM <= quantile(TRTSDTM)[3] ~ lubridate::as_datetime(NA), |
| 130 | -3x | +26x |
- dplyr::ungroup() %>%+ TRUE ~ TRTEDTM |
| 131 | -3x | +
- dplyr::arrange(STUDYID, USUBJID, ASTDT, DVTERM, DVSEQ)+ )) %>% |
|
| 132 | -+ | 26x |
-
+ dplyr::select(-"TRTEDTM_discon") |
| 133 | -3x | +
- addv <- addv %>%+ |
|
| 134 | -3x | +
- dplyr::mutate(AEPRELFL = ifelse(DVEPRELI == "Y", DVEPRELI, ""))+ # add period 2 if needed |
|
| 135 | -+ | 26x |
-
+ if (with_trt02) {
|
| 136 | -3x | +26x |
- if (length(na_vars) > 0 && na_percentage > 0) {
+ with_trt02 <- lubridate::seconds(lubridate::years(1)) |
| 137 | -! | +26x |
- addv <- mutate_na(ds = addv, na_vars = na_vars, na_percentage = na_percentage)+ adsl <- adsl %>% |
| 138 | -+ | 26x |
- }+ dplyr::mutate(TRT02P = sample(ARM)) %>% |
| 139 | -+ | 26x |
-
+ dplyr::mutate(TRT02A = sample(ACTARM)) %>% |
| 140 | -+ | 26x |
- # apply metadata+ dplyr::mutate( |
| 141 | -3x | +26x |
- addv <- apply_metadata(addv, "metadata/ADDV.yml")+ TRT01SDTM = TRTSDTM, |
| 142 | -+ | 26x |
-
+ AP01SDTM = TRT01SDTM, |
| 143 | -3x | +26x |
- return(addv)+ TRT01EDTM = TRTEDTM, |
| 144 | -- |
- }- |
-
| 1 | -+ | 26x |
- #' Tumor Response Analysis Dataset (ADTR)+ AP01EDTM = TRT01EDTM, |
|
| 2 | -+ | |||
| 145 | +26x |
- #'+ TRT02SDTM = TRTEDTM, |
||
| 3 | -+ | |||
| 146 | +26x |
- #' @description `r lifecycle::badge("stable")`
+ AP02SDTM = TRT02SDTM, |
||
| 4 | -+ | |||
| 147 | +26x |
- #'+ TRT02EDTM = TRT01EDTM + with_trt02, |
||
| 5 | -+ | |||
| 148 | +26x |
- #' Function for generating a random Tumor Response Analysis Dataset for a given+ AP02EDTM = TRT02EDTM, |
||
| 6 | -+ | |||
| 149 | +26x |
- #' Subject-Level Analysis Dataset.+ TRTEDTM = TRT02EDTM |
||
| 7 | +150 |
- #'+ ) |
||
| 8 | +151 |
- #' @details One record per subject per parameter per analysis visit per analysis date.+ } |
||
| 9 | +152 |
- #'+ |
||
| 10 | -+ | |||
| 153 | +26x |
- #' Keys: `STUDYID`, `USUBJID`, `PARAMCD`, `BASETYPE`, `AVISITN`, `DTYPE`+ adsl <- adsl %>% |
||
| 11 | -+ | |||
| 154 | +26x |
- #'+ dplyr::mutate(EOSDT = lubridate::date(TRTEDTM)) %>% |
||
| 12 | -+ | |||
| 155 | +26x |
- #' @inheritParams argument_convention+ dplyr::mutate(EOSDY = ceiling(difftime(TRTEDTM, TRTSDTM))) %>% |
||
| 13 | -+ | |||
| 156 | +26x |
- #' @param ... Additional arguments to be passed to `radrs`.+ dplyr::mutate(EOSSTT = dplyr::case_when( |
||
| 14 | -+ | |||
| 157 | +26x |
- #' @template param_cached+ EOSDY == max(EOSDY, na.rm = TRUE) ~ "COMPLETED", |
||
| 15 | -+ | |||
| 158 | +26x |
- #' @templateVar data adtr+ EOSDY < max(EOSDY, na.rm = TRUE) ~ "DISCONTINUED", |
||
| 16 | -+ | |||
| 159 | +26x |
- #'+ is.na(TRTEDTM) ~ "ONGOING" |
||
| 17 | +160 |
- #' @return `data.frame`+ )) %>% |
||
| 18 | -+ | |||
| 161 | +26x |
- #' @export+ dplyr::mutate(EOTSTT = EOSSTT) |
||
| 19 | +162 |
- #'+ |
||
| 20 | +163 |
- #' @author tomlinsj, npaszty, Xuefeng Hou, dipietrc+ # disposition related variables |
||
| 21 | +164 |
- #'+ # using probability of 1 for the "DEATH" level to ensure at least one death record exists |
||
| 22 | -+ | |||
| 165 | +26x |
- #' @examples+ l_dcsreas <- list( |
||
| 23 | -+ | |||
| 166 | +26x |
- #' adsl <- radsl(N = 10, seed = 1, study_duration = 2)+ choices = c( |
||
| 24 | -+ | |||
| 167 | +26x |
- #'+ "ADVERSE EVENT", "DEATH", "LACK OF EFFICACY", "PHYSICIAN DECISION", |
||
| 25 | -+ | |||
| 168 | +26x |
- #' adtr <- radtr(adsl, seed = 2)+ "PROTOCOL VIOLATION", "WITHDRAWAL BY PARENT/GUARDIAN", "WITHDRAWAL BY SUBJECT" |
||
| 26 | +169 |
- #' adtr+ ), |
||
| 27 | -+ | |||
| 170 | +26x |
- radtr <- function(adsl,+ prob = c(.2, 1, .1, .1, .2, .1, .1) |
||
| 28 | +171 |
- param = c("Sum of Longest Diameter by Investigator"),
+ ) |
||
| 29 | -+ | |||
| 172 | +26x |
- paramcd = c("SLDINV"),
+ l_dthcat_other <- list( |
||
| 30 | -+ | |||
| 173 | +26x |
- seed = NULL,+ choices = c( |
||
| 31 | -+ | |||
| 174 | +26x |
- cached = FALSE,+ "Post-study reporting of death", "LOST TO FOLLOW UP", "MISSING", "SUICIDE", "UNKNOWN" |
||
| 32 | +175 |
- ...) {
+ ), |
||
| 33 | -4x | +176 | +26x |
- checkmate::assert_flag(cached)+ prob = c(.1, .3, .3, .2, .1) |
| 34 | -4x | +|||
| 177 | +
- if (cached) {
+ ) |
|||
| 35 | -1x | +|||
| 178 | +
- return(get_cached_data("cadtr"))
+
|
|||
| 36 | -+ | |||
| 179 | +26x |
- }+ adsl <- adsl %>% |
||
| 37 | -3x | +180 | +26x |
- checkmate::assert_data_frame(adsl)+ dplyr::mutate( |
| 38 | -3x | +181 | +26x |
- checkmate::assert_character(param, min.len = 1, any.missing = FALSE)+ DCSREAS = ifelse( |
| 39 | -3x | +182 | +26x |
- checkmate::assert_character(paramcd, min.len = 1, any.missing = FALSE)+ EOSSTT == "DISCONTINUED", |
| 40 | -3x | +183 | +26x |
- checkmate::assert_number(seed, null.ok = TRUE)+ sample(x = l_dcsreas$choices, size = N, replace = TRUE, prob = l_dcsreas$prob), |
| 41 | -3x | +184 | +26x |
- stopifnot(length(param) == length(paramcd))+ as.character(NA) |
| 42 | +185 |
- # validate and initialize related variables+ ) |
||
| 43 | +186 |
-
+ ) %>% |
||
| 44 | -3x | +187 | +26x |
- if (!is.null(seed)) {
+ dplyr::mutate(DTHFL = dplyr::case_when( |
| 45 | -3x | +188 | +26x |
- set.seed(seed)+ DCSREAS == "DEATH" ~ "Y", |
| 46 | -+ | |||
| 189 | +26x |
- }+ TRUE ~ "N" |
||
| 47 | +190 |
-
+ )) %>% |
||
| 48 | -+ | |||
| 191 | +26x |
- # Make times consistent with ADRS at ADY and ADTM.+ dplyr::mutate( |
||
| 49 | -3x | +192 | +26x |
- adrs <- radrs(adsl, seed = seed, ...) %>%+ DTHCAT = ifelse( |
| 50 | -3x | +193 | +26x |
- dplyr::filter(PARAMCD == "OVRINV") %>%+ DCSREAS == "DEATH", |
| 51 | -3x | +194 | +26x |
- dplyr::select(+ sample(x = c("ADVERSE EVENT", "PROGRESSIVE DISEASE", "OTHER"), size = N, replace = TRUE),
|
| 52 | -3x | +195 | +26x |
- "STUDYID",+ as.character(NA) |
| 53 | -3x | +|||
| 196 | +
- "USUBJID",+ ) |
|||
| 54 | -3x | +|||
| 197 | +
- "AVISIT",+ ) %>% |
|||
| 55 | -3x | +198 | +26x |
- "AVISITN",+ dplyr::mutate(DTHCAUS = dplyr::case_when( |
| 56 | -3x | +199 | +26x |
- "ADTM",+ DTHCAT == "ADVERSE EVENT" ~ "ADVERSE EVENT", |
| 57 | -3x | -
- "ADY"- |
- ||
| 58 | -+ | 200 | +26x |
- )+ DTHCAT == "PROGRESSIVE DISEASE" ~ "DISEASE PROGRESSION", |
| 59 | -+ | |||
| 201 | +26x |
-
+ DTHCAT == "OTHER" ~ sample(x = l_dthcat_other$choices, size = N, replace = TRUE, prob = l_dthcat_other$prob), |
||
| 60 | -3x | +202 | +26x |
- adtr <- Map(function(parcd, par) {
+ TRUE ~ as.character(NA) |
| 61 | -3x | +|||
| 203 | +
- df <- adrs+ )) %>% |
|||
| 62 | -3x | +204 | +26x |
- df$AVAL <- stats::rnorm(nrow(df), mean = 150, sd = 30)+ dplyr::mutate(ADTHAUT = dplyr::case_when( |
| 63 | -3x | +205 | +26x |
- df$PARAMCD <- parcd+ DTHCAUS %in% c("ADVERSE EVENT", "DISEASE PROGRESSION") ~ "Yes",
|
| 64 | -3x | +206 | +26x |
- df$PARAM <- par+ DTHCAUS %in% c("UNKNOWN", "SUICIDE", "Post-study reporting of death") ~ sample(
|
| 65 | -3x | +207 | +26x |
- df+ x = c("Yes", "No"), size = N, replace = TRUE, prob = c(0.25, 0.75)
|
| 66 | -3x | +|||
| 208 | +
- }, paramcd, param) %>%+ ), |
|||
| 67 | -3x | +209 | +26x |
- Reduce(rbind, .)+ TRUE ~ as.character(NA) |
| 68 | +210 |
-
+ )) %>% |
||
| 69 | -3x | +|||
| 211 | +
- adtr_base <- adtr %>%+ # adding some random number of days post last treatment date so that death days from last trt admin |
|||
| 70 | -3x | +|||
| 212 | +
- dplyr::filter(AVISITN == 0) %>%+ # supports the LDDTHGR1 derivation below |
|||
| 71 | -3x | +213 | +26x |
- dplyr::group_by(USUBJID, PARAMCD) %>%+ dplyr::mutate(DTHDT = dplyr::case_when( |
| 72 | -3x | +214 | +26x |
- dplyr::mutate(BASE = AVAL) %>%+ DCSREAS == "DEATH" ~ lubridate::date(TRTEDTM + lubridate::days(sample(0:50, size = N, replace = TRUE))), |
| 73 | -3x | +215 | +26x |
- dplyr::select("STUDYID", "USUBJID", "BASE", "PARAMCD")
+ TRUE ~ NA |
| 74 | +216 |
-
+ )) %>% |
||
| 75 | -3x | +217 | +26x |
- adtr_postbase <- adtr %>%+ dplyr::mutate(LDDTHELD = difftime(DTHDT, lubridate::date(TRTEDTM), units = "days")) %>% |
| 76 | -3x | +218 | +26x |
- dplyr::filter(AVISITN > 0) %>%+ dplyr::mutate(LDDTHGR1 = dplyr::case_when( |
| 77 | -3x | +219 | +26x |
- dplyr::filter(!is.na(AVAL)) %>%+ LDDTHELD <= 30 ~ "<=30", |
| 78 | -3x | +220 | +26x |
- dplyr::group_by(USUBJID, PARAMCD) %>%+ LDDTHELD > 30 ~ ">30", |
| 79 | -3x | +221 | +26x |
- dplyr::filter(AVAL == min(AVAL)) %>%+ TRUE ~ as.character(NA) |
| 80 | -3x | +|||
| 222 | +
- dplyr::slice(1) %>%+ )) %>% |
|||
| 81 | -3x | +223 | +26x |
- dplyr::mutate(AVISIT = "POST-BASELINE MINIMUM") %>%+ dplyr::mutate(LSTALVDT = dplyr::case_when( |
| 82 | -3x | +224 | +26x |
- dplyr::mutate(DTYPE = "MINIMUM") %>%+ DCSREAS == "DEATH" ~ DTHDT, |
| 83 | -3x | +225 | +26x |
- dplyr::ungroup()+ TRUE ~ lubridate::date(TRTEDTM) + lubridate::days(floor(stats::runif(N, min = 10, max = 30))) |
| 84 | +226 |
-
+ )) |
||
| 85 | -3x | +|||
| 227 | +
- adtr_lastobs <- adtr %>%+ |
|||
| 86 | -3x | +|||
| 228 | +
- dplyr::filter(AVISITN > 0) %>%+ # add random ETHNIC (Ethnicity) |
|||
| 87 | -3x | +229 | +26x |
- dplyr::filter(!is.na(AVAL)) %>%+ adsl <- adsl %>% |
| 88 | -3x | +230 | +26x |
- dplyr::group_by(USUBJID, PARAMCD) %>%+ dplyr::mutate(ETHNIC = sample( |
| 89 | -3x | +231 | +26x |
- dplyr::filter(ADTM == max(ADTM, na.rm = TRUE)) %>%+ x = c("HISPANIC OR LATINO", "NOT HISPANIC OR LATINO", "NOT REPORTED", "UNKNOWN"),
|
| 90 | -3x | +232 | +26x |
- dplyr::slice(1) %>%+ size = N, replace = TRUE, prob = c(.1, .8, .06, .04) |
| 91 | -3x | +|||
| 233 | +
- dplyr::mutate(LAST_VISIT = AVISIT) %>%+ )) |
|||
| 92 | -3x | +|||
| 234 | +
- dplyr::ungroup() %>%+ |
|||
| 93 | -3x | +|||
| 235 | +
- dplyr::select(+ # associate DTHADY (Relative Day of Death) with Death date |
|||
| 94 | -3x | +|||
| 236 | +
- "STUDYID",+ # Date of Death [adsl.DTHDT] - date part of Date of First Exposure to Treatment [adsl.TRTSDTM] |
|||
| 95 | -3x | +|||
| 237 | +
- "USUBJID",+ |
|||
| 96 | -3x | +238 | +26x |
- "PARAMCD",+ adsl <- adsl %>% |
| 97 | -3x | +239 | +26x |
- "LAST_VISIT"+ dplyr::mutate(DTHADY = difftime(DTHDT, TRTSDTM, units = "days")) |
| 98 | +240 |
- )+ |
||
| 99 | +241 | |||
| 100 | -3x | -
- adtr <- rbind(adtr %>% dplyr::mutate(DTYPE = ""), adtr_postbase)- |
- ||
| 101 | +242 |
-
+ # associate sites with countries and regions |
||
| 102 | -3x | +243 | +26x |
- adtr <- merge(adtr, adtr_base, by = c("STUDYID", "USUBJID", "PARAMCD")) %>%
+ adsl <- adsl %>% |
| 103 | -3x | +244 | +26x |
- dplyr::mutate(+ dplyr::mutate(SITEID = paste0(COUNTRY, "-", SITEID)) %>% |
| 104 | -3x | +245 | +26x |
- ABLFL = dplyr::case_when(AVISIT == "BASELINE" ~ "Y", TRUE ~ ""),+ dplyr::mutate(REGION1 = dplyr::case_when( |
| 105 | -3x | +246 | +26x |
- AVAL = dplyr::case_when(AVISIT == "BASELINE" ~ NA_real_, TRUE ~ AVAL),+ COUNTRY %in% c("NGA") ~ "Africa",
|
| 106 | -3x | +247 | +26x |
- CHG = dplyr::case_when(AVISITN > 0 ~ AVAL - BASE, TRUE ~ NA_real_),+ COUNTRY %in% c("CHN", "JPN", "PAK") ~ "Asia",
|
| 107 | -3x | +248 | +26x |
- PCHG = dplyr::case_when(AVISITN > 0 ~ CHG / BASE * 100, TRUE ~ NA_real_),+ COUNTRY %in% c("RUS") ~ "Eurasia",
|
| 108 | -3x | +249 | +26x |
- AVALC = as.character(AVAL),+ COUNTRY %in% c("GBR") ~ "Europe",
|
| 109 | -3x | +250 | +26x |
- AVALU = "mm"+ COUNTRY %in% c("CAN", "USA") ~ "North America",
|
| 110 | -+ | |||
| 251 | +26x |
- )+ COUNTRY %in% c("BRA") ~ "South America",
|
||
| 111 | -+ | |||
| 252 | +26x |
-
+ TRUE ~ as.character(NA) |
||
| 112 | +253 |
- # ensure PCHG does not exceed 200%, nor go below -100% (double in size, or complete remission of tumor).+ )) %>% |
||
| 113 | -3x | +254 | +26x |
- adtr <- adtr %>%+ dplyr::mutate(INVID = paste("INV ID", SITEID)) %>%
|
| 114 | -3x | +255 | +26x |
- dplyr::mutate(+ dplyr::mutate(INVNAM = paste("Dr.", SITEID, "Doe")) %>%
|
| 115 | -3x | +256 | +26x |
- PCHG_DUM = PCHG,+ dplyr::mutate(USUBJID = paste(STUDYID, SITEID, SUBJID, sep = "-")) |
| 116 | -3x | +|||
| 257 | +
- PCHG = dplyr::case_when(+ |
|||
| 117 | -3x | +|||
| 258 | +
- PCHG_DUM > 200 ~ 200,+ |
|||
| 118 | -3x | +259 | +26x |
- PCHG_DUM < -100 ~ -100,+ if (length(na_vars) > 0 && na_percentage > 0) {
|
| 119 | -3x | +|||
| 260 | +! |
- TRUE ~ PCHG+ adsl <- mutate_na(ds = adsl, na_vars = na_vars, na_percentage = na_percentage) |
||
| 120 | +261 |
- ),- |
- ||
| 121 | -3x | -
- AVAL = dplyr::case_when(+ } |
||
| 122 | -3x | +|||
| 262 | +
- PCHG_DUM > 200 ~ 3 * BASE,+ |
|||
| 123 | -3x | +|||
| 263 | +
- PCHG_DUM < -100 ~ 0,+ # apply metadata |
|||
| 124 | -3x | +264 | +26x |
- TRUE ~ AVAL+ adsl <- apply_metadata(adsl, "metadata/ADSL.yml", FALSE) |
| 125 | +265 |
- ),+ |
||
| 126 | -3x | +266 | +26x |
- CHG = dplyr::case_when(+ attr(adsl, "study_duration_secs") <- as.numeric(study_duration_secs) |
| 127 | -3x | +267 | +26x |
- PCHG_DUM > 200 ~ 2 * BASE,+ return(adsl) |
| 128 | -3x | +|||
| 268 | +
- PCHG_DUM < -100 ~ -BASE,- |
- |||
| 129 | -3x | -
- TRUE ~ CHG- |
- ||
| 130 | -- |
- )- |
- ||
| 131 | -- |
- ) %>%- |
- ||
| 132 | -3x | -
- dplyr::select(-"PCHG_DUM")- |
- ||
| 133 | -- | - - | -||
| 134 | -3x | -
- adtr <- merge(adsl, adtr, by = c("STUDYID", "USUBJID")) %>%
- |
- ||
| 135 | -3x | -
- dplyr::group_by(USUBJID, PARAMCD) %>%- |
- ||
| 136 | -3x | -
- dplyr::mutate(- |
- ||
| 137 | -3x | -
- ONTRTFL = factor(dplyr::case_when(- |
- ||
| 138 | -3x | -
- !AVISIT %in% c("SCREENING", "BASELINE", "FOLLOW UP") ~ "Y",
- |
- ||
| 139 | -3x | -
- TRUE ~ ""- |
- ||
| 140 | -- |
- )),- |
- ||
| 141 | -3x | -
- ANL01FL = dplyr::case_when(- |
- ||
| 142 | -3x | -
- DTYPE == "" & AVISITN > 0 ~ "Y",- |
- ||
| 143 | -3x | -
- TRUE ~ ""- |
- ||
| 144 | -- |
- ),- |
- ||
| 145 | -3x | -
- ANL03FL = dplyr::case_when(- |
- ||
| 146 | -3x | -
- DTYPE == "MINIMUM" ~ "Y",- |
- ||
| 147 | -3x | -
- ABLFL == "Y" ~ "Y",- |
- ||
| 148 | -3x | -
- TRUE ~ ""- |
- ||
| 149 | -- |
- )- |
- ||
| 150 | -- |
- )- |
- ||
| 151 | -3x | -
- adtr <- merge(adtr, adtr_lastobs, by = c("STUDYID", "USUBJID", "PARAMCD")) %>%
- |
- ||
| 152 | -3x | -
- dplyr::mutate(- |
- ||
| 153 | -3x | -
- ANL02FL = dplyr::case_when(- |
- ||
| 154 | -3x | -
- as.character(AVISIT) == as.character(LAST_VISIT) ~ "Y",- |
- ||
| 155 | -3x | -
- ABLFL == "Y" ~ "Y",- |
- ||
| 156 | -3x | -
- TRUE ~ ""- |
- ||
| 157 | -- |
- )- |
- ||
| 158 | -- |
- ) %>%- |
- ||
| 159 | -3x | -
- dplyr::select(-"LAST_VISIT")- |
- ||
| 160 | -- |
- # Adding variables that are in ADTR osprey but not RCD.- |
- ||
| 161 | -3x | -
- adtr <- adtr %>%- |
- ||
| 162 | -3x | -
- dplyr::mutate(- |
- ||
| 163 | -3x | -
- DCSREAS_GRP = ifelse(DCSREAS == "ADVERSE EVENT", "Safety", "Non-Safety"),- |
- ||
| 164 | -3x | -
- TRTDURD = ifelse(- |
- ||
| 165 | -3x | -
- is.na(TRTSDTM) | is.na(TRTEDTM),- |
- ||
| 166 | -3x | -
- NA,- |
- ||
| 167 | -3x | -
- TRTEDTM - (TRTSDTM + lubridate::days(1))- |
- ||
| 168 | -- |
- ),- |
- ||
| 169 | -3x | -
- AGEGR1 = ifelse(AGE < 65, "<65", ">=65")- |
- ||
| 170 | -- |
- )- |
- ||
| 171 | -- | - - | -||
| 172 | -- |
- # apply metadata- |
- ||
| 173 | -3x | -
- adtr <- apply_metadata(adtr, "metadata/ADTR.yml")- |
- ||
| 174 | -3x | -
- return(adtr)- |
- ||
| 175 | -- |
- }+ } |
| 1 |
- #' Subject-Level Analysis Dataset (ADSL)+ #' Tumor Response Analysis Dataset (ADRS) |
||
| 5 |
- #' The Subject-Level Analysis Dataset (ADSL) is used to provide the variables+ #' Function for generating a random Tumor Response Analysis Dataset for a given |
||
| 6 |
- #' that describe attributes of a subject. ADSL is a source for subject-level+ #' Subject-Level Analysis Dataset. |
||
| 7 |
- #' variables used in other analysis data sets, such as population flags and+ #' |
||
| 8 |
- #' treatment variables. There is only one ADSL per study. ADSL and its related+ #' @details |
||
| 9 |
- #' metadata are required in a CDISC-based submission of data from a clinical+ #' One record per subject per parameter per analysis visit per analysis date. |
||
| 10 |
- #' trial even if no other analysis data sets are submitted.+ #' SDTM variables are populated on new records coming from other single records. |
||
| 11 |
- #'+ #' Otherwise, SDTM variables are left blank. |
||
| 12 |
- #' @details One record per subject.+ #' |
||
| 13 |
- #'+ #' Keys: `STUDYID`, `USUBJID`, `PARAMCD`, `AVISITN`, `ADT`, `RSSEQ` |
||
| 14 |
- #' Keys: `STUDYID`, `USUBJID`+ #' |
||
| 15 |
- #'+ #' @inheritParams argument_convention |
||
| 16 |
- #' @inheritParams argument_convention+ #' @param avalc (`character vector`)\cr Analysis value categories. |
||
| 17 |
- #' @param N (`numeric`)\cr Number of patients.+ #' @template param_cached |
||
| 18 |
- #' @param study_duration (`numeric`)\cr Duration of study in years.+ #' @templateVar data adrs |
||
| 19 |
- #' @param with_trt02 (`logical`)\cr Should period 2 be added.+ #' |
||
| 20 |
- #' @param ae_withdrawal_prob (`proportion`)\cr Probability that there is at least one+ #' @return `data.frame` |
||
| 21 |
- #' Adverse Event leading to the withdrawal of a study drug.+ #' @export |
||
| 22 |
- #' @template param_cached+ #' |
||
| 23 |
- #' @templateVar data adsl+ #' @examples |
||
| 24 |
- #'+ #' adsl <- radsl(N = 10, seed = 1, study_duration = 2) |
||
| 25 |
- #' @return `data.frame`+ #' |
||
| 26 |
- #' @export+ #' adrs <- radrs(adsl, seed = 2) |
||
| 27 |
- #+ #' adrs |
||
| 28 |
- #' @examples+ radrs <- function(adsl, |
||
| 29 |
- #' adsl <- radsl(N = 10, study_duration = 2, seed = 1)+ avalc = NULL, |
||
| 30 |
- #' adsl+ lookup = NULL, |
||
| 31 |
- #'+ seed = NULL, |
||
| 32 |
- #' adsl <- radsl(+ na_percentage = 0, |
||
| 33 |
- #' N = 10, seed = 1,+ na_vars = list(AVISIT = c(NA, 0.1), AVAL = c(1234, 0.1), AVALC = c(1234, 0.1)), |
||
| 34 |
- #' na_percentage = 0.1,+ cached = FALSE) {
|
||
| 35 | -+ | 7x |
- #' na_vars = list(+ checkmate::assert_flag(cached) |
| 36 | -+ | 7x |
- #' DTHDT = c(seed = 1234, percentage = 0.1),+ if (cached) {
|
| 37 | -+ | 1x |
- #' LSTALVDT = c(seed = 1234, percentage = 0.1)+ return(get_cached_data("cadrs"))
|
| 38 |
- #' )+ } |
||
| 39 |
- #' )+ |
||
| 40 | -+ | 6x |
- #' adsl+ checkmate::assert_data_frame(adsl) |
| 41 | -+ | 6x |
- #'+ checkmate::assert_vector(avalc, null.ok = TRUE) |
| 42 | -+ | 6x |
- #' adsl <- radsl(N = 10, seed = 1, na_percentage = .1)+ checkmate::assert_number(seed, null.ok = TRUE) |
| 43 | -+ | 6x |
- #' adsl+ checkmate::assert_number(na_percentage, lower = 0, upper = 1) |
| 44 | -+ | 6x |
- radsl <- function(N = 400, # nolint+ checkmate::assert_true(na_percentage < 1) |
| 45 |
- study_duration = 2,+ |
||
| 46 | -+ | 6x |
- seed = NULL,+ param_codes <- if (!is.null(avalc)) {
|
| 47 | -+ | ! |
- with_trt02 = TRUE,+ avalc |
| 48 |
- na_percentage = 0,+ } else {
|
||
| 49 | -+ | 6x |
- na_vars = list(+ stats::setNames(1:5, c("CR", "PR", "SD", "PD", "NE"))
|
| 50 |
- "AGE" = NA, "SEX" = NA, "RACE" = NA, "STRATA1" = NA, "STRATA2" = NA,+ } |
||
| 51 |
- "BMRKR1" = c(seed = 1234, percentage = 0.1), "BMRKR2" = c(1234, 0.1), "BEP01FL" = NA+ |
||
| 52 | -+ | 6x |
- ),+ checkmate::assert_data_frame(lookup, null.ok = TRUE) |
| 53 | -+ | 6x |
- ae_withdrawal_prob = 0.05,+ lookup_ars <- if (!is.null(lookup)) {
|
| 54 | -+ | ! |
- cached = FALSE) {
+ lookup |
| 55 | -28x | +
- checkmate::assert_flag(cached)+ } else {
|
|
| 56 | -28x | +6x |
- if (cached) {
+ expand.grid( |
| 57 | -2x | +6x |
- return(get_cached_data("cadsl"))
+ ARM = c("A: Drug X", "B: Placebo", "C: Combination"),
|
| 58 | -+ | 6x |
- }+ AVALC = names(param_codes) |
| 59 | -+ | 6x |
-
+ ) %>% dplyr::mutate( |
| 60 | -26x | +6x |
- checkmate::assert_number(N)+ AVAL = param_codes[AVALC], |
| 61 | -26x | +6x |
- checkmate::assert_number(seed, null.ok = TRUE)+ p_scr = c(rep(0, 3), rep(0, 3), c(1, 1, 1), c(0, 0, 0), c(0, 0, 0)), |
| 62 | -26x | +6x |
- checkmate::assert_number(na_percentage, lower = 0, upper = 1, na.ok = TRUE)+ p_bsl = c(rep(0, 3), rep(0, 3), c(1, 1, 1), c(0, 0, 0), c(0, 0, 0)), |
| 63 | -26x | +6x |
- checkmate::assert_number(study_duration, lower = 1)+ p_cycle = c(c(.4, .3, .5), c(.35, .25, .25), c(.1, .2, .08), c(.14, 0.15, 0.15), c(.01, 0.1, 0.02)), |
| 64 | -26x | +6x |
- checkmate::assert_number(na_percentage, lower = 0, upper = 1)+ p_eoi = c(c(.4, .3, .5), c(.35, .25, .25), c(.1, .2, .08), c(.14, 0.15, 0.15), c(.01, 0.1, 0.02)), |
| 65 | -26x | +6x |
- checkmate::assert_true(na_percentage < 1)+ p_fu = c(c(.3, .2, .4), c(.2, .1, .3), c(.2, .2, .2), c(.3, .5, 0.1), rep(0, 3)) |
| 66 |
-
+ ) |
||
| 67 | -26x | +
- if (!is.null(seed)) {
+ } |
|
| 68 | -26x | +
- set.seed(seed)+ |
|
| 69 | -+ | 6x |
- }+ if (!is.null(seed)) {
|
| 70 | -+ | 6x |
-
+ set.seed(seed) |
| 71 | -26x | +
- study_duration_secs <- lubridate::seconds(lubridate::years(study_duration))+ } |
|
| 72 | -26x | +6x |
- sys_dtm <- lubridate::fast_strptime("20/2/2019 11:16:16.683", "%d/%m/%Y %H:%M:%OS")
+ study_duration_secs <- lubridate::seconds(attr(adsl, "study_duration_secs")) |
| 73 | -26x | +
- discons <- max(1, floor((N * .3)))+ |
|
| 74 | -26x | +6x |
- country_site_prob <- c(.5, .121, .077, .077, .075, .052, .046, .025, .014, .003)+ adrs <- split(adsl, adsl$USUBJID) %>% |
| 75 | -+ | 6x |
-
+ lapply(function(pinfo) {
|
| 76 | -26x | +60x |
- adsl <- tibble::tibble(+ probs <- dplyr::filter(lookup_ars, ARM == as.character(pinfo$ACTARM)) |
| 77 | -26x | +
- STUDYID = rep("AB12345", N),
+
|
|
| 78 | -26x | +
- COUNTRY = sample_fct(+ # screening |
|
| 79 | -26x | +60x |
- c("CHN", "USA", "BRA", "PAK", "NGA", "RUS", "JPN", "GBR", "CAN", "CHE"),
+ rsp_screen <- sample(probs$AVALC, 1, prob = probs$p_scr) %>% as.character() |
| 80 | -26x | +
- N,+ |
|
| 81 | -26x | +
- prob = country_site_prob+ # baseline |
|
| 82 | -+ | 60x |
- ),+ rsp_bsl <- sample(probs$AVALC, 1, prob = probs$p_bsl) %>% as.character() |
| 83 | -26x | +
- SITEID = sample_fct(1:20, N, prob = rep(country_site_prob, times = 2)),+ |
|
| 84 | -26x | +
- SUBJID = paste("id", seq_len(N), sep = "-"),
+ # cycle |
|
| 85 | -26x | +60x |
- AGE = sapply(stats::rchisq(N, df = 5, ncp = 10), max, 0) + 20,+ rsp_c2d1 <- sample(probs$AVALC, 1, prob = probs$p_cycle) %>% as.character() |
| 86 | -26x | +60x |
- AGEU = "YEARS",+ rsp_c4d1 <- sample(probs$AVALC, 1, prob = probs$p_cycle) %>% as.character() |
| 87 | -26x | +
- SEX = c("F", "M") %>% sample_fct(N, prob = c(.52, .48)),
+
|
|
| 88 | -26x | +
- ARMCD = c("ARM A", "ARM B", "ARM C") %>% sample_fct(N),
+ # end of induction |
|
| 89 | -26x | +60x |
- RACE = c(+ rsp_eoi <- sample(probs$AVALC, 1, prob = probs$p_eoi) %>% as.character() |
| 90 | -26x | +
- "ASIAN", "BLACK OR AFRICAN AMERICAN", "WHITE", "AMERICAN INDIAN OR ALASKA NATIVE",+ |
|
| 91 | -26x | +
- "MULTIPLE", "NATIVE HAWAIIAN OR OTHER PACIFIC ISLANDER", "OTHER", "UNKNOWN"+ # follow up |
|
| 92 | -+ | 60x |
- ) %>%+ rsp_fu <- sample(probs$AVALC, 1, prob = probs$p_fu) %>% as.character() |
| 93 | -26x | +
- sample_fct(N, prob = c(.55, .23, .16, .05, .004, .003, .002, .002)),+ |
|
| 94 | -26x | +60x |
- TRTSDTM = sys_dtm + sample(seq(0, study_duration_secs), size = N, replace = TRUE),+ best_rsp <- min(param_codes[c(rsp_screen, rsp_bsl, rsp_eoi, rsp_fu, rsp_c2d1, rsp_c4d1)]) |
| 95 | -26x | +60x |
- RANDDT = lubridate::date(TRTSDTM - lubridate::days(floor(stats::runif(N, min = 0, max = 5)))),+ best_rsp_i <- which.min(param_codes[c(rsp_screen, rsp_bsl, rsp_eoi, rsp_fu, rsp_c2d1, rsp_c4d1)]) |
| 96 | -26x | +
- TRTEDTM = TRTSDTM + study_duration_secs,+ |
|
| 97 | -26x | +60x |
- STRATA1 = c("A", "B", "C") %>% sample_fct(N),
+ avisit <- c("SCREENING", "BASELINE", "CYCLE 2 DAY 1", "CYCLE 4 DAY 1", "END OF INDUCTION", "FOLLOW UP")
|
| 98 | -26x | +
- STRATA2 = c("S1", "S2") %>% sample_fct(N),
+
|
|
| 99 | -26x | +
- BMRKR1 = stats::rchisq(N, 6),+ # meaningful date information |
|
| 100 | -26x | +60x |
- BMRKR2 = sample_fct(c("LOW", "MEDIUM", "HIGH"), N),
+ trtstdt <- lubridate::date(pinfo$TRTSDTM) |
| 101 | -26x | +60x |
- BMEASIFL = sample_fct(c("Y", "N"), N),
+ trtendt <- lubridate::date(dplyr::if_else( |
| 102 | -26x | +60x |
- BEP01FL = sample_fct(c("Y", "N"), N),
+ !is.na(pinfo$TRTEDTM), pinfo$TRTEDTM, |
| 103 | -26x | +60x |
- AEWITHFL = sample_fct(c("Y", "N"), N, prob = c(ae_withdrawal_prob, 1 - ae_withdrawal_prob))
+ lubridate::floor_date(trtstdt + study_duration_secs, unit = "day") |
| 104 |
- ) %>%+ )) |
||
| 105 | -26x | +60x |
- dplyr::mutate(ARM = dplyr::recode(+ scr_date <- trtstdt - lubridate::days(100) |
| 106 | -26x | +60x |
- ARMCD,+ bs_date <- trtstdt |
| 107 | -26x | +60x |
- "ARM A" = "A: Drug X", "ARM B" = "B: Placebo", "ARM C" = "C: Combination"+ flu_date <- sample(seq(lubridate::as_datetime(trtstdt), lubridate::as_datetime(trtendt), by = "day"), size = 1) |
| 108 | -+ | 60x |
- )) %>%+ eoi_date <- sample(seq(lubridate::as_datetime(trtstdt), lubridate::as_datetime(trtendt), by = "day"), size = 1) |
| 109 | -26x | +60x |
- dplyr::mutate(ACTARM = ARM) %>%+ c2d1_date <- sample(seq(lubridate::as_datetime(trtstdt), lubridate::as_datetime(trtendt), by = "day"), size = 1) |
| 110 | -26x | +60x |
- dplyr::mutate(ACTARMCD = ARMCD) %>%+ c4d1_date <- min(lubridate::date(c2d1_date + lubridate::days(60)), trtendt) |
| 111 | -26x | +
- dplyr::mutate(TRT01P = ARM) %>%+ |
|
| 112 | -26x | +60x |
- dplyr::mutate(TRT01A = ACTARM) %>%+ tibble::tibble( |
| 113 | -26x | +60x |
- dplyr::mutate(ITTFL = factor("Y")) %>%
+ STUDYID = pinfo$STUDYID, |
| 114 | -26x | +60x |
- dplyr::mutate(SAFFL = factor("Y")) %>%
+ SITEID = pinfo$SITEID, |
| 115 | -26x | +60x |
- dplyr::arrange(TRTSDTM)+ USUBJID = pinfo$USUBJID, |
| 116 | -+ | 60x |
-
+ PARAMCD = as.factor(c(rep("OVRINV", 6), "BESRSPI", "INVET")),
|
| 117 | -26x | +60x |
- adds <- adsl[sample(nrow(adsl), discons), ] %>%+ PARAM = as.factor(dplyr::recode( |
| 118 | -26x | +60x |
- dplyr::mutate(TRTEDTM_discon = sample(+ PARAMCD, |
| 119 | -26x | +60x |
- seq(from = max(TRTSDTM), to = sys_dtm + study_duration_secs, by = 1),+ OVRINV = "Overall Response by Investigator - by visit", |
| 120 | -26x | +60x |
- size = discons,+ OVRSPI = "Best Overall Response by Investigator (no confirmation required)", |
| 121 | -26x | +60x |
- replace = TRUE+ BESRSPI = "Best Confirmed Overall Response by Investigator",+ |
+
| 122 | +60x | +
+ INVET = "Investigator End Of Induction Response"+ |
+ |
| 123 | ++ |
+ )),+ |
+ |
| 124 | +60x | +
+ AVALC = c(+ |
+ |
| 125 | +60x | +
+ rsp_screen, rsp_bsl, rsp_c2d1, rsp_c4d1, rsp_eoi, rsp_fu,+ |
+ |
| 126 | +60x | +
+ names(param_codes)[best_rsp],+ |
+ |
| 127 | +60x | +
+ rsp_eoi+ |
+ |
| 128 | ++ |
+ ),+ |
+ |
| 129 | +60x | +
+ AVAL = param_codes[AVALC],+ |
+ |
| 130 | +60x | +
+ AVISIT = factor(c(avisit, avisit[best_rsp_i], avisit[5]), levels = avisit)+ |
+ |
| 131 | ++ |
+ ) %>%+ |
+ |
| 132 | +60x | +
+ merge(+ |
+ |
| 133 | +60x | +
+ tibble::tibble(+ |
+ |
| 134 | +60x | +
+ AVISIT = avisit,+ |
+ |
| 135 | +60x | +
+ ADTM = c(scr_date, bs_date, c2d1_date, c4d1_date, eoi_date, flu_date),+ |
+ |
| 136 | +60x | +
+ AVISITN = c(-1, 0, 2, 4, 999, 999),+ |
+ |
| 137 | +60x | +
+ TRTSDTM = pinfo$TRTSDTM+ |
+ |
| 138 | ++ |
+ ) %>%+ |
+ |
| 139 | +60x | +
+ dplyr::mutate(+ |
+ |
| 140 | +60x | +
+ ADY = ceiling(difftime(ADTM, TRTSDTM, units = "days"))+ |
+ |
| 141 | ++ |
+ ) %>%+ |
+ |
| 142 | +60x | +
+ dplyr::select(-"TRTSDTM"),+ |
+ |
| 143 | +60x | +
+ by = "AVISIT"+ |
+ |
| 144 | ++ |
+ )+ |
+ |
| 145 | ++ |
+ }) %>%+ |
+ |
| 146 | +6x | +
+ Reduce(rbind, .) %>%+ |
+ |
| 147 | +6x | +
+ dplyr::mutate(AVALC = factor(AVALC, levels = names(param_codes))) %>%+ |
+ |
| 148 | +6x | +
+ var_relabel(+ |
+ |
| 149 | +6x | +
+ STUDYID = "Study Identifier",+ |
+ |
| 150 | +6x | +
+ USUBJID = "Unique Subject Identifier"+ |
+ |
| 151 | ++ |
+ )+ |
+ |
| 152 | ++ | + + | +|
| 153 | +6x | +
+ adrs <- var_relabel(+ |
+ |
| 154 | +6x | +
+ adrs,+ |
+ |
| 155 | +6x | +
+ STUDYID = "Study Identifier",+ |
+ |
| 156 | +6x | +
+ USUBJID = "Unique Subject Identifier"+ |
+ |
| 157 | ++ |
+ )+ |
+ |
| 158 | ++ | + + | +|
| 159 | ++ |
+ # merge ADSL to be able to add RS date and study day variables+ |
+ |
| 160 | ++ | + + | +|
| 161 | ++ | + + | +|
| 162 | +6x | +
+ adrs <- dplyr::inner_join(+ |
+ |
| 163 | +6x | +
+ dplyr::select(adrs, -"SITEID"),+ |
+ |
| 164 | +6x | +
+ adsl,+ |
+ |
| 165 | +6x | +
+ by = c("STUDYID", "USUBJID")
+ |
+ |
| 166 | ++ |
+ )+ |
+ |
| 167 | ++ | + + | +|
| 168 | +6x | +
+ adrs <- adrs %>%+ |
+ |
| 169 | +6x | +
+ dplyr::group_by(USUBJID) %>%+ |
+ |
| 170 | +6x | +
+ dplyr::mutate(RSSEQ = seq_len(dplyr::n())) %>%+ |
+ |
| 171 | +6x | +
+ dplyr::mutate(ASEQ = RSSEQ) %>%+ |
+ |
| 172 | +6x | +
+ dplyr::ungroup() %>%+ |
+ |
| 173 | +6x | +
+ dplyr::arrange(+ |
+ |
| 174 | +6x | +
+ STUDYID,+ |
+ |
| 175 | +6x | +
+ USUBJID,+ |
+ |
| 176 | +6x | +
+ PARAMCD,+ |
+ |
| 177 | +6x | +
+ AVISITN,+ |
+ |
| 178 | +6x | +
+ ADTM,+ |
+ |
| 179 | +6x | +
+ RSSEQ+ |
+ |
| 180 | ++ |
+ )+ |
+ |
| 181 | ++ | + + | +|
| 182 | +6x | +
+ if (length(na_vars) > 0 && na_percentage > 0) {
+ |
+ |
| 183 | +! | +
+ adrs <- mutate_na(ds = adrs, na_vars = na_vars, na_percentage = na_percentage)+ |
+ |
| 184 | ++ |
+ }+ |
+ |
| 185 | ++ | + + | +|
| 186 | ++ |
+ # apply metadata+ |
+ |
| 187 | +6x | +
+ adrs <- apply_metadata(adrs, "metadata/ADRS.yml")+ |
+ |
| 188 | ++ | + + | +|
| 189 | +6x | +
+ return(adrs)+ |
+ |
| 190 | ++ |
+ }+ |
+
| 1 | ++ |
+ #' Pharmacokinetics Parameters Dataset (ADPP)+ |
+ ||
| 2 | ++ |
+ #'+ |
+ ||
| 3 | ++ |
+ #' @description `r lifecycle::badge("stable")`
+ |
+ ||
| 4 | ++ |
+ #'+ |
+ ||
| 5 | ++ |
+ #' Function for generating a random Pharmacokinetics Parameters Dataset for a given+ |
+ ||
| 6 | ++ |
+ #' Subject-Level Analysis Dataset.+ |
+ ||
| 7 | ++ |
+ #'+ |
+ ||
| 8 | ++ |
+ #' @details One record per study, subject, parameter category, parameter and visit.+ |
+ ||
| 9 | ++ |
+ #'+ |
+ ||
| 10 | ++ |
+ #' @inheritParams argument_convention+ |
+ ||
| 11 | ++ |
+ #' @param ppcat (`character vector`)\cr Categories of parameters.+ |
+ ||
| 12 | ++ |
+ #' @param ppspec (`character vector`)\cr Specimen material types.+ |
+ ||
| 13 | ++ |
+ #' @template param_cached+ |
+ ||
| 14 | ++ |
+ #' @templateVar data adpp+ |
+ ||
| 15 | ++ |
+ #'+ |
+ ||
| 16 | ++ |
+ #' @return `data.frame`+ |
+ ||
| 17 | ++ |
+ #' @export+ |
+ ||
| 18 | ++ |
+ #'+ |
+ ||
| 19 | ++ |
+ #' @examples+ |
+ ||
| 20 | ++ |
+ #' adsl <- radsl(N = 10, seed = 1, study_duration = 2)+ |
+ ||
| 21 | ++ |
+ #'+ |
+ ||
| 22 | ++ |
+ #' adpp <- radpp(adsl, seed = 2)+ |
+ ||
| 23 | ++ |
+ #' adpp+ |
+ ||
| 24 | ++ |
+ radpp <- function(adsl,+ |
+ ||
| 25 | ++ |
+ ppcat = c("Plasma Drug X", "Plasma Drug Y", "Metabolite Drug X", "Metabolite Drug Y"),
+ |
+ ||
| 26 | ++ |
+ ppspec = c(+ |
+ ||
| 27 | ++ |
+ "Plasma", "Plasma", "Plasma", "Matrix of PD", "Matrix of PD",+ |
+ ||
| 28 | ++ |
+ "Urine", "Urine", "Urine", "Urine"+ |
+ ||
| 29 | ++ |
+ ),+ |
+ ||
| 30 | ++ |
+ paramcd = c(+ |
+ ||
| 31 | ++ |
+ "AUCIFO", "CMAX", "CLO", "RMAX", "TON",+ |
+ ||
| 32 | ++ |
+ "RENALCL", "RENALCLD", "RCAMINT", "RCPCINT"+ |
+ ||
| 33 | ++ |
+ ),+ |
+ ||
| 34 | ++ |
+ param = c(+ |
+ ||
| 35 | ++ |
+ "AUC Infinity Obs", "Max Conc", "Total CL Obs", "Time of Maximum Response",+ |
+ ||
| 36 | ++ |
+ "Time to Onset", "Renal CL", "Renal CL Norm by Dose",+ |
+ ||
| 37 | ++ |
+ "Amt Rec from T1 to T2", "Pct Rec from T1 to T2"+ |
+ ||
| 38 | ++ |
+ ),+ |
+ ||
| 39 | ++ |
+ paramu = c("day*ug/mL", "ug/mL", "ml/day/kg", "hr", "hr", "L/hr", "L/hr/mg", "mg", "%"),
+ |
+ ||
| 40 | ++ |
+ aval_mean = c(200, 30, 5, 10, 3, 0.05, 0.005, 1.5613, 15.65),+ |
+ ||
| 41 | ++ |
+ visit_format = "CYCLE",+ |
+ ||
| 42 | ++ |
+ n_days = 2L,+ |
+ ||
| 43 | ++ |
+ seed = NULL,+ |
+ ||
| 44 | ++ |
+ na_percentage = 0,+ |
+ ||
| 45 | ++ |
+ na_vars = list(+ |
+ ||
| 46 | ++ |
+ AVAL = c(NA, 0.1)+ |
+ ||
| 47 | ++ |
+ ),+ |
+ ||
| 48 | ++ |
+ cached = FALSE) {
+ |
+ ||
| 49 | +4x | +
+ checkmate::assert_flag(cached) |
||
| 122 | -+ | |||
| 50 | +4x |
- )) %>%+ if (cached) {
|
||
| 123 | -26x | +51 | +1x |
- dplyr::select(SUBJID, TRTSDTM, TRTEDTM_discon) %>%+ return(get_cached_data("cadlb"))
|
| 124 | -26x | +|||
| 52 | +
- dplyr::arrange(TRTSDTM)+ } |
|||
| 125 | +53 | |||
| 126 | -26x | +54 | +3x |
- adsl <- dplyr::left_join(adsl, adds, by = c("SUBJID", "TRTSDTM")) %>%
+ checkmate::assert_character(ppcat) |
| 127 | -26x | +55 | +3x |
- dplyr::mutate(TRTEDTM = dplyr::case_when(+ checkmate::assert_character(ppspec) |
| 128 | -26x | +56 | +3x |
- !is.na(TRTEDTM_discon) ~ TRTEDTM_discon,+ checkmate::assert_character(paramcd) |
| 129 | -26x | +57 | +3x |
- TRTSDTM >= quantile(TRTSDTM)[2] & TRTSDTM <= quantile(TRTSDTM)[3] ~ lubridate::as_datetime(NA),+ checkmate::assert_character(param) |
| 130 | -26x | +58 | +3x |
- TRUE ~ TRTEDTM+ checkmate::assert_character(paramu) |
| 131 | -+ | |||
| 59 | +3x |
- )) %>%+ checkmate::assert_vector(aval_mean) |
||
| 132 | -26x | +60 | +3x |
- dplyr::select(-"TRTEDTM_discon")+ checkmate::assert_string(visit_format) |
| 133 | -+ | |||
| 61 | +3x |
-
+ checkmate::assert_integer(n_days) |
||
| 134 | -+ | |||
| 62 | +3x |
- # add period 2 if needed+ checkmate::assert_number(seed, null.ok = TRUE) |
||
| 135 | -26x | +63 | +3x |
- if (with_trt02) {
+ checkmate::assert_number(na_percentage, lower = 0, upper = 1) |
| 136 | -26x | +64 | +3x |
- with_trt02 <- lubridate::seconds(lubridate::years(1))+ checkmate::assert_true(na_percentage < 1) |
| 137 | -26x | +65 | +3x |
- adsl <- adsl %>%+ checkmate::assert_list(na_vars) |
| 138 | -26x | +|||
| 66 | +
- dplyr::mutate(TRT02P = sample(ARM)) %>%+ |
|||
| 139 | -26x | +67 | +3x |
- dplyr::mutate(TRT02A = sample(ACTARM)) %>%+ checkmate::assertTRUE(length(ppspec) == length(paramcd)) |
| 140 | -26x | +68 | +3x |
- dplyr::mutate(+ checkmate::assertTRUE(length(ppspec) == length(param)) |
| 141 | -26x | +69 | +3x |
- TRT01SDTM = TRTSDTM,+ checkmate::assertTRUE(length(ppspec) == length(paramu)) |
| 142 | -26x | +70 | +3x |
- AP01SDTM = TRT01SDTM,+ checkmate::assertTRUE(length(ppspec) == length(aval_mean)) |
| 143 | -26x | +|||
| 71 | +
- TRT01EDTM = TRTEDTM,+ |
|||
| 144 | -26x | +72 | +3x |
- AP01EDTM = TRT01EDTM,+ if (!is.null(seed)) {
|
| 145 | -26x | +73 | +3x |
- TRT02SDTM = TRTEDTM,+ set.seed(seed) |
| 146 | -26x | +|||
| 74 | +
- AP02SDTM = TRT02SDTM,+ } |
|||
| 147 | -26x | +|||
| 75 | +
- TRT02EDTM = TRT01EDTM + with_trt02,+ |
|||
| 148 | -26x | +|||
| 76 | +
- AP02EDTM = TRT02EDTM,+ # validate and initialize related variables |
|||
| 149 | -26x | +77 | +3x |
- TRTEDTM = TRT02EDTM+ ppspec_init_list <- relvar_init(param, ppspec) |
| 150 | -+ | |||
| 78 | +3x |
- )+ param_init_list <- relvar_init(param, paramcd) |
||
| 151 | -+ | |||
| 79 | +3x |
- }+ unit_init_list <- relvar_init(param, paramu) |
||
| 152 | +80 | |||
| 153 | -26x | +81 | +3x |
- adsl <- adsl %>%+ adpp <- expand.grid( |
| 154 | -26x | +82 | +3x |
- dplyr::mutate(EOSDT = lubridate::date(TRTEDTM)) %>%+ STUDYID = unique(adsl$STUDYID), |
| 155 | -26x | +83 | +3x |
- dplyr::mutate(EOSDY = ceiling(difftime(TRTEDTM, TRTSDTM))) %>%+ USUBJID = adsl$USUBJID, |
| 156 | -26x | +84 | +3x |
- dplyr::mutate(EOSSTT = dplyr::case_when(+ PPCAT = as.factor(ppcat), |
| 157 | -26x | +85 | +3x |
- EOSDY == max(EOSDY, na.rm = TRUE) ~ "COMPLETED",+ PARAM = as.factor(param_init_list$relvar1), |
| 158 | -26x | +86 | +3x |
- EOSDY < max(EOSDY, na.rm = TRUE) ~ "DISCONTINUED",+ AVISIT = visit_schedule(visit_format = visit_format, n_assessments = 1L, n_days = n_days), |
| 159 | -26x | +87 | +3x |
- is.na(TRTEDTM) ~ "ONGOING"+ stringsAsFactors = FALSE |
| 160 | +88 |
- )) %>%+ ) |
||
| 161 | -26x | +89 | +3x |
- dplyr::mutate(EOTSTT = EOSSTT)+ adpp <- adpp %>% |
| 162 | -+ | |||
| 90 | +3x |
-
+ dplyr::mutate(AVAL = stats::rnorm(nrow(adpp), mean = 1, sd = 0.2)) %>%+ |
+ ||
| 91 | +3x | +
+ dplyr::left_join(data.frame(PARAM = param, ADJUST = aval_mean), by = "PARAM") %>%+ |
+ ||
| 92 | +3x | +
+ dplyr::mutate(AVAL = AVAL * ADJUST) %>%+ |
+ ||
| 93 | +3x | +
+ dplyr::select(-"ADJUST") |
||
| 163 | +94 |
- # disposition related variables+ |
||
| 164 | +95 |
- # using probability of 1 for the "DEATH" level to ensure at least one death record exists+ # assign related variable values: PARAMxPPSPEC are related |
||
| 165 | -26x | +96 | +3x |
- l_dcsreas <- list(+ adpp <- adpp %>% rel_var( |
| 166 | -26x | +97 | +3x |
- choices = c(+ var_name = "PPSPEC", |
| 167 | -26x | +98 | +3x |
- "ADVERSE EVENT", "DEATH", "LACK OF EFFICACY", "PHYSICIAN DECISION",+ related_var = "PARAM", |
| 168 | -26x | +99 | +3x |
- "PROTOCOL VIOLATION", "WITHDRAWAL BY PARENT/GUARDIAN", "WITHDRAWAL BY SUBJECT"+ var_values = ppspec_init_list$relvar2 |
| 169 | +100 |
- ),+ ) |
||
| 170 | -26x | +|||
| 101 | +
- prob = c(.2, 1, .1, .1, .2, .1, .1)+ |
|||
| 171 | +102 |
- )+ # assign related variable values: PARAMxPARAMCD are related |
||
| 172 | -26x | +103 | +3x |
- l_dthcat_other <- list(+ adpp <- adpp %>% rel_var( |
| 173 | -26x | +104 | +3x |
- choices = c(+ var_name = "PARAMCD", |
| 174 | -26x | -
- "Post-study reporting of death", "LOST TO FOLLOW UP", "MISSING", "SUICIDE", "UNKNOWN"- |
- ||
| 175 | -+ | 105 | +3x |
- ),+ related_var = "PARAM", |
| 176 | -26x | +106 | +3x |
- prob = c(.1, .3, .3, .2, .1)+ var_values = param_init_list$relvar2 |
| 177 | +107 |
) |
||
| 178 | +108 | |||
| 179 | -26x | -
- adsl <- adsl %>%- |
- ||
| 180 | -26x | +|||
| 109 | +
- dplyr::mutate(+ # assign related variable values: PARAMxAVALU are related |
|||
| 181 | -26x | +110 | +3x |
- DCSREAS = ifelse(+ adpp <- adpp %>% rel_var( |
| 182 | -26x | +111 | +3x |
- EOSSTT == "DISCONTINUED",+ var_name = "AVALU", |
| 183 | -26x | +112 | +3x |
- sample(x = l_dcsreas$choices, size = N, replace = TRUE, prob = l_dcsreas$prob),+ related_var = "PARAM", |
| 184 | -26x | +113 | +3x |
- as.character(NA)+ var_values = unit_init_list$relvar2 |
| 185 | +114 |
- )+ ) |
||
| 186 | +115 |
- ) %>%+ |
||
| 187 | -26x | +|||
| 116 | +
- dplyr::mutate(DTHFL = dplyr::case_when(+ # derive AVISITN based AVISIT and AVALC based on AVAL |
|||
| 188 | -26x | +117 | +3x |
- DCSREAS == "DEATH" ~ "Y",+ adpp <- adpp %>% |
| 189 | -26x | -
- TRUE ~ "N"- |
- ||
| 190 | -+ | 118 | +3x |
- )) %>%+ dplyr::mutate(AVALC = as.character(AVAL)) %>% |
| 191 | -26x | +119 | +3x |
dplyr::mutate( |
| 192 | -26x | +120 | +3x |
- DTHCAT = ifelse(+ AVISITN = dplyr::case_when( |
| 193 | -26x | +121 | +3x |
- DCSREAS == "DEATH",+ AVISIT == "SCREENING" ~ 0, |
| 194 | -26x | +122 | +3x |
- sample(x = c("ADVERSE EVENT", "PROGRESSIVE DISEASE", "OTHER"), size = N, replace = TRUE),
+ (grepl("^WEEK", AVISIT) | grepl("^CYCLE", AVISIT)) ~ as.numeric(AVISIT) - 1,
|
| 195 | -26x | +123 | +3x |
- as.character(NA)+ TRUE ~ NA_real_ |
| 196 | +124 |
) |
||
| 197 | +125 |
- ) %>%- |
- ||
| 198 | -26x | -
- dplyr::mutate(DTHCAUS = dplyr::case_when(+ ) |
||
| 199 | -26x | +|||
| 126 | +
- DTHCAT == "ADVERSE EVENT" ~ "ADVERSE EVENT",+ |
|||
| 200 | -26x | +|||
| 127 | +
- DTHCAT == "PROGRESSIVE DISEASE" ~ "DISEASE PROGRESSION",+ # derive REGIMEN variable |
|||
| 201 | -26x | +128 | +3x |
- DTHCAT == "OTHER" ~ sample(x = l_dthcat_other$choices, size = N, replace = TRUE, prob = l_dthcat_other$prob),+ adpp <- adpp %>% dplyr::mutate(REGIMEN = "BID") |
| 202 | -26x | +|||
| 129 | +
- TRUE ~ as.character(NA)+ |
|||
| 203 | +130 |
- )) %>%+ # derive PPSTINT and PPENINT based on PARAMCD |
||
| 204 | -26x | +131 | +3x |
- dplyr::mutate(ADTHAUT = dplyr::case_when(+ t1_t2 <- data.frame( |
| 205 | -26x | +132 | +3x |
- DTHCAUS %in% c("ADVERSE EVENT", "DISEASE PROGRESSION") ~ "Yes",
+ PARAMCD = c("RCAMINT", "RCAMINT", "RCPCINT", "RCPCINT"),
|
| 206 | -26x | +133 | +3x |
- DTHCAUS %in% c("UNKNOWN", "SUICIDE", "Post-study reporting of death") ~ sample(
+ PPSTINT = c("P0H", "P0H", "P0H", "P0H"),
|
| 207 | -26x | +134 | +3x |
- x = c("Yes", "No"), size = N, replace = TRUE, prob = c(0.25, 0.75)
+ PPENINT = c("P12H", "P24H", "P12H", "P24H")
|
| 208 | +135 |
- ),+ ) |
||
| 209 | -26x | +136 | +3x |
- TRUE ~ as.character(NA)+ adpp <- adpp %>% |
| 210 | -+ | |||
| 137 | +3x |
- )) %>%+ dplyr::left_join(t1_t2, by = c("PARAMCD"), multiple = "all", relationship = "many-to-many")
|
||
| 211 | +138 |
- # adding some random number of days post last treatment date so that death days from last trt admin+ |
||
| 212 | -+ | |||
| 139 | +3x |
- # supports the LDDTHGR1 derivation below+ adpp <- dplyr::inner_join(adpp, adsl, by = c("STUDYID", "USUBJID")) %>%
|
||
| 213 | -26x | +140 | +3x |
- dplyr::mutate(DTHDT = dplyr::case_when(+ dplyr::filter( |
| 214 | -26x | +141 | +3x |
- DCSREAS == "DEATH" ~ lubridate::date(TRTEDTM + lubridate::days(sample(0:50, size = N, replace = TRUE))),+ ACTARM != "B: Placebo", |
| 215 | -26x | +142 | +3x |
- TRUE ~ NA+ !(ACTARM == "A: Drug X" & (PPCAT == "Plasma Drug Y" | PPCAT == "Metabolite Drug Y")) |
| 216 | +143 |
- )) %>%+ ) |
||
| 217 | -26x | +|||
| 144 | +
- dplyr::mutate(LDDTHELD = difftime(DTHDT, lubridate::date(TRTEDTM), units = "days")) %>%+ + |
+ |||
| 145 | ++ |
+ # derive PKARMCD column for creating more cohorts |
||
| 218 | -26x | +146 | +3x |
- dplyr::mutate(LDDTHGR1 = dplyr::case_when(+ adpp <- adpp %>% |
| 219 | -26x | +147 | +3x |
- LDDTHELD <= 30 ~ "<=30",+ dplyr::mutate(PKARMCD = factor(1 + (seq_len(nrow(adpp)) - 1) %/% (nrow(adpp) / 10), labels = c( |
| 220 | -26x | +148 | +3x |
- LDDTHELD > 30 ~ ">30",+ "Drug A", "Drug B", "Drug C", "Drug D", "Drug E", "Drug F", "Drug G", "Drug H", |
| 221 | -26x | +149 | +3x |
- TRUE ~ as.character(NA)+ "Drug I", "Drug J" |
| 222 | +150 |
- )) %>%+ ))) |
||
| 223 | -26x | +|||
| 151 | +
- dplyr::mutate(LSTALVDT = dplyr::case_when(+ |
|||
| 224 | -26x | +152 | +3x |
- DCSREAS == "DEATH" ~ DTHDT,+ if (length(na_vars) > 0 && na_percentage > 0) {
|
| 225 | -26x | +|||
| 153 | +! |
- TRUE ~ lubridate::date(TRTEDTM) + lubridate::days(floor(stats::runif(N, min = 10, max = 30)))+ adpp <- mutate_na(ds = adpp, na_vars = na_vars, na_percentage = na_percentage) |
||
| 226 | +154 |
- ))+ } |
||
| 227 | +155 | |||
| 228 | -+ | |||
| 156 | +3x |
- # add random ETHNIC (Ethnicity)+ adpp <- apply_metadata(adpp, "metadata/ADPP.yml") |
||
| 229 | -26x | +157 | +3x |
- adsl <- adsl %>%+ return(adpp) |
| 230 | -26x | +|||
| 158 | +
- dplyr::mutate(ETHNIC = sample(+ } |
|||
| 231 | -26x | +
| 1 | +
- x = c("HISPANIC OR LATINO", "NOT HISPANIC OR LATINO", "NOT REPORTED", "UNKNOWN"),
+ #' Previous and Concomitant Medications Analysis Dataset (ADCM) |
|||
| 232 | -26x | +|||
| 2 | +
- size = N, replace = TRUE, prob = c(.1, .8, .06, .04)+ #' |
|||
| 233 | +3 |
- ))+ #' @description `r lifecycle::badge("stable")`
|
||
| 234 | +4 |
-
+ #' |
||
| 235 | +5 |
- # associate DTHADY (Relative Day of Death) with Death date+ #' Function for generating random Concomitant Medication Analysis Dataset for a given |
||
| 236 | +6 |
- # Date of Death [adsl.DTHDT] - date part of Date of First Exposure to Treatment [adsl.TRTSDTM]+ #' Subject-Level Analysis Dataset. |
||
| 237 | +7 |
-
+ #' |
||
| 238 | -26x | +|||
| 8 | +
- adsl <- adsl %>%+ #' @details One record per each record in the corresponding SDTM domain. |
|||
| 239 | -26x | +|||
| 9 | +
- dplyr::mutate(DTHADY = difftime(DTHDT, TRTSDTM, units = "days"))+ #' |
|||
| 240 | +10 |
-
+ #' Keys: `STUDYID`, `USUBJID`, `ASTDTM`, `CMSEQ` |
||
| 241 | +11 |
-
+ #' |
||
| 242 | +12 |
- # associate sites with countries and regions+ #' @inheritParams argument_convention |
||
| 243 | -26x | +|||
| 13 | +
- adsl <- adsl %>%+ #' @param max_n_cms (`integer`)\cr Maximum number of concomitant medications per patient. Defaults to 10. |
|||
| 244 | -26x | +|||
| 14 | +
- dplyr::mutate(SITEID = paste0(COUNTRY, "-", SITEID)) %>%+ #' @param who_coding (`flag`)\cr Whether WHO coding (with multiple paths per medication) should be used. |
|||
| 245 | -26x | +|||
| 15 | +
- dplyr::mutate(REGION1 = dplyr::case_when(+ #' @template param_cached |
|||
| 246 | -26x | +|||
| 16 | +
- COUNTRY %in% c("NGA") ~ "Africa",
+ #' @templateVar data adcm |
|||
| 247 | -26x | +|||
| 17 | +
- COUNTRY %in% c("CHN", "JPN", "PAK") ~ "Asia",
+ #' |
|||
| 248 | -26x | +|||
| 18 | +
- COUNTRY %in% c("RUS") ~ "Eurasia",
+ #' @return `data.frame` |
|||
| 249 | -26x | +|||
| 19 | +
- COUNTRY %in% c("GBR") ~ "Europe",
+ #' @export |
|||
| 250 | -26x | +|||
| 20 | +
- COUNTRY %in% c("CAN", "USA") ~ "North America",
+ #' |
|||
| 251 | -26x | +|||
| 21 | +
- COUNTRY %in% c("BRA") ~ "South America",
+ #' @examples |
|||
| 252 | -26x | +|||
| 22 | +
- TRUE ~ as.character(NA)+ #' adsl <- radsl(N = 10, seed = 1, study_duration = 2) |
|||
| 253 | +23 |
- )) %>%+ #' |
||
| 254 | -26x | +|||
| 24 | +
- dplyr::mutate(INVID = paste("INV ID", SITEID)) %>%
+ #' adcm <- radcm(adsl, seed = 2) |
|||
| 255 | -26x | +|||
| 25 | +
- dplyr::mutate(INVNAM = paste("Dr.", SITEID, "Doe")) %>%
+ #' adcm |
|||
| 256 | -26x | +|||
| 26 | +
- dplyr::mutate(USUBJID = paste(STUDYID, SITEID, SUBJID, sep = "-"))+ #' |
|||
| 257 | +27 |
-
+ #' adcm_who <- radcm(adsl, seed = 2, who_coding = TRUE) |
||
| 258 | +28 |
-
+ #' adcm_who |
||
| 259 | -26x | +|||
| 29 | +
- if (length(na_vars) > 0 && na_percentage > 0) {
+ radcm <- function(adsl, |
|||
| 260 | -! | +|||
| 30 | +
- adsl <- mutate_na(ds = adsl, na_vars = na_vars, na_percentage = na_percentage)+ max_n_cms = 10L, |
|||
| 261 | +31 |
- }+ lookup = NULL, |
||
| 262 | +32 |
-
+ seed = NULL, |
||
| 263 | +33 |
- # apply metadata+ na_percentage = 0, |
||
| 264 | -26x | +|||
| 34 | +
- adsl <- apply_metadata(adsl, "metadata/ADSL.yml", FALSE)+ na_vars = list(CMCLAS = c(NA, 0.1), CMDECOD = c(1234, 0.1), ATIREL = c(1234, 0.1)), |
|||
| 265 | +35 |
-
+ who_coding = FALSE,+ |
+ ||
| 36 | ++ |
+ cached = FALSE) {
|
||
| 266 | -26x | +37 | +5x |
- attr(adsl, "study_duration_secs") <- as.numeric(study_duration_secs)+ checkmate::assert_flag(cached) |
| 267 | -26x | +38 | +5x |
- return(adsl)+ if (cached) {
|
| 268 | -+ | |||
| 39 | +1x |
- }+ return(get_cached_data("cadcm"))
|
| 1 | +40 |
- #' Pharmacokinetics Parameters Dataset (ADPP)+ } |
||
| 2 | +41 |
- #'+ |
||
| 3 | -+ | |||
| 42 | +4x |
- #' @description `r lifecycle::badge("stable")`
+ checkmate::assert_data_frame(adsl) |
||
| 4 | -+ | |||
| 43 | +4x |
- #'+ checkmate::assert_integer(max_n_cms, len = 1, any.missing = FALSE) |
||
| 5 | -+ | |||
| 44 | +4x |
- #' Function for generating a random Pharmacokinetics Parameters Dataset for a given+ checkmate::assert_number(seed, null.ok = TRUE) |
||
| 6 | -+ | |||
| 45 | +4x |
- #' Subject-Level Analysis Dataset.+ checkmate::assert_number(na_percentage, lower = 0, upper = 1) |
||
| 7 | -+ | |||
| 46 | +4x |
- #'+ checkmate::assert_true(na_percentage < 1) |
||
| 8 | -+ | |||
| 47 | +4x |
- #' @details One record per study, subject, parameter category, parameter and visit.+ checkmate::assert_flag(who_coding) |
||
| 9 | +48 |
- #'+ + |
+ ||
| 49 | +4x | +
+ checkmate::assert_data_frame(lookup, null.ok = TRUE)+ |
+ ||
| 50 | +4x | +
+ lookup_cm <- if (!is.null(lookup)) {
+ |
+ ||
| 51 | +! | +
+ lookup |
||
| 10 | +52 |
- #' @inheritParams argument_convention+ } else {
|
||
| 11 | -+ | |||
| 53 | +4x |
- #' @param ppcat (`character vector`)\cr Categories of parameters.+ tibble::tribble( |
||
| 12 | -+ | |||
| 54 | +4x |
- #' @param ppspec (`character vector`)\cr Specimen material types.+ ~CMCLAS, ~CMDECOD, ~ATIREL, |
||
| 13 | -+ | |||
| 55 | +4x |
- #' @template param_cached+ "medcl A", "medname A_1/3", "PRIOR", |
||
| 14 | -+ | |||
| 56 | +4x |
- #' @templateVar data adpp+ "medcl A", "medname A_2/3", "CONCOMITANT", |
||
| 15 | -+ | |||
| 57 | +4x |
- #'+ "medcl A", "medname A_3/3", "CONCOMITANT", |
||
| 16 | -+ | |||
| 58 | +4x |
- #' @return `data.frame`+ "medcl B", "medname B_1/4", "CONCOMITANT", |
||
| 17 | -+ | |||
| 59 | +4x |
- #' @export+ "medcl B", "medname B_2/4", "PRIOR", |
||
| 18 | -+ | |||
| 60 | +4x |
- #'+ "medcl B", "medname B_3/4", "PRIOR", |
||
| 19 | -+ | |||
| 61 | +4x |
- #' @examples+ "medcl B", "medname B_4/4", "CONCOMITANT", |
||
| 20 | -+ | |||
| 62 | +4x |
- #' adsl <- radsl(N = 10, seed = 1, study_duration = 2)+ "medcl C", "medname C_1/2", "CONCOMITANT", |
||
| 21 | -+ | |||
| 63 | +4x |
- #'+ "medcl C", "medname C_2/2", "CONCOMITANT" |
||
| 22 | +64 |
- #' adpp <- radpp(adsl, seed = 2)+ ) |
||
| 23 | +65 |
- #' adpp+ } |
||
| 24 | +66 |
- radpp <- function(adsl,+ |
||
| 25 | -+ | |||
| 67 | +4x |
- ppcat = c("Plasma Drug X", "Plasma Drug Y", "Metabolite Drug X", "Metabolite Drug Y"),
+ if (!is.null(seed)) {
|
||
| 26 | -+ | |||
| 68 | +3x |
- ppspec = c(+ set.seed(seed) |
||
| 27 | +69 |
- "Plasma", "Plasma", "Plasma", "Matrix of PD", "Matrix of PD",+ } |
||
| 28 | -+ | |||
| 70 | +4x |
- "Urine", "Urine", "Urine", "Urine"+ study_duration_secs <- lubridate::seconds(attr(adsl, "study_duration_secs")) |
||
| 29 | +71 |
- ),+ |
||
| 30 | -+ | |||
| 72 | +4x |
- paramcd = c(+ adcm <- Map(function(id, sid) {
|
||
| 31 | -+ | |||
| 73 | +430x |
- "AUCIFO", "CMAX", "CLO", "RMAX", "TON",+ n_cms <- sample(c(0, seq_len(max_n_cms)), 1) |
||
| 32 | -+ | |||
| 74 | +430x |
- "RENALCL", "RENALCLD", "RCAMINT", "RCPCINT"+ i <- sample(seq_len(nrow(lookup_cm)), n_cms, TRUE) |
||
| 33 | -+ | |||
| 75 | +430x |
- ),+ dplyr::mutate( |
||
| 34 | -+ | |||
| 76 | +430x |
- param = c(+ lookup_cm[i, ], |
||
| 35 | -+ | |||
| 77 | +430x |
- "AUC Infinity Obs", "Max Conc", "Total CL Obs", "Time of Maximum Response",+ USUBJID = id, |
||
| 36 | -+ | |||
| 78 | +430x |
- "Time to Onset", "Renal CL", "Renal CL Norm by Dose",+ STUDYID = sid |
||
| 37 | +79 |
- "Amt Rec from T1 to T2", "Pct Rec from T1 to T2"+ ) |
||
| 38 | -+ | |||
| 80 | +4x |
- ),+ }, adsl$USUBJID, adsl$STUDYID) %>% |
||
| 39 | -+ | |||
| 81 | +4x |
- paramu = c("day*ug/mL", "ug/mL", "ml/day/kg", "hr", "hr", "L/hr", "L/hr/mg", "mg", "%"),
+ Reduce(rbind, .) %>% |
||
| 40 | -+ | |||
| 82 | +4x |
- aval_mean = c(200, 30, 5, 10, 3, 0.05, 0.005, 1.5613, 15.65),+ `[`(c(4, 5, 1, 2, 3)) %>% |
||
| 41 | -+ | |||
| 83 | +4x |
- visit_format = "CYCLE",+ dplyr::mutate(CMCAT = CMCLAS) |
||
| 42 | +84 |
- n_days = 2L,+ |
||
| 43 | -+ | |||
| 85 | +4x |
- seed = NULL,+ adcm <- var_relabel( |
||
| 44 | -+ | |||
| 86 | +4x |
- na_percentage = 0,+ adcm, |
||
| 45 | -+ | |||
| 87 | +4x |
- na_vars = list(+ STUDYID = "Study Identifier",+ |
+ ||
| 88 | +4x | +
+ USUBJID = "Unique Subject Identifier" |
||
| 46 | +89 |
- AVAL = c(NA, 0.1)+ ) |
||
| 47 | +90 |
- ),+ |
||
| 48 | +91 |
- cached = FALSE) {
+ # merge ADSL to be able to add CM date and study day variables |
||
| 49 | +92 | 4x |
- checkmate::assert_flag(cached)+ adcm <- dplyr::inner_join( |
|
| 50 | +93 | 4x |
- if (cached) {
+ adcm, |
|
| 51 | -1x | +94 | +4x |
- return(get_cached_data("cadlb"))
+ adsl, |
| 52 | -+ | |||
| 95 | +4x |
- }+ by = c("STUDYID", "USUBJID")
|
||
| 53 | +96 |
-
+ ) %>% |
||
| 54 | -3x | +97 | +4x |
- checkmate::assert_character(ppcat)+ dplyr::rowwise() %>% |
| 55 | -3x | +98 | +4x |
- checkmate::assert_character(ppspec)+ dplyr::mutate(TRTENDT = lubridate::date(dplyr::case_when( |
| 56 | -3x | +99 | +4x |
- checkmate::assert_character(paramcd)+ is.na(TRTEDTM) ~ lubridate::floor_date(lubridate::date(TRTSDTM) + study_duration_secs, unit = "day"), |
| 57 | -3x | +100 | +4x |
- checkmate::assert_character(param)+ TRUE ~ TRTEDTM |
| 58 | -3x | +|||
| 101 | +
- checkmate::assert_character(paramu)+ ))) %>% |
|||
| 59 | -3x | +102 | +4x |
- checkmate::assert_vector(aval_mean)+ dplyr::mutate(ASTDTM = sample( |
| 60 | -3x | +103 | +4x |
- checkmate::assert_string(visit_format)+ seq(lubridate::as_datetime(TRTSDTM), lubridate::as_datetime(TRTENDT), by = "day"), |
| 61 | -3x | +104 | +4x |
- checkmate::assert_integer(n_days)+ size = 1+ |
+
| 105 | ++ |
+ )) %>% |
||
| 62 | -3x | +106 | +4x |
- checkmate::assert_number(seed, null.ok = TRUE)+ dplyr::mutate(ASTDY = ceiling(difftime(ASTDTM, TRTSDTM, units = "days"))) %>%+ |
+
| 107 | ++ |
+ # add 1 to end of range incase both values passed to sample() are the same |
||
| 63 | -3x | +108 | +4x |
- checkmate::assert_number(na_percentage, lower = 0, upper = 1)+ dplyr::mutate(AENDTM = sample( |
| 64 | -3x | +109 | +4x |
- checkmate::assert_true(na_percentage < 1)+ seq(lubridate::as_datetime(ASTDTM), lubridate::as_datetime(TRTENDT + 1), by = "day"), |
| 65 | -3x | +110 | +4x |
- checkmate::assert_list(na_vars)+ size = 1 |
| 66 | +111 |
-
+ )) %>% |
||
| 67 | -3x | +112 | +4x |
- checkmate::assertTRUE(length(ppspec) == length(paramcd))+ dplyr::mutate(AENDY = ceiling(difftime(AENDTM, TRTSDTM, units = "days"))) %>% |
| 68 | -3x | +113 | +4x |
- checkmate::assertTRUE(length(ppspec) == length(param))+ dplyr::select(-TRTENDT) %>% |
| 69 | -3x | +114 | +4x |
- checkmate::assertTRUE(length(ppspec) == length(paramu))+ dplyr::ungroup() %>% |
| 70 | -3x | +115 | +4x |
- checkmate::assertTRUE(length(ppspec) == length(aval_mean))+ dplyr::arrange(STUDYID, USUBJID, ASTDTM) |
| 71 | +116 | |||
| 72 | -3x | +117 | +4x |
- if (!is.null(seed)) {
+ adcm <- adcm %>% |
| 73 | -3x | +118 | +4x |
- set.seed(seed)+ dplyr::group_by(USUBJID) %>% |
| 74 | -+ | |||
| 119 | +4x |
- }+ dplyr::mutate(CMSEQ = seq_len(dplyr::n())) %>% |
||
| 75 | -+ | |||
| 120 | +4x |
-
+ dplyr::mutate(ASEQ = CMSEQ) %>% |
||
| 76 | -+ | |||
| 121 | +4x |
- # validate and initialize related variables+ dplyr::ungroup() %>% |
||
| 77 | -3x | +122 | +4x |
- ppspec_init_list <- relvar_init(param, ppspec)+ dplyr::arrange(STUDYID, USUBJID, ASTDTM, CMSEQ) %>% |
| 78 | -3x | +123 | +4x |
- param_init_list <- relvar_init(param, paramcd)+ dplyr::mutate( |
| 79 | -3x | +124 | +4x |
- unit_init_list <- relvar_init(param, paramu)+ ATC1 = paste("ATCCLAS1", substr(CMDECOD, 9, 9)),
|
| 80 | -+ | |||
| 125 | +4x |
-
+ ATC2 = paste("ATCCLAS2", substr(CMDECOD, 9, 9)),
|
||
| 81 | -3x | +126 | +4x |
- adpp <- expand.grid(+ ATC3 = paste("ATCCLAS3", substr(CMDECOD, 9, 9)),
|
| 82 | -3x | +127 | +4x |
- STUDYID = unique(adsl$STUDYID),+ ATC4 = paste("ATCCLAS4", substr(CMDECOD, 9, 9))
+ |
+
| 128 | ++ |
+ ) %>% |
||
| 83 | -3x | +129 | +4x |
- USUBJID = adsl$USUBJID,+ dplyr::mutate(CMINDC = sample(c( |
| 84 | -3x | +130 | +4x |
- PPCAT = as.factor(ppcat),+ "Nausea", "Hypertension", "Urticaria", "Fever", |
| 85 | -3x | +131 | +4x |
- PARAM = as.factor(param_init_list$relvar1),+ "Asthma", "Infection", "Diabete", "Diarrhea", "Pneumonia" |
| 86 | -3x | +132 | +4x |
- AVISIT = visit_schedule(visit_format = visit_format, n_assessments = 1L, n_days = n_days),+ ), dplyr::n(), replace = TRUE)) %>% |
| 87 | -3x | +133 | +4x |
- stringsAsFactors = FALSE+ dplyr::mutate(CMDOSE = sample(1:99, dplyr::n(), replace = TRUE)) %>% |
| 88 | -+ | |||
| 134 | +4x |
- )+ dplyr::mutate(CMTRT = substr(CMDECOD, 9, 13)) %>% |
||
| 89 | -3x | +135 | +4x |
- adpp <- adpp %>%+ dplyr::mutate(CMDOSU = sample(c( |
| 90 | -3x | +136 | +4x |
- dplyr::mutate(AVAL = stats::rnorm(nrow(adpp), mean = 1, sd = 0.2)) %>%+ "ug/mL", "ug/kg/day", "%", "uL", "DROP", |
| 91 | -3x | +137 | +4x |
- dplyr::left_join(data.frame(PARAM = param, ADJUST = aval_mean), by = "PARAM") %>%+ "umol/L", "mg", "mg/breath", "ug" |
| 92 | -3x | +138 | +4x |
- dplyr::mutate(AVAL = AVAL * ADJUST) %>%+ ), dplyr::n(), replace = TRUE)) %>% |
| 93 | -3x | +139 | +4x |
- dplyr::select(-"ADJUST")+ dplyr::mutate(CMROUTE = sample(c( |
| 94 | -+ | |||
| 140 | +4x |
-
+ "INTRAVENOUS", "ORAL", "NASAL", |
||
| 95 | -+ | |||
| 141 | +4x |
- # assign related variable values: PARAMxPPSPEC are related+ "INTRAMUSCULAR", "SUBCUTANEOUS", "INHALED", "RECTAL", "UNKNOWN" |
||
| 96 | -3x | +142 | +4x |
- adpp <- adpp %>% rel_var(+ ), dplyr::n(), replace = TRUE)) %>% |
| 97 | -3x | +143 | +4x |
- var_name = "PPSPEC",+ dplyr::mutate(CMDOSFRQ = sample(c( |
| 98 | -3x | +144 | +4x |
- related_var = "PARAM",+ "Q4W", "QN", "Q4H", "UNKNOWN", "TWICE", |
| 99 | -3x | +145 | +4x |
- var_values = ppspec_init_list$relvar2+ "Q4H", "QD", "TID", "4 TIMES PER MONTH" |
| 100 | -+ | |||
| 146 | +4x |
- )+ ), dplyr::n(), replace = TRUE)) %>% |
||
| 101 | -+ | |||
| 147 | +4x |
-
+ dplyr::mutate( |
||
| 102 | +148 |
- # assign related variable values: PARAMxPARAMCD are related+ # use 1 year as reference time point |
||
| 103 | -3x | +149 | +4x |
- adpp <- adpp %>% rel_var(+ CMSTRTPT = dplyr::case_when( |
| 104 | -3x | +150 | +4x |
- var_name = "PARAMCD",+ ASTDY <= 365 ~ "BEFORE", |
| 105 | -3x | +151 | +4x |
- related_var = "PARAM",+ ASTDY > 365 ~ "AFTER", |
| 106 | -3x | +152 | +4x |
- var_values = param_init_list$relvar2+ is.na(ASTDY) ~ "U" |
| 107 | +153 |
- )+ ), |
||
| 108 | -+ | |||
| 154 | +4x |
-
+ CMENRTPT = dplyr::case_when( |
||
| 109 | -+ | |||
| 155 | +4x |
- # assign related variable values: PARAMxAVALU are related+ EOSSTT %in% c("COMPLETED", "DISCONTINUED") ~ "BEFORE",
|
||
| 110 | -3x | +156 | +4x |
- adpp <- adpp %>% rel_var(+ EOSSTT == "ONGOING" ~ "ONGOING", |
| 111 | -3x | +157 | +4x |
- var_name = "AVALU",+ is.na(EOSSTT) ~ "U"+ |
+
| 158 | ++ |
+ ), |
||
| 112 | -3x | +159 | +4x |
- related_var = "PARAM",+ ADURN = as.numeric(difftime(ASTDTM, AENDTM, units = "days")), |
| 113 | -3x | +160 | +4x |
- var_values = unit_init_list$relvar2+ ADURU = "days" |
| 114 | +161 |
- )+ ) |
||
| 115 | +162 | |||
| 116 | +163 |
- # derive AVISITN based AVISIT and AVALC based on AVAL+ + |
+ ||
| 164 | ++ |
+ # Optional WHO coding, which adds more `ATC` paths for randomly selected `CMDECOD`. |
||
| 117 | -3x | +165 | +4x |
- adpp <- adpp %>%+ if (who_coding) {
|
| 118 | -3x | +166 | +1x |
- dplyr::mutate(AVALC = as.character(AVAL)) %>%+ n_cmdecod_path2 <- ceiling(nrow(lookup_cm) / 2) |
| 119 | -3x | +167 | +1x |
- dplyr::mutate(+ cmdecod_path2 <- sample(lookup_cm$CMDECOD, n_cmdecod_path2) |
| 120 | -3x | +168 | +1x |
- AVISITN = dplyr::case_when(+ adcm_path2 <- adcm %>% |
| 121 | -3x | +169 | +1x |
- AVISIT == "SCREENING" ~ 0,+ dplyr::filter(CMDECOD %in% cmdecod_path2) %>% |
| 122 | -3x | +170 | +1x |
- (grepl("^WEEK", AVISIT) | grepl("^CYCLE", AVISIT)) ~ as.numeric(AVISIT) - 1,
+ dplyr::mutate( |
| 123 | -3x | +171 | +1x |
- TRUE ~ NA_real_+ ATC1 = paste(ATC1, "p2"), |
| 124 | -+ | |||
| 172 | +1x |
- )+ ATC2 = paste(ATC2, "p2"), |
||
| 125 | -+ | |||
| 173 | +1x |
- )+ ATC3 = paste(ATC3, "p2"),+ |
+ ||
| 174 | +1x | +
+ ATC4 = paste(ATC4, "p2") |
||
| 126 | +175 |
-
+ ) |
||
| 127 | +176 |
- # derive REGIMEN variable+ |
||
| 128 | -3x | +177 | +1x |
- adpp <- adpp %>% dplyr::mutate(REGIMEN = "BID")+ n_cmdecod_path3 <- ceiling(length(cmdecod_path2) / 2) |
| 129 | -+ | |||
| 178 | +1x |
-
+ cmdecod_path3 <- sample(cmdecod_path2, n_cmdecod_path3) |
||
| 130 | -+ | |||
| 179 | +1x |
- # derive PPSTINT and PPENINT based on PARAMCD+ adcm_path3 <- adcm %>% |
||
| 131 | -3x | +180 | +1x |
- t1_t2 <- data.frame(+ dplyr::filter(CMDECOD %in% cmdecod_path3) %>% |
| 132 | -3x | +181 | +1x |
- PARAMCD = c("RCAMINT", "RCAMINT", "RCPCINT", "RCPCINT"),
+ dplyr::mutate( |
| 133 | -3x | +182 | +1x |
- PPSTINT = c("P0H", "P0H", "P0H", "P0H"),
+ ATC1 = paste(ATC1, "p3"), |
| 134 | -3x | +183 | +1x |
- PPENINT = c("P12H", "P24H", "P12H", "P24H")
+ ATC2 = paste(ATC2, "p3"), |
| 135 | -+ | |||
| 184 | +1x |
- )+ ATC3 = paste(ATC3, "p3"), |
||
| 136 | -3x | +185 | +1x |
- adpp <- adpp %>%+ ATC4 = paste(ATC4, "p3") |
| 137 | -3x | +|||
| 186 | +
- dplyr::left_join(t1_t2, by = c("PARAMCD"), multiple = "all", relationship = "many-to-many")
+ ) |
|||
| 138 | +187 | |||
| 139 | -3x | +188 | +1x |
- adpp <- dplyr::inner_join(adpp, adsl, by = c("STUDYID", "USUBJID")) %>%
+ adcm <- dplyr::bind_rows( |
| 140 | -3x | +189 | +1x |
- dplyr::filter(+ adcm, |
| 141 | -3x | +190 | +1x |
- ACTARM != "B: Placebo",+ adcm_path2, |
| 142 | -3x | +191 | +1x |
- !(ACTARM == "A: Drug X" & (PPCAT == "Plasma Drug Y" | PPCAT == "Metabolite Drug Y"))+ adcm_path3 |
| 143 | +192 |
) |
||
| 144 | +193 |
-
+ } |
||
| 145 | +194 |
- # derive PKARMCD column for creating more cohorts+ |
||
| 146 | -3x | +195 | +4x |
- adpp <- adpp %>%+ adcm <- adcm %>% |
| 147 | -3x | +196 | +4x |
- dplyr::mutate(PKARMCD = factor(1 + (seq_len(nrow(adpp)) - 1) %/% (nrow(adpp) / 10), labels = c(+ dplyr::mutate( |
| 148 | -3x | +197 | +4x |
- "Drug A", "Drug B", "Drug C", "Drug D", "Drug E", "Drug F", "Drug G", "Drug H",+ ATC1CD = ATC1, |
| 149 | -3x | +198 | +4x |
- "Drug I", "Drug J"+ ATC2CD = ATC2,+ |
+
| 199 | +4x | +
+ ATC3CD = ATC3,+ |
+ ||
| 200 | +4x | +
+ ATC4CD = ATC4 |
||
| 150 | +201 |
- )))+ ) |
||
| 151 | +202 | |||
| 152 | -3x | +203 | +4x |
if (length(na_vars) > 0 && na_percentage > 0) {
|
| 153 | +204 | ! |
- adpp <- mutate_na(ds = adpp, na_vars = na_vars, na_percentage = na_percentage)+ adcm <- mutate_na(ds = adcm, na_vars = na_vars, na_percentage = na_percentage) |
|
| 154 | +205 |
} |
||
| 155 | +206 | |||
| 207 | ++ |
+ # apply metadata+ |
+ ||
| 156 | -3x | +208 | +4x |
- adpp <- apply_metadata(adpp, "metadata/ADPP.yml")+ adcm <- apply_metadata(adcm, "metadata/ADCM.yml")+ |
+
| 209 | ++ | + | ||
| 157 | -3x | +210 | +4x |
- return(adpp)+ return(adcm) |
| 158 | +211 |
}@@ -41714,14 +41434,14 @@ random.cdisc.data coverage - 98.86% |
| 1 |
- #' Previous and Concomitant Medications Analysis Dataset (ADCM)+ #' Anti-Drug Antibody Analysis Dataset (ADAB) |
||
| 5 |
- #' Function for generating random Concomitant Medication Analysis Dataset for a given+ #' Function for generating a random Anti-Drug Antibody Analysis Dataset for a given |
||
| 6 |
- #' Subject-Level Analysis Dataset.+ #' Subject-Level Analysis Dataset and Pharmacokinetics Analysis Dataset. |
||
| 8 |
- #' @details One record per each record in the corresponding SDTM domain.+ #' @inheritParams argument_convention |
||
| 9 |
- #'+ #' @inheritParams radpc |
||
| 10 |
- #' Keys: `STUDYID`, `USUBJID`, `ASTDTM`, `CMSEQ`+ #' @param adpc (`data.frame`)\cr Pharmacokinetics Analysis Dataset. |
||
| 11 |
- #'+ #' @template param_cached |
||
| 12 |
- #' @inheritParams argument_convention+ #' @templateVar data adab |
||
| 13 |
- #' @param max_n_cms (`integer`)\cr Maximum number of concomitant medications per patient. Defaults to 10.+ #' |
||
| 14 |
- #' @param who_coding (`flag`)\cr Whether WHO coding (with multiple paths per medication) should be used.+ #' @return `data.frame` |
||
| 15 |
- #' @template param_cached+ #' @export |
||
| 16 |
- #' @templateVar data adcm+ #' |
||
| 17 |
- #'+ #' @details One record per study per subject per parameter per time point: "R1800000", "RESULT1", "R1800001", "RESULT2". |
||
| 18 |
- #' @return `data.frame`+ #' |
||
| 19 |
- #' @export+ #' @examples |
||
| 20 |
- #'+ #' adsl <- radsl(N = 10, seed = 1, study_duration = 2) |
||
| 21 |
- #' @examples+ #' adpc <- radpc(adsl, seed = 2, duration = 9 * 7) |
||
| 22 |
- #' adsl <- radsl(N = 10, seed = 1, study_duration = 2)+ #' |
||
| 23 |
- #'+ #' adab <- radab(adsl, adpc, seed = 2) |
||
| 24 |
- #' adcm <- radcm(adsl, seed = 2)+ #' adab |
||
| 25 |
- #' adcm+ radab <- function(adsl, |
||
| 26 |
- #'+ adpc, |
||
| 27 |
- #' adcm_who <- radcm(adsl, seed = 2, who_coding = TRUE)+ constants = c(D = 100, ka = 0.8, ke = 1), |
||
| 28 |
- #' adcm_who+ paramcd = c( |
||
| 29 |
- radcm <- function(adsl,+ "R1800000", "RESULT1", "R1800001", "RESULT2", "ADASTAT1", "INDUCD1", "ENHANC1", |
||
| 30 |
- max_n_cms = 10L,+ "TRUNAFF1", "EMERNEG1", "EMERPOS1", "PERSADA1", "TRANADA1", "BFLAG1", "TIMADA1", |
||
| 31 |
- lookup = NULL,+ "ADADUR1", "ADASTAT2", "INDUCD2", "ENHANC2", "EMERNEG2", "EMERPOS2", "BFLAG2", |
||
| 32 |
- seed = NULL,+ "TRUNAFF2" |
||
| 33 |
- na_percentage = 0,+ ), |
||
| 34 |
- na_vars = list(CMCLAS = c(NA, 0.1), CMDECOD = c(1234, 0.1), ATIREL = c(1234, 0.1)),+ param = c( |
||
| 35 |
- who_coding = FALSE,+ "Antibody titer units", "ADA interpreted per sample result", |
||
| 36 |
- cached = FALSE) {
+ "Neutralizing Antibody titer units", "NAB interpreted per sample result", |
||
| 37 | -5x | +
- checkmate::assert_flag(cached)+ "ADA Status of a patient", "Treatment induced ADA", "Treatment enhanced ADA", |
|
| 38 | -5x | +
- if (cached) {
+ "Treatment unaffected", "Treatment Emergent - Negative", |
|
| 39 | -1x | +
- return(get_cached_data("cadcm"))
+ "Treatment Emergent - Positive", "Persistent ADA", "Transient ADA", "Baseline", |
|
| 40 |
- }+ "Time to onset of ADA", "ADA Duration", "NAB Status of a patient", |
||
| 41 |
-
+ "Treatment induced ADA, Neutralizing Antibody", |
||
| 42 | -4x | +
- checkmate::assert_data_frame(adsl)+ "Treatment enhanced ADA, Neutralizing Antibody", |
|
| 43 | -4x | +
- checkmate::assert_integer(max_n_cms, len = 1, any.missing = FALSE)+ "Treatment Emergent - Negative, Neutralizing Antibody", |
|
| 44 | -4x | +
- checkmate::assert_number(seed, null.ok = TRUE)+ "Treatment Emergent - Positive, Neutralizing Antibody", |
|
| 45 | -4x | +
- checkmate::assert_number(na_percentage, lower = 0, upper = 1)+ "Baseline, Neutralizing Antibody", |
|
| 46 | -4x | +
- checkmate::assert_true(na_percentage < 1)+ "Treatment unaffected, Neutralizing Antibody" |
|
| 47 | -4x | +
- checkmate::assert_flag(who_coding)+ ), |
|
| 48 |
-
+ avalu = c( |
||
| 49 | -4x | +
- checkmate::assert_data_frame(lookup, null.ok = TRUE)+ "titer", "", "titer", "", "", "", "", "", "", "", "", "", "", "weeks", "weeks", |
|
| 50 | -4x | +
- lookup_cm <- if (!is.null(lookup)) {
+ "", "", "", "", "", "", "" |
|
| 51 | -! | +
- lookup+ ), |
|
| 52 |
- } else {
+ seed = NULL, |
||
| 53 | -4x | +
- tibble::tribble(+ na_percentage = 0, |
|
| 54 | -4x | +
- ~CMCLAS, ~CMDECOD, ~ATIREL,+ na_vars = list( |
|
| 55 | -4x | +
- "medcl A", "medname A_1/3", "PRIOR",+ AVAL = c(NA, 0.1) |
|
| 56 | -4x | +
- "medcl A", "medname A_2/3", "CONCOMITANT",+ ), |
|
| 57 | -4x | +
- "medcl A", "medname A_3/3", "CONCOMITANT",+ cached = FALSE) {
|
|
| 58 | 4x |
- "medcl B", "medname B_1/4", "CONCOMITANT",+ checkmate::assert_flag(cached) |
|
| 59 | 4x |
- "medcl B", "medname B_2/4", "PRIOR",+ if (cached) {
|
|
| 60 | -4x | +1x |
- "medcl B", "medname B_3/4", "PRIOR",+ return(get_cached_data("cadab"))
|
| 61 | -4x | +
- "medcl B", "medname B_4/4", "CONCOMITANT",+ } |
|
| 62 | -4x | +
- "medcl C", "medname C_1/2", "CONCOMITANT",+ |
|
| 63 | -4x | +3x |
- "medcl C", "medname C_2/2", "CONCOMITANT"+ checkmate::assert_data_frame(adpc) |
| 64 | -+ | 3x |
- )+ checkmate::assert_subset(names(constants), c("D", "ka", "ke"))
|
| 65 | -+ | 3x |
- }+ checkmate::assert_number(seed, null.ok = TRUE) |
| 66 | -+ | 3x |
-
+ checkmate::assert_number(na_percentage, lower = 0, upper = 1, na.ok = TRUE) |
| 67 | -4x | +3x |
- if (!is.null(seed)) {
+ checkmate::assert_list(na_vars) |
| 68 | 3x |
- set.seed(seed)+ checkmate::assert_character(paramcd) |
|
| 69 | -+ | 3x |
- }+ checkmate::assert_character(param, len = length(paramcd)) |
| 70 | -4x | +3x |
- study_duration_secs <- lubridate::seconds(attr(adsl, "study_duration_secs"))+ checkmate::assert_character(avalu, len = length(paramcd)) |
| 71 | -+ | 3x |
-
+ checkmate::assert_number(na_percentage, lower = 0, upper = 1) |
| 72 | -4x | +3x |
- adcm <- Map(function(id, sid) {
+ checkmate::assert_true(na_percentage < 1) |
| 73 | -430x | +
- n_cms <- sample(c(0, seq_len(max_n_cms)), 1)+ |
|
| 74 | -430x | +3x |
- i <- sample(seq_len(nrow(lookup_cm)), n_cms, TRUE)+ if (!is.null(seed)) {
|
| 75 | -430x | +3x |
- dplyr::mutate(+ set.seed(seed) |
| 76 | -430x | +
- lookup_cm[i, ],+ } |
|
| 77 | -430x | +
- USUBJID = id,+ |
|
| 78 | -430x | +
- STUDYID = sid+ # validate and initialize related variables |
|
| 79 | -+ | 3x |
- )+ param_init_list <- relvar_init(param, paramcd) |
| 80 | -4x | +3x |
- }, adsl$USUBJID, adsl$STUDYID) %>%+ unit_init_list <- relvar_init(param, avalu) |
| 81 | -4x | +
- Reduce(rbind, .) %>%+ |
|
| 82 | -4x | +3x |
- `[`(c(4, 5, 1, 2, 3)) %>%+ adpc <- adpc %>% dplyr::filter(ASMED == "PLASMA") |
| 83 | -4x | +3x |
- dplyr::mutate(CMCAT = CMCLAS)+ adab0 <- expand.grid( |
| 84 | -+ | 3x |
-
+ STUDYID = unique(adsl$STUDYID), |
| 85 | -4x | +3x |
- adcm <- var_relabel(+ USUBJID = unique(adsl$USUBJID), |
| 86 | -4x | +3x |
- adcm,+ VISIT = unique(adpc$VISIT), |
| 87 | -4x | +3x |
- STUDYID = "Study Identifier",+ PARAM = as.factor(param_init_list$relvar1[c(1:4)]), |
| 88 | -4x | +3x |
- USUBJID = "Unique Subject Identifier"+ PARCAT1 = "A: Drug X Antibody", |
| 89 | -+ | 3x |
- )+ stringsAsFactors = FALSE |
| 90 |
-
+ ) |
||
| 91 |
- # merge ADSL to be able to add CM date and study day variables+ # Set random values for observations |
||
| 92 | -4x | +3x |
- adcm <- dplyr::inner_join(+ visit_lvl_params <- c( |
| 93 | -4x | +3x |
- adcm,+ "Antibody titer units", "Neutralizing Antibody titer units", |
| 94 | -4x | +3x |
- adsl,+ "ADA interpreted per sample result", "NAB interpreted per sample result" |
| 95 | -4x | +
- by = c("STUDYID", "USUBJID")
+ ) |
|
| 96 | -+ | 3x |
- ) %>%+ aval_random <- stats::rnorm(nrow(unique(adab0 %>% dplyr::select(USUBJID, VISIT))), mean = 1, sd = 0.2) |
| 97 | -4x | +3x |
- dplyr::rowwise() %>%+ aval_random <- cbind(unique(adab0 %>% dplyr::select(USUBJID, VISIT)), AVAL1 = aval_random) |
| 98 | -4x | +
- dplyr::mutate(TRTENDT = lubridate::date(dplyr::case_when(+ |
|
| 99 | -4x | +3x |
- is.na(TRTEDTM) ~ lubridate::floor_date(lubridate::date(TRTSDTM) + study_duration_secs, unit = "day"),+ adab_visit <- adab0 %>% dplyr::left_join(aval_random, by = c("USUBJID", "VISIT"))
|
| 100 | -4x | +3x |
- TRUE ~ TRTEDTM+ adab_visit <- adab_visit %>% |
| 101 | -+ | 3x |
- ))) %>%+ dplyr::mutate( |
| 102 | -4x | +3x |
- dplyr::mutate(ASTDTM = sample(+ AVAL2 = ifelse(AVAL1 >= 1, AVAL1, NA), |
| 103 | -4x | +3x |
- seq(lubridate::as_datetime(TRTSDTM), lubridate::as_datetime(TRTENDT), by = "day"),+ AVALC = dplyr::case_when( |
| 104 | -4x | +3x |
- size = 1+ !is.na(AVAL2) ~ "POSITIVE", |
| 105 | -+ | 3x |
- )) %>%+ is.na(AVAL2) ~ "NEGATIVE" |
| 106 | -4x | +
- dplyr::mutate(ASTDY = ceiling(difftime(ASTDTM, TRTSDTM, units = "days"))) %>%+ ), |
|
| 107 | -+ | 3x |
- # add 1 to end of range incase both values passed to sample() are the same+ AVAL = dplyr::case_when( |
| 108 | -4x | +3x |
- dplyr::mutate(AENDTM = sample(+ (PARAM %in% visit_lvl_params[3:4] & !is.na(AVAL2)) ~ 1, |
| 109 | -4x | +3x |
- seq(lubridate::as_datetime(ASTDTM), lubridate::as_datetime(TRTENDT + 1), by = "day"),+ (PARAM %in% visit_lvl_params[3:4] & is.na(AVAL2)) ~ 0, |
| 110 | -4x | +3x |
- size = 1+ (PARAM %in% visit_lvl_params[1:2] & !is.na(AVAL2)) ~ AVAL2, |
| 111 | -+ | 3x |
- )) %>%+ TRUE ~ as.numeric(NA) |
| 112 | -4x | +
- dplyr::mutate(AENDY = ceiling(difftime(AENDTM, TRTSDTM, units = "days"))) %>%+ ) |
|
| 113 | -4x | +
- dplyr::select(-TRTENDT) %>%+ ) %>% |
|
| 114 | -4x | +3x |
- dplyr::ungroup() %>%+ dplyr::select(-c(AVAL1, AVAL2)) |
| 115 | -4x | +
- dplyr::arrange(STUDYID, USUBJID, ASTDTM)+ |
|
| 116 |
-
+ # retrieve other variables from adpc |
||
| 117 | -4x | +3x |
- adcm <- adcm %>%+ adab_visit <- adab_visit %>% |
| 118 | -4x | +3x |
- dplyr::group_by(USUBJID) %>%+ dplyr::inner_join( |
| 119 | -4x | +3x |
- dplyr::mutate(CMSEQ = seq_len(dplyr::n())) %>%+ adpc %>% |
| 120 | -4x | +3x |
- dplyr::mutate(ASEQ = CMSEQ) %>%+ dplyr::filter(PCTPT %in% c("Predose", "24H")) %>%
|
| 121 | -4x | +3x |
- dplyr::ungroup() %>%+ dplyr::select( |
| 122 | -4x | +3x |
- dplyr::arrange(STUDYID, USUBJID, ASTDTM, CMSEQ) %>%+ STUDYID, |
| 123 | -4x | +3x |
- dplyr::mutate(+ USUBJID, |
| 124 | -4x | +3x |
- ATC1 = paste("ATCCLAS1", substr(CMDECOD, 9, 9)),
+ VISIT, |
| 125 | -4x | +3x |
- ATC2 = paste("ATCCLAS2", substr(CMDECOD, 9, 9)),
+ PCTPT, |
| 126 | -4x | +3x |
- ATC3 = paste("ATCCLAS3", substr(CMDECOD, 9, 9)),
+ ARM, |
| 127 | -4x | +3x |
- ATC4 = paste("ATCCLAS4", substr(CMDECOD, 9, 9))
+ ACTARM, |
| 128 | -+ | 3x |
- ) %>%+ VISITDY, |
| 129 | -4x | +3x |
- dplyr::mutate(CMINDC = sample(c(+ AFRLT, |
| 130 | -4x | +3x |
- "Nausea", "Hypertension", "Urticaria", "Fever",+ NFRLT, |
| 131 | -4x | +3x |
- "Asthma", "Infection", "Diabete", "Diarrhea", "Pneumonia"+ ARRLT, |
| 132 | -4x | +3x |
- ), dplyr::n(), replace = TRUE)) %>%+ NRRLT, |
| 133 | -4x | +3x |
- dplyr::mutate(CMDOSE = sample(1:99, dplyr::n(), replace = TRUE)) %>%+ RELTMU |
| 134 | -4x | +
- dplyr::mutate(CMTRT = substr(CMDECOD, 9, 13)) %>%+ ) %>% |
|
| 135 | -4x | +3x |
- dplyr::mutate(CMDOSU = sample(c(+ unique(), |
| 136 | -4x | +3x |
- "ug/mL", "ug/kg/day", "%", "uL", "DROP",+ by = c("STUDYID", "USUBJID", "VISIT")
|
| 137 | -4x | +
- "umol/L", "mg", "mg/breath", "ug"+ ) %>% |
|
| 138 | -4x | +3x |
- ), dplyr::n(), replace = TRUE)) %>%+ rename(ISTPT = PCTPT) |
| 139 | -4x | +
- dplyr::mutate(CMROUTE = sample(c(+ |
|
| 140 | -4x | +
- "INTRAVENOUS", "ORAL", "NASAL",+ # mutate time from dose variables from adpc to convert into Days |
|
| 141 | -4x | +3x |
- "INTRAMUSCULAR", "SUBCUTANEOUS", "INHALED", "RECTAL", "UNKNOWN"+ adab_visit <- adab_visit %>% dplyr::mutate_at(c("AFRLT", "NFRLT", "ARRLT", "NRRLT"), ~ . / 24)
|
| 142 | -4x | +
- ), dplyr::n(), replace = TRUE)) %>%+ |
|
| 143 | -4x | +
- dplyr::mutate(CMDOSFRQ = sample(c(+ |
|
| 144 | -4x | +
- "Q4W", "QN", "Q4H", "UNKNOWN", "TWICE",+ |
|
| 145 | -4x | +
- "Q4H", "QD", "TID", "4 TIMES PER MONTH"+ # Set random values for subject level paramaters (Y/N) |
|
| 146 | -4x | +
- ), dplyr::n(), replace = TRUE)) %>%+ |
|
| 147 | -4x | +3x |
- dplyr::mutate(+ adab1 <- expand.grid( |
| 148 | -+ | 3x |
- # use 1 year as reference time point+ STUDYID = unique(adsl$STUDYID), |
| 149 | -4x | +3x |
- CMSTRTPT = dplyr::case_when(+ USUBJID = unique(adpc$USUBJID), |
| 150 | -4x | +3x |
- ASTDY <= 365 ~ "BEFORE",+ VISIT = NA, |
| 151 | -4x | +3x |
- ASTDY > 365 ~ "AFTER",+ PARAM = as.factor(param_init_list$relvar1[c(5:13, 16:22)]), |
| 152 | -4x | +3x |
- is.na(ASTDY) ~ "U"+ PARCAT1 = "A: Drug X Antibody", |
| 153 | -+ | 3x |
- ),+ stringsAsFactors = FALSE |
| 154 | -4x | +
- CMENRTPT = dplyr::case_when(+ ) |
|
| 155 | -4x | +
- EOSSTT %in% c("COMPLETED", "DISCONTINUED") ~ "BEFORE",
+
|
|
| 156 | -4x | +3x |
- EOSSTT == "ONGOING" ~ "ONGOING",+ sub_lvl_params <- c( |
| 157 | -4x | +3x |
- is.na(EOSSTT) ~ "U"+ "ADA Status of a patient", "Treatment induced ADA", "Treatment enhanced ADA", |
| 158 | -+ | 3x |
- ),+ "Treatment unaffected", "Treatment Emergent - Negative", |
| 159 | -4x | +3x |
- ADURN = as.numeric(difftime(ASTDTM, AENDTM, units = "days")),+ "Treatment Emergent - Positive", "Persistent ADA", "Transient ADA", "Baseline", |
| 160 | -4x | +
- ADURU = "days"+ # "Time to onset of ADA", "ADA Duration", |
|
| 161 | -+ | 3x |
- )+ "NAB Status of a patient", |
| 162 | -+ | 3x |
-
+ "Treatment induced ADA, Neutralizing Antibody", |
| 163 | -+ | 3x |
-
+ "Treatment enhanced ADA, Neutralizing Antibody", |
| 164 | -+ | 3x |
- # Optional WHO coding, which adds more `ATC` paths for randomly selected `CMDECOD`.+ "Treatment Emergent - Negative, Neutralizing Antibody", |
| 165 | -4x | +3x |
- if (who_coding) {
+ "Treatment Emergent - Positive, Neutralizing Antibody", |
| 166 | -1x | +3x |
- n_cmdecod_path2 <- ceiling(nrow(lookup_cm) / 2)+ "Baseline, Neutralizing Antibody", |
| 167 | -1x | +3x |
- cmdecod_path2 <- sample(lookup_cm$CMDECOD, n_cmdecod_path2)+ "Treatment unaffected, Neutralizing Antibody" |
| 168 | -1x | +
- adcm_path2 <- adcm %>%+ ) |
|
| 169 | -1x | +
- dplyr::filter(CMDECOD %in% cmdecod_path2) %>%+ |
|
| 170 | -1x | +3x |
- dplyr::mutate(+ aval_random_sub <- stats::rbinom(nrow(unique(adab1 %>% dplyr::select(USUBJID))), 1, 0.5) |
| 171 | -1x | +3x |
- ATC1 = paste(ATC1, "p2"),+ aval_random_sub <- cbind(unique(adab1 %>% dplyr::select(USUBJID)), AVAL1 = aval_random_sub) |
| 172 | -1x | +
- ATC2 = paste(ATC2, "p2"),+ |
|
| 173 | -1x | +3x |
- ATC3 = paste(ATC3, "p2"),+ adab_sub <- adab1 %>% dplyr::left_join(aval_random_sub, by = c("USUBJID"))
|
| 174 | -1x | +3x |
- ATC4 = paste(ATC4, "p2")+ adab_sub <- adab_sub %>% |
| 175 | -+ | 3x |
- )+ dplyr::mutate( |
| 176 | -+ | 3x |
-
+ AVAL = AVAL1, |
| 177 | -1x | +3x |
- n_cmdecod_path3 <- ceiling(length(cmdecod_path2) / 2)+ AVALC = dplyr::case_when( |
| 178 | -1x | +3x |
- cmdecod_path3 <- sample(cmdecod_path2, n_cmdecod_path3)+ PARAM %in% c("ADA Status of a patient", "NAB Status of a patient") & AVAL1 == 1 ~ "POSITIVE",
|
| 179 | -1x | +3x |
- adcm_path3 <- adcm %>%+ PARAM %in% c("ADA Status of a patient", "NAB Status of a patient") & AVAL1 == 0 ~ "NEGATIVE",
|
| 180 | -1x | +3x |
- dplyr::filter(CMDECOD %in% cmdecod_path3) %>%+ !(PARAM %in% c("ADA Status of a patient", "NAB Status of a patient")) & AVAL1 == 1 ~ "Y",
|
| 181 | -1x | +3x |
- dplyr::mutate(+ !(PARAM %in% c("ADA Status of a patient", "NAB Status of a patient")) & AVAL1 == 0 ~ "N"
|
| 182 | -1x | +
- ATC1 = paste(ATC1, "p3"),+ ) |
|
| 183 | -1x | +
- ATC2 = paste(ATC2, "p3"),+ ) %>% |
|
| 184 | -1x | +3x |
- ATC3 = paste(ATC3, "p3"),+ dplyr::select(-c(AVAL1)) |
| 185 | -1x | +
- ATC4 = paste(ATC4, "p3")+ |
|
| 186 |
- )+ # Set random values for subject level paramaters (numeric) |
||
| 188 | -1x | +3x |
- adcm <- dplyr::bind_rows(+ adab2 <- expand.grid( |
| 189 | -1x | +3x |
- adcm,+ STUDYID = unique(adsl$STUDYID), |
| 190 | -1x | +3x |
- adcm_path2,+ USUBJID = unique(adpc$USUBJID), |
| 191 | -1x | +3x |
- adcm_path3+ VISIT = NA, |
| 192 | -+ | 3x |
- )+ PARAM = as.factor(param_init_list$relvar1[c(14, 15)]), |
| 193 | -+ | 3x |
- }+ PARCAT1 = "A: Drug X Antibody", |
| 194 | -+ | 3x |
-
+ stringsAsFactors = FALSE |
| 195 | -4x | +
- adcm <- adcm %>%+ ) |
|
| 196 | -4x | +
- dplyr::mutate(+ |
|
| 197 | -4x | +3x |
- ATC1CD = ATC1,+ sub_lvl_params_num <- c("Time to onset of ADA", "ADA Duration")
|
| 198 | -4x | +
- ATC2CD = ATC2,+ |
|
| 199 | -4x | +3x |
- ATC3CD = ATC3,+ aval_random_sub_num <- stats::rnorm(nrow(unique(adab2 %>% dplyr::select(USUBJID))), mean = 1, sd = 1) |
| 200 | -4x | +3x |
- ATC4CD = ATC4+ aval_random_sub_num <- cbind(unique(adab2 %>% dplyr::select(USUBJID)), AVAL1 = aval_random_sub_num) |
| 201 |
- )+ |
||
| 202 | -+ | 3x |
-
+ adab_sub_num <- adab2 %>% dplyr::left_join(aval_random_sub_num, by = c("USUBJID"))
|
| 203 | -4x | +3x |
- if (length(na_vars) > 0 && na_percentage > 0) {
+ adab_sub_num <- adab_sub_num %>% |
| 204 | -! | +3x |
- adcm <- mutate_na(ds = adcm, na_vars = na_vars, na_percentage = na_percentage)+ dplyr::mutate( |
| 205 | -+ | 3x |
- }+ AVAL = ifelse(AVAL1 >= 1, round(AVAL1, 2), NA), |
| 206 | -+ | 3x |
-
+ AVALC = as.character(AVAL) |
| 207 |
- # apply metadata+ ) %>% |
||
| 208 | -4x | +3x |
- adcm <- apply_metadata(adcm, "metadata/ADCM.yml")+ dplyr::select(-c(AVAL1)) |
| 210 | -4x | -
- return(adcm)- |
- |
| 211 | -- |
- }- |
-
| 1 | -- |
- #' Anti-Drug Antibody Analysis Dataset (ADAB)- |
- ||
| 2 | -- |
- #'- |
- ||
| 3 | -- |
- #' @description `r lifecycle::badge("stable")`
- |
- ||
| 4 | -- |
- #'- |
- ||
| 5 | -- |
- #' Function for generating a random Anti-Drug Antibody Analysis Dataset for a given- |
- ||
| 6 | -- |
- #' Subject-Level Analysis Dataset and Pharmacokinetics Analysis Dataset.- |
- ||
| 7 | -- |
- #'- |
- ||
| 8 | -- |
- #' @inheritParams argument_convention- |
- ||
| 9 | -- |
- #' @inheritParams radpc- |
- ||
| 10 | -- |
- #' @param adpc (`data.frame`)\cr Pharmacokinetics Analysis Dataset.- |
- ||
| 11 | -- |
- #' @template param_cached- |
- ||
| 12 | -- |
- #' @templateVar data adab- |
- ||
| 13 | -- |
- #'- |
- ||
| 14 | -- |
- #' @return `data.frame`- |
- ||
| 15 | -- |
- #' @export- |
- ||
| 16 | -- |
- #'- |
- ||
| 17 | -- |
- #' @details One record per study per subject per parameter per time point: "R1800000", "RESULT1", "R1800001", "RESULT2".- |
- ||
| 18 | -- |
- #'- |
- ||
| 19 | -- |
- #' @examples- |
- ||
| 20 | -- |
- #' adsl <- radsl(N = 10, seed = 1, study_duration = 2)- |
- ||
| 21 | -- |
- #' adpc <- radpc(adsl, seed = 2, duration = 9 * 7)- |
- ||
| 22 | -- |
- #'- |
- ||
| 23 | -- |
- #' adab <- radab(adsl, adpc, seed = 2)- |
- ||
| 24 | +210 |
- #' adab+ |
||
| 25 | -+ | |||
| 211 | +3x |
- radab <- function(adsl,+ adab <- bind_rows(adab_visit, adab_sub, adab_sub_num) |
||
| 26 | +212 |
- adpc,+ |
||
| 27 | +213 |
- constants = c(D = 100, ka = 0.8, ke = 1),+ |
||
| 28 | +214 |
- paramcd = c(+ # assign related variable values: PARAMxPARAMCD are related |
||
| 29 | -+ | |||
| 215 | +3x |
- "R1800000", "RESULT1", "R1800001", "RESULT2", "ADASTAT1", "INDUCD1", "ENHANC1",+ adab <- adab %>% rel_var( |
||
| 30 | -+ | |||
| 216 | +3x |
- "TRUNAFF1", "EMERNEG1", "EMERPOS1", "PERSADA1", "TRANADA1", "BFLAG1", "TIMADA1",+ var_name = "PARAMCD", |
||
| 31 | -+ | |||
| 217 | +3x |
- "ADADUR1", "ADASTAT2", "INDUCD2", "ENHANC2", "EMERNEG2", "EMERPOS2", "BFLAG2",+ related_var = "PARAM", |
||
| 32 | -+ | |||
| 218 | +3x |
- "TRUNAFF2"+ var_values = param_init_list$relvar2 |
||
| 33 | +219 |
- ),+ ) |
||
| 34 | +220 |
- param = c(+ |
||
| 35 | +221 |
- "Antibody titer units", "ADA interpreted per sample result",+ # assign related variable values: PARAMxAVALU are related |
||
| 36 | -+ | |||
| 222 | +3x |
- "Neutralizing Antibody titer units", "NAB interpreted per sample result",+ adab <- adab %>% rel_var( |
||
| 37 | -+ | |||
| 223 | +3x |
- "ADA Status of a patient", "Treatment induced ADA", "Treatment enhanced ADA",+ var_name = "AVALU", |
||
| 38 | -+ | |||
| 224 | +3x |
- "Treatment unaffected", "Treatment Emergent - Negative",+ related_var = "PARAM", |
||
| 39 | -+ | |||
| 225 | +3x |
- "Treatment Emergent - Positive", "Persistent ADA", "Transient ADA", "Baseline",+ var_values = unit_init_list$relvar2 |
||
| 40 | +226 |
- "Time to onset of ADA", "ADA Duration", "NAB Status of a patient",+ ) |
||
| 41 | +227 |
- "Treatment induced ADA, Neutralizing Antibody",+ |
||
| 42 | +228 |
- "Treatment enhanced ADA, Neutralizing Antibody",+ |
||
| 43 | -+ | |||
| 229 | +3x |
- "Treatment Emergent - Negative, Neutralizing Antibody",+ adab <- adab %>% |
||
| 44 | -+ | |||
| 230 | +3x |
- "Treatment Emergent - Positive, Neutralizing Antibody",+ dplyr::mutate( |
||
| 45 | -+ | |||
| 231 | +3x |
- "Baseline, Neutralizing Antibody",+ RELTMU = "day", |
||
| 46 | -+ | |||
| 232 | +3x |
- "Treatment unaffected, Neutralizing Antibody"+ ABLFL = ifelse(!is.na(NFRLT) & NFRLT == 0, "Y", NA) # Baseline Record Flag |
||
| 47 | +233 |
- ),+ , |
||
| 48 | -+ | |||
| 234 | +3x |
- avalu = c(+ ADABLPFL = ifelse(PARAMCD == "RESULT1" & !is.na(NFRLT) & NFRLT == 0, "Y", NA) |
||
| 49 | +235 |
- "titer", "", "titer", "", "", "", "", "", "", "", "", "", "", "weeks", "weeks",+ # Baseline ADA Eval. Param-Level Flag, only populate for ADA, not for NAB |
||
| 50 | +236 |
- "", "", "", "", "", "", ""+ , |
||
| 51 | -+ | |||
| 237 | +3x |
- ),+ ADPBLPFL = ifelse(PARAMCD == "RESULT1" & !is.na(NFRLT) & NFRLT > 0 & !is.na(AVAL), "Y", NA) |
||
| 52 | +238 |
- seed = NULL,+ # Post-Baseline ADA Eval. Param-Level Flag, only populate for ADA, not for NAB |
||
| 53 | +239 |
- na_percentage = 0,+ ) %>% |
||
| 54 | -+ | |||
| 240 | +3x |
- na_vars = list(+ dplyr::group_by(USUBJID) %>% |
||
| 55 | -+ | |||
| 241 | +3x |
- AVAL = c(NA, 0.1)+ dplyr::ungroup() |
||
| 56 | +242 |
- ),+ |
||
| 57 | +243 |
- cached = FALSE) {
+ # create temporary flags to derive subject-level variables |
||
| 58 | -4x | +244 | +3x |
- checkmate::assert_flag(cached)+ adab_subj <- adab %>% |
| 59 | -4x | +245 | +3x |
- if (cached) {
+ dplyr::group_by(USUBJID) %>% |
| 60 | -1x | +246 | +3x |
- return(get_cached_data("cadab"))
+ dplyr::mutate( |
| 61 | -+ | |||
| 247 | +3x |
- }+ pos_bl = any(PARAM == "ADA interpreted per sample result" & !is.na(ABLFL) & AVALC == "POSITIVE"), |
||
| 62 | -+ | |||
| 248 | +3x |
-
+ pos_bl_nab = any(PARAM == "NAB interpreted per sample result" & !is.na(ABLFL) & AVALC == "POSITIVE"), |
||
| 63 | +249 | 3x |
- checkmate::assert_data_frame(adpc)+ any_pos_postbl = any(PARAM == "ADA interpreted per sample result" & is.na(ABLFL) & AVALC == "POSITIVE"), |
|
| 64 | +250 | 3x |
- checkmate::assert_subset(names(constants), c("D", "ka", "ke"))
+ any_pos_postbl_nab = any(PARAM == "NAB interpreted per sample result" & is.na(ABLFL) & AVALC == "POSITIVE"), |
|
| 65 | +251 | 3x |
- checkmate::assert_number(seed, null.ok = TRUE)+ pos_last_postbl = any(PARAM == "ADA interpreted per sample result" & NFRLT == max(NFRLT) & AVALC == "POSITIVE"), |
|
| 66 | +252 | 3x |
- checkmate::assert_number(na_percentage, lower = 0, upper = 1, na.ok = TRUE)+ ada_bl = AVAL[PARAM == "Antibody titer units" & !is.na(ABLFL)], |
|
| 67 | +253 | 3x |
- checkmate::assert_list(na_vars)+ nab_bl = AVAL[PARAM == "Neutralizing Antibody titer units" & !is.na(ABLFL)]+ |
+ |
| 254 | ++ |
+ ) |
||
| 68 | +255 | 3x |
- checkmate::assert_character(paramcd)+ pos_tots <- adab_subj %>% |
|
| 69 | +256 | 3x |
- checkmate::assert_character(param, len = length(paramcd))+ dplyr::summarise( |
|
| 70 | +257 | 3x |
- checkmate::assert_character(avalu, len = length(paramcd))+ n_pos = sum(PARAM == "ADA interpreted per sample result" & AVALC == "POSITIVE"), |
|
| 71 | +258 | 3x |
- checkmate::assert_number(na_percentage, lower = 0, upper = 1)+ inc_postbl = sum(PARAM == "ADA interpreted per sample result" & is.na(ABLFL) & (AVAL - ada_bl) > 0.60), |
|
| 72 | +259 | 3x |
- checkmate::assert_true(na_percentage < 1)+ inc_postbl_nab = sum(PARAM == "NAB interpreted per sample result" & is.na(ABLFL) & (AVAL - nab_bl) > 0.60),+ |
+ |
| 260 | +3x | +
+ onset_ada = if (any(PARAM == "ADA interpreted per sample result" & AVALC == "POSITIVE")) {
+ |
+ ||
| 261 | +18x | +
+ min(NFRLT[PARAM == "ADA interpreted per sample result" & AVALC == "POSITIVE"]) |
||
| 73 | +262 |
-
+ } else {
|
||
| 74 | +263 | 3x |
- if (!is.null(seed)) {
+ NA+ |
+ |
| 264 | ++ |
+ }, |
||
| 75 | +265 | 3x |
- set.seed(seed)+ last_ada = if (any(PARAM == "ADA interpreted per sample result" & AVALC == "POSITIVE")) {
+ |
+ |
| 266 | +18x | +
+ max(NFRLT[PARAM == "ADA interpreted per sample result" & AVALC == "POSITIVE"]) |
||
| 76 | +267 |
- }+ } else {
+ |
+ ||
| 268 | +3x | +
+ NA |
||
| 77 | +269 |
-
+ } |
||
| 78 | +270 |
- # validate and initialize related variables+ ) |
||
| 79 | +271 | 3x |
- param_init_list <- relvar_init(param, paramcd)+ adab_subj <- adab_subj %>% |
|
| 80 | +272 | 3x |
- unit_init_list <- relvar_init(param, avalu)- |
- |
| 81 | -- |
-
+ dplyr::left_join(pos_tots, by = "USUBJID") %>% |
||
| 82 | +273 | 3x |
- adpc <- adpc %>% dplyr::filter(ASMED == "PLASMA")+ dplyr::select( |
|
| 83 | +274 | 3x |
- adab0 <- expand.grid(+ USUBJID, |
|
| 84 | +275 | 3x |
- STUDYID = unique(adsl$STUDYID),+ NFRLT, |
|
| 85 | +276 | 3x |
- USUBJID = unique(adsl$USUBJID),+ pos_bl, |
|
| 86 | +277 | 3x |
- VISIT = unique(adpc$VISIT),+ pos_bl_nab, |
|
| 87 | +278 | 3x |
- PARAM = as.factor(param_init_list$relvar1[c(1:4)]),+ any_pos_postbl, |
|
| 88 | +279 | 3x |
- PARCAT1 = "A: Drug X Antibody",+ any_pos_postbl_nab, |
|
| 89 | +280 | 3x |
- stringsAsFactors = FALSE+ inc_postbl, |
|
| 90 | -+ | |||
| 281 | +3x |
- )+ inc_postbl_nab, |
||
| 91 | -+ | |||
| 282 | +3x |
- # Set random values for observations+ pos_last_postbl, |
||
| 92 | +283 | 3x |
- visit_lvl_params <- c(+ n_pos, |
|
| 93 | +284 | 3x |
- "Antibody titer units", "Neutralizing Antibody titer units",+ onset_ada, |
|
| 94 | +285 | 3x |
- "ADA interpreted per sample result", "NAB interpreted per sample result"+ last_ada |
|
| 95 | +286 |
- )+ ) %>% |
||
| 96 | +287 | 3x |
- aval_random <- stats::rnorm(nrow(unique(adab0 %>% dplyr::select(USUBJID, VISIT))), mean = 1, sd = 0.2)+ unique() |
|
| 97 | -3x | +|||
| 288 | +
- aval_random <- cbind(unique(adab0 %>% dplyr::select(USUBJID, VISIT)), AVAL1 = aval_random)+ |
|||
| 98 | +289 |
-
+ # add flags to ADAB dataset |
||
| 99 | +290 | 3x |
- adab_visit <- adab0 %>% dplyr::left_join(aval_random, by = c("USUBJID", "VISIT"))
+ adab <- adab %>% |
|
| 100 | +291 | 3x |
- adab_visit <- adab_visit %>%+ dplyr::left_join(adab_subj, by = c("USUBJID", "NFRLT"))
|
|
| 101 | -3x | +|||
| 292 | +
- dplyr::mutate(+ |
|||
| 102 | -3x | +|||
| 293 | +
- AVAL2 = ifelse(AVAL1 >= 1, AVAL1, NA),+ # derive subject-level variables |
|||
| 103 | +294 | 3x |
- AVALC = dplyr::case_when(+ adab[!(adab$PARAM %in% visit_lvl_params), ] <- adab %>% |
|
| 104 | +295 | 3x |
- !is.na(AVAL2) ~ "POSITIVE",+ dplyr::filter(!(PARAM %in% visit_lvl_params)) %>% |
|
| 105 | +296 | 3x |
- is.na(AVAL2) ~ "NEGATIVE"+ dplyr::mutate( |
|
| 106 | +297 |
- ),+ # nolint start indentation_linter |
||
| 107 | +298 | 3x |
- AVAL = dplyr::case_when(+ AVALC = dplyr::case_when( |
|
| 108 | +299 | 3x |
- (PARAM %in% visit_lvl_params[3:4] & !is.na(AVAL2)) ~ 1,+ (PARAM == "ADA Status of a patient" & any_pos_postbl) ~ "POSITIVE", |
|
| 109 | +300 | 3x |
- (PARAM %in% visit_lvl_params[3:4] & is.na(AVAL2)) ~ 0,+ (PARAM == "ADA Status of a patient" & !any_pos_postbl) ~ "NEGATIVE", |
|
| 110 | +301 | 3x |
- (PARAM %in% visit_lvl_params[1:2] & !is.na(AVAL2)) ~ AVAL2,+ (PARAM == "Treatment induced ADA" & !pos_bl & any_pos_postbl) ~ "Y", |
|
| 111 | +302 | 3x |
- TRUE ~ as.numeric(NA)+ (PARAM == "Treatment enhanced ADA" & pos_bl & inc_postbl > 0) ~ "Y", |
|
| 112 | -+ | |||
| 303 | +3x |
- )+ (PARAM == "Treatment unaffected" & pos_bl & (inc_postbl == 0 | !any_pos_postbl)) ~ "Y", |
||
| 113 | -+ | |||
| 304 | +3x |
- ) %>%+ (PARAM == "Treatment Emergent - Positive" & |
||
| 114 | +305 | 3x |
- dplyr::select(-c(AVAL1, AVAL2))+ ((!pos_bl & any_pos_postbl) | (pos_bl & inc_postbl > 0))) ~ "Y", |
|
| 115 | -+ | |||
| 306 | +3x |
-
+ (PARAM == "Treatment Emergent - Negative" & |
||
| 116 | -+ | |||
| 307 | +3x |
- # retrieve other variables from adpc+ !((!pos_bl & any_pos_postbl) | (pos_bl & inc_postbl > 0))) ~ "Y", |
||
| 117 | +308 | 3x |
- adab_visit <- adab_visit %>%+ (PARAM == "Persistent ADA" & pos_last_postbl) ~ "Y", |
|
| 118 | +309 | 3x |
- dplyr::inner_join(+ (PARAM == "Transient ADA" & |
|
| 119 | +310 | 3x |
- adpc %>%+ (n_pos - pos_bl - pos_last_postbl == 1 | n_pos > 1)) ~ "Y", |
|
| 120 | +311 | 3x |
- dplyr::filter(PCTPT %in% c("Predose", "24H")) %>%
+ (PARAM == "Baseline" & pos_bl) ~ "POSITIVE", |
|
| 121 | +312 | 3x |
- dplyr::select(+ (PARAM == "Baseline" & !pos_bl) ~ "NEGATIVE", |
|
| 122 | +313 | 3x |
- STUDYID,+ (PARAM == "Time to onset of ADA") ~ as.character(onset_ada / 7), |
|
| 123 | +314 | 3x |
- USUBJID,+ (PARAM == "ADA Duration") ~ as.character((last_ada - onset_ada) / 7), |
|
| 124 | +315 | 3x |
- VISIT,+ (PARAM == "NAB Status of a patient" & any_pos_postbl_nab) ~ "POSITIVE", |
|
| 125 | +316 | 3x |
- PCTPT,+ (PARAM == "NAB Status of a patient" & !any_pos_postbl_nab) ~ "NEGATIVE", |
|
| 126 | +317 | 3x |
- ARM,+ (PARAM == "Treatment induced ADA, Neutralizing Antibody" & |
|
| 127 | +318 | 3x |
- ACTARM,+ !pos_bl_nab & any_pos_postbl_nab) ~ "Y", |
|
| 128 | +319 | 3x |
- VISITDY,+ (PARAM == "Treatment enhanced ADA, Neutralizing Antibody" & |
|
| 129 | +320 | 3x |
- AFRLT,+ pos_bl_nab & inc_postbl_nab > 0) ~ "Y", |
|
| 130 | +321 | 3x |
- NFRLT,+ (PARAM == "Baseline, Neutralizing Antibody" & pos_bl_nab) ~ "POSITIVE", |
|
| 131 | +322 | 3x |
- ARRLT,+ (PARAM == "Baseline, Neutralizing Antibody" & !pos_bl_nab) ~ "NEGATIVE", |
|
| 132 | +323 | 3x |
- NRRLT,+ (PARAM == "Treatment unaffected, Neutralizing Antibody" & pos_bl_nab & |
|
| 133 | +324 | 3x |
- RELTMU+ (inc_postbl_nab == 0 | !any_pos_postbl_nab)) ~ "Y", |
|
| 134 | -+ | |||
| 325 | +3x |
- ) %>%+ (PARAM == "Treatment Emergent - Positive, Neutralizing Antibody" & |
||
| 135 | +326 | 3x |
- unique(),+ ((!pos_bl_nab & any_pos_postbl_nab) | (pos_bl_nab & inc_postbl_nab > 0))) ~ "Y", |
|
| 136 | +327 | 3x |
- by = c("STUDYID", "USUBJID", "VISIT")
+ (PARAM == "Treatment Emergent - Negative, Neutralizing Antibody" & |
|
| 137 | -+ | |||
| 328 | +3x |
- ) %>%+ !((!pos_bl_nab & any_pos_postbl_nab) | (pos_bl_nab & inc_postbl_nab > 0))) ~ "Y", |
||
| 138 | +329 | 3x |
- rename(ISTPT = PCTPT)+ TRUE ~ "N" |
|
| 139 | +330 |
-
+ ), |
||
| 140 | -+ | |||
| 331 | +3x |
- # mutate time from dose variables from adpc to convert into Days+ AVAL = dplyr::case_when( |
||
| 141 | +332 | 3x |
- adab_visit <- adab_visit %>% dplyr::mutate_at(c("AFRLT", "NFRLT", "ARRLT", "NRRLT"), ~ . / 24)
+ (PARAM == "ADA Status of a patient" & any_pos_postbl) ~ 1, |
|
| 142 | -+ | |||
| 333 | +3x |
-
+ (PARAM == "Treatment induced ADA" & !pos_bl & any_pos_postbl) ~ 1, |
||
| 143 | -+ | |||
| 334 | +3x |
-
+ (PARAM == "Treatment enhanced ADA" & pos_bl & inc_postbl > 0) ~ 1, |
||
| 144 | -+ | |||
| 335 | +3x |
-
+ (PARAM == "Treatment unaffected" & pos_bl & (inc_postbl == 0 | !any_pos_postbl)) ~ 1, |
||
| 145 | -+ | |||
| 336 | +3x |
- # Set random values for subject level paramaters (Y/N)+ (PARAM == "Treatment Emergent - Positive" & |
||
| 146 | -+ | |||
| 337 | +3x |
-
+ ((!pos_bl & any_pos_postbl) | (pos_bl & inc_postbl > 0))) ~ 1, |
||
| 147 | +338 | 3x |
- adab1 <- expand.grid(+ (PARAM == "Treatment Emergent - Negative" & |
|
| 148 | +339 | 3x |
- STUDYID = unique(adsl$STUDYID),+ !((!pos_bl & any_pos_postbl) | (pos_bl & inc_postbl > 0))) ~ 1, |
|
| 149 | +340 | 3x |
- USUBJID = unique(adpc$USUBJID),+ (PARAM == "Persistent ADA" & pos_last_postbl) ~ 1, |
|
| 150 | +341 | 3x |
- VISIT = NA,+ (PARAM == "Transient ADA" & |
|
| 151 | +342 | 3x |
- PARAM = as.factor(param_init_list$relvar1[c(5:13, 16:22)]),+ (n_pos - ifelse(pos_bl, 1, 0) - ifelse(pos_last_postbl, 1, 0) == 1 | n_pos > 1)) ~ 1, |
|
| 152 | +343 | 3x |
- PARCAT1 = "A: Drug X Antibody",+ (PARAM == "Baseline" & pos_bl) ~ 1, |
|
| 153 | +344 | 3x |
- stringsAsFactors = FALSE+ (PARAM == "Time to onset of ADA") ~ onset_ada / 7, |
|
| 154 | -+ | |||
| 345 | +3x |
- )+ (PARAM == "ADA Duration") ~ (last_ada - onset_ada) / 7, |
||
| 155 | -+ | |||
| 346 | +3x |
-
+ (PARAM == "NAB Status of a patient" & any_pos_postbl_nab) ~ 1, |
||
| 156 | +347 | 3x |
- sub_lvl_params <- c(+ (PARAM == "Treatment induced ADA, Neutralizing Antibody" & |
|
| 157 | +348 | 3x |
- "ADA Status of a patient", "Treatment induced ADA", "Treatment enhanced ADA",+ !pos_bl_nab & any_pos_postbl_nab) ~ 1, |
|
| 158 | +349 | 3x |
- "Treatment unaffected", "Treatment Emergent - Negative",+ (PARAM == "Treatment enhanced ADA, Neutralizing Antibody" & |
|
| 159 | +350 | 3x |
- "Treatment Emergent - Positive", "Persistent ADA", "Transient ADA", "Baseline",+ pos_bl_nab & inc_postbl_nab > 0) ~ 1, |
|
| 160 | -+ | |||
| 351 | +3x |
- # "Time to onset of ADA", "ADA Duration",+ (PARAM == "Baseline, Neutralizing Antibody" & pos_bl_nab) ~ 1, |
||
| 161 | +352 | 3x |
- "NAB Status of a patient",+ (PARAM == "Treatment unaffected, Neutralizing Antibody" & pos_bl_nab & |
|
| 162 | +353 | 3x |
- "Treatment induced ADA, Neutralizing Antibody",+ (inc_postbl_nab == 0 | !any_pos_postbl_nab)) ~ 1, |
|
| 163 | +354 | 3x |
- "Treatment enhanced ADA, Neutralizing Antibody",+ (PARAM == "Treatment Emergent - Positive, Neutralizing Antibody" & |
|
| 164 | +355 | 3x |
- "Treatment Emergent - Negative, Neutralizing Antibody",+ ((!pos_bl_nab & any_pos_postbl_nab) | (pos_bl_nab & inc_postbl_nab > 0))) ~ 1, |
|
| 165 | +356 | 3x |
- "Treatment Emergent - Positive, Neutralizing Antibody",+ (PARAM == "Treatment Emergent - Negative, Neutralizing Antibody" & |
|
| 166 | +357 | 3x |
- "Baseline, Neutralizing Antibody",+ !((!pos_bl_nab & any_pos_postbl_nab) | (pos_bl_nab & inc_postbl_nab > 0))) ~ 1, |
|
| 167 | +358 | 3x |
- "Treatment unaffected, Neutralizing Antibody"+ TRUE ~ 0 |
|
| 168 | +359 |
- )+ ), |
||
| 169 | +360 |
-
+ # nolint end indentation_linter |
||
| 170 | +361 | 3x |
- aval_random_sub <- stats::rbinom(nrow(unique(adab1 %>% dplyr::select(USUBJID))), 1, 0.5)+ PARCAT1 = dplyr::case_when( |
|
| 171 | +362 | 3x |
- aval_random_sub <- cbind(unique(adab1 %>% dplyr::select(USUBJID)), AVAL1 = aval_random_sub)+ PARAM %in% c( |
|
| 172 | -+ | |||
| 363 | +3x |
-
+ "Neutralizing Antibody titer units", "NAB interpreted per sample result", |
||
| 173 | +364 | 3x |
- adab_sub <- adab1 %>% dplyr::left_join(aval_random_sub, by = c("USUBJID"))
+ "NAB Status of a patient", "Treatment induced ADA, Neutralizing Antibody", |
|
| 174 | +365 | 3x |
- adab_sub <- adab_sub %>%+ "Treatment enhanced ADA, Neutralizing Antibody", |
|
| 175 | +366 | 3x |
- dplyr::mutate(+ "Treatment Emergent - Negative, Neutralizing Antibody", |
|
| 176 | +367 | 3x |
- AVAL = AVAL1,+ "Treatment Emergent - Positive, Neutralizing Antibody", |
|
| 177 | +368 | 3x |
- AVALC = dplyr::case_when(+ "Treatment unaffected, Neutralizing Antibody" |
|
| 178 | +369 | 3x |
- PARAM %in% c("ADA Status of a patient", "NAB Status of a patient") & AVAL1 == 1 ~ "POSITIVE",
+ ) ~ "A: Drug X Neutralizing Antibody", |
|
| 179 | +370 | 3x |
- PARAM %in% c("ADA Status of a patient", "NAB Status of a patient") & AVAL1 == 0 ~ "NEGATIVE",
+ TRUE ~ PARCAT1 |
|
| 180 | -3x | +|||
| 371 | +
- !(PARAM %in% c("ADA Status of a patient", "NAB Status of a patient")) & AVAL1 == 1 ~ "Y",
+ ) |
|||
| 181 | -3x | +|||
| 372 | +
- !(PARAM %in% c("ADA Status of a patient", "NAB Status of a patient")) & AVAL1 == 0 ~ "N"
+ ) |
|||
| 182 | +373 |
- )+ |
||
| 183 | +374 |
- ) %>%+ # remove intermediate flag variables from adab |
||
| 184 | +375 | 3x |
- dplyr::select(-c(AVAL1))+ adab <- adab %>% |
|
| 185 | -+ | |||
| 376 | +3x |
-
+ dplyr::select(-c( |
||
| 186 | -+ | |||
| 377 | +3x |
- # Set random values for subject level paramaters (numeric)+ pos_bl, |
||
| 187 | -+ | |||
| 378 | +3x |
-
+ pos_bl_nab, |
||
| 188 | +379 | 3x |
- adab2 <- expand.grid(+ any_pos_postbl, |
|
| 189 | +380 | 3x |
- STUDYID = unique(adsl$STUDYID),+ any_pos_postbl_nab, |
|
| 190 | +381 | 3x |
- USUBJID = unique(adpc$USUBJID),+ pos_last_postbl, |
|
| 191 | +382 | 3x |
- VISIT = NA,+ inc_postbl, |
|
| 192 | +383 | 3x |
- PARAM = as.factor(param_init_list$relvar1[c(14, 15)]),+ inc_postbl_nab, |
|
| 193 | +384 | 3x |
- PARCAT1 = "A: Drug X Antibody",+ n_pos, |
|
| 194 | +385 | 3x |
- stringsAsFactors = FALSE+ onset_ada,+ |
+ |
| 386 | +3x | +
+ last_ada |
||
| 195 | +387 |
- )+ )) |
||
| 196 | +388 | |||
| 197 | +389 | 3x |
- sub_lvl_params_num <- c("Time to onset of ADA", "ADA Duration")
+ if (length(na_vars) > 0 && na_percentage > 0) {
+ |
+ |
| 390 | +! | +
+ adab <- mutate_na(ds = adab, na_vars = na_vars, na_percentage = na_percentage) |
||
| 198 | +391 | ++ |
+ }+ |
+ |
| 392 | ||||
| 199 | +393 | 3x |
- aval_random_sub_num <- stats::rnorm(nrow(unique(adab2 %>% dplyr::select(USUBJID))), mean = 1, sd = 1)+ adab <- apply_metadata(adab, "metadata/ADAB.yml") |
|
| 200 | -3x | +|||
| 394 | +
- aval_random_sub_num <- cbind(unique(adab2 %>% dplyr::select(USUBJID)), AVAL1 = aval_random_sub_num)+ } |
| 201 | +1 |
-
+ #' Questionnaires Analysis Dataset (ADQS) |
||
| 202 | -3x | +|||
| 2 | +
- adab_sub_num <- adab2 %>% dplyr::left_join(aval_random_sub_num, by = c("USUBJID"))
+ #' |
|||
| 203 | -3x | +|||
| 3 | +
- adab_sub_num <- adab_sub_num %>%+ #' @description `r lifecycle::badge("stable")`
|
|||
| 204 | -3x | +|||
| 4 | +
- dplyr::mutate(+ #' |
|||
| 205 | -3x | +|||
| 5 | +
- AVAL = ifelse(AVAL1 >= 1, round(AVAL1, 2), NA),+ #' Function for generating a random Questionnaires Analysis Dataset for a given |
|||
| 206 | -3x | +|||
| 6 | +
- AVALC = as.character(AVAL)+ #' Subject-Level Analysis Dataset.+ |
+ |||
| 7 | ++ |
+ #'+ |
+ ||
| 8 | ++ |
+ #' @details One record per subject per parameter per analysis visit per analysis date. |
||
| 207 | +9 |
- ) %>%+ #' |
||
| 208 | -3x | +|||
| 10 | +
- dplyr::select(-c(AVAL1))+ #' Keys: `STUDYID`, `USUBJID`, `PARAMCD`, `AVISITN` |
|||
| 209 | +11 |
-
+ #' |
||
| 210 | +12 |
-
+ #' @inheritParams argument_convention |
||
| 211 | -3x | +|||
| 13 | +
- adab <- bind_rows(adab_visit, adab_sub, adab_sub_num)+ #' @template param_cached |
|||
| 212 | +14 |
-
+ #' @templateVar data adqs |
||
| 213 | +15 |
-
+ #' |
||
| 214 | +16 |
- # assign related variable values: PARAMxPARAMCD are related+ #' @return `data.frame` |
||
| 215 | -3x | +|||
| 17 | +
- adab <- adab %>% rel_var(+ #' @export |
|||
| 216 | -3x | +|||
| 18 | +
- var_name = "PARAMCD",+ #' |
|||
| 217 | -3x | +|||
| 19 | +
- related_var = "PARAM",+ #' @author npaszty |
|||
| 218 | -3x | +|||
| 20 | +
- var_values = param_init_list$relvar2+ #' |
|||
| 219 | +21 |
- )+ #' @examples |
||
| 220 | +22 |
-
+ #' adsl <- radsl(N = 10, seed = 1, study_duration = 2) |
||
| 221 | +23 |
- # assign related variable values: PARAMxAVALU are related+ #' |
||
| 222 | -3x | +|||
| 24 | +
- adab <- adab %>% rel_var(+ #' adqs <- radqs(adsl, visit_format = "WEEK", n_assessments = 7L, seed = 2) |
|||
| 223 | -3x | +|||
| 25 | +
- var_name = "AVALU",+ #' adqs |
|||
| 224 | -3x | +|||
| 26 | +
- related_var = "PARAM",+ #' |
|||
| 225 | -3x | +|||
| 27 | +
- var_values = unit_init_list$relvar2+ #' adqs <- radqs(adsl, visit_format = "CYCLE", n_assessments = 3L, seed = 2) |
|||
| 226 | +28 |
- )+ #' adqs |
||
| 227 | +29 |
-
+ radqs <- function(adsl, |
||
| 228 | +30 |
-
+ param = c( |
||
| 229 | -3x | +|||
| 31 | +
- adab <- adab %>%+ "BFI All Questions", |
|||
| 230 | -3x | +|||
| 32 | +
- dplyr::mutate(+ "Fatigue Interference", |
|||
| 231 | -3x | +|||
| 33 | +
- RELTMU = "day",+ "Function/Well-Being (GF1,GF3,GF7)", |
|||
| 232 | -3x | +|||
| 34 | +
- ABLFL = ifelse(!is.na(NFRLT) & NFRLT == 0, "Y", NA) # Baseline Record Flag+ "Treatment Side Effects (GP2,C5,GP5)", |
|||
| 233 | +35 |
- ,+ "FKSI-19 All Questions" |
||
| 234 | -3x | +|||
| 36 | +
- ADABLPFL = ifelse(PARAMCD == "RESULT1" & !is.na(NFRLT) & NFRLT == 0, "Y", NA)+ ), |
|||
| 235 | +37 |
- # Baseline ADA Eval. Param-Level Flag, only populate for ADA, not for NAB+ paramcd = c("BFIALL", "FATIGI", "FKSI-FWB", "FKSI-TSE", "FKSIALL"),
|
||
| 236 | +38 |
- ,+ visit_format = "WEEK", |
||
| 237 | -3x | +|||
| 39 | +
- ADPBLPFL = ifelse(PARAMCD == "RESULT1" & !is.na(NFRLT) & NFRLT > 0 & !is.na(AVAL), "Y", NA)+ n_assessments = 5L, |
|||
| 238 | +40 |
- # Post-Baseline ADA Eval. Param-Level Flag, only populate for ADA, not for NAB+ n_days = 5L, |
||
| 239 | +41 |
- ) %>%+ seed = NULL, |
||
| 240 | -3x | +|||
| 42 | +
- dplyr::group_by(USUBJID) %>%+ na_percentage = 0, |
|||
| 241 | -3x | +|||
| 43 | +
- dplyr::ungroup()+ na_vars = list( |
|||
| 242 | +44 |
-
+ LOQFL = c(NA, 0.1), ABLFL2 = c(1234, 0.1), ABLFL = c(1235, 0.1), |
||
| 243 | +45 |
- # create temporary flags to derive subject-level variables+ CHG2 = c(1235, 0.1), PCHG2 = c(1235, 0.1), CHG = c(1234, 0.1), PCHG = c(1234, 0.1) |
||
| 244 | -3x | +|||
| 46 | +
- adab_subj <- adab %>%+ ), |
|||
| 245 | -3x | +|||
| 47 | +
- dplyr::group_by(USUBJID) %>%+ cached = FALSE) {
|
|||
| 246 | -3x | +48 | +4x |
- dplyr::mutate(+ checkmate::assert_flag(cached) |
| 247 | -3x | +49 | +4x |
- pos_bl = any(PARAM == "ADA interpreted per sample result" & !is.na(ABLFL) & AVALC == "POSITIVE"),+ if (cached) {
|
| 248 | -3x | +50 | +1x |
- pos_bl_nab = any(PARAM == "NAB interpreted per sample result" & !is.na(ABLFL) & AVALC == "POSITIVE"),+ return(get_cached_data("cadqs"))
|
| 249 | -3x | +|||
| 51 | +
- any_pos_postbl = any(PARAM == "ADA interpreted per sample result" & is.na(ABLFL) & AVALC == "POSITIVE"),+ } |
|||
| 250 | -3x | +|||
| 52 | +
- any_pos_postbl_nab = any(PARAM == "NAB interpreted per sample result" & is.na(ABLFL) & AVALC == "POSITIVE"),+ |
|||
| 251 | +53 | 3x |
- pos_last_postbl = any(PARAM == "ADA interpreted per sample result" & NFRLT == max(NFRLT) & AVALC == "POSITIVE"),+ checkmate::assert_data_frame(adsl) |
|
| 252 | +54 | 3x |
- ada_bl = AVAL[PARAM == "Antibody titer units" & !is.na(ABLFL)],+ checkmate::assert_character(param, min.len = 1, any.missing = FALSE) |
|
| 253 | +55 | 3x |
- nab_bl = AVAL[PARAM == "Neutralizing Antibody titer units" & !is.na(ABLFL)]- |
- |
| 254 | -- |
- )+ checkmate::assert_character(paramcd, min.len = 1, any.missing = FALSE) |
||
| 255 | +56 | 3x |
- pos_tots <- adab_subj %>%+ checkmate::assert_string(visit_format) |
|
| 256 | +57 | 3x |
- dplyr::summarise(+ checkmate::assert_integer(n_assessments, len = 1, any.missing = FALSE) |
|
| 257 | +58 | 3x |
- n_pos = sum(PARAM == "ADA interpreted per sample result" & AVALC == "POSITIVE"),+ checkmate::assert_integer(n_days, len = 1, any.missing = FALSE) |
|
| 258 | +59 | 3x |
- inc_postbl = sum(PARAM == "ADA interpreted per sample result" & is.na(ABLFL) & (AVAL - ada_bl) > 0.60),+ checkmate::assert_number(seed, null.ok = TRUE) |
|
| 259 | +60 | 3x |
- inc_postbl_nab = sum(PARAM == "NAB interpreted per sample result" & is.na(ABLFL) & (AVAL - nab_bl) > 0.60),+ checkmate::assert_number(na_percentage, lower = 0, upper = 1) |
|
| 260 | +61 | 3x |
- onset_ada = if (any(PARAM == "ADA interpreted per sample result" & AVALC == "POSITIVE")) {
+ checkmate::assert_true(na_percentage < 1) |
|
| 261 | -18x | +|||
| 62 | +
- min(NFRLT[PARAM == "ADA interpreted per sample result" & AVALC == "POSITIVE"])+ |
|||
| 262 | +63 |
- } else {
+ # validate and initialize param vectors |
||
| 263 | +64 | 3x |
- NA+ param_init_list <- relvar_init(param, paramcd) |
|
| 264 | +65 |
- },+ |
||
| 265 | +66 | 3x |
- last_ada = if (any(PARAM == "ADA interpreted per sample result" & AVALC == "POSITIVE")) {
+ if (!is.null(seed)) {
|
|
| 266 | -18x | +67 | +3x |
- max(NFRLT[PARAM == "ADA interpreted per sample result" & AVALC == "POSITIVE"])+ set.seed(seed) |
| 267 | +68 |
- } else {
+ } |
||
| 268 | +69 | 3x |
- NA- |
- |
| 269 | -- |
- }+ study_duration_secs <- lubridate::seconds(attr(adsl, "study_duration_secs")) |
||
| 270 | +70 |
- )- |
- ||
| 271 | -3x | -
- adab_subj <- adab_subj %>%+ |
||
| 272 | +71 | 3x |
- dplyr::left_join(pos_tots, by = "USUBJID") %>%+ adqs <- expand.grid( |
|
| 273 | +72 | 3x |
- dplyr::select(+ STUDYID = unique(adsl$STUDYID), |
|
| 274 | +73 | 3x |
- USUBJID,+ USUBJID = adsl$USUBJID, |
|
| 275 | +74 | 3x |
- NFRLT,+ PARAM = param_init_list$relvar1, |
|
| 276 | +75 | 3x |
- pos_bl,+ AVISIT = visit_schedule(visit_format = visit_format, n_assessments = n_assessments, n_days = n_days), |
|
| 277 | +76 | 3x |
- pos_bl_nab,+ stringsAsFactors = FALSE |
|
| 278 | -3x | +|||
| 77 | +
- any_pos_postbl,+ ) |
|||
| 279 | -3x | +|||
| 78 | +
- any_pos_postbl_nab,+ |
|||
| 280 | +79 | 3x |
- inc_postbl,+ adqs <- dplyr::mutate( |
|
| 281 | +80 | 3x |
- inc_postbl_nab,+ adqs, |
|
| 282 | +81 | 3x |
- pos_last_postbl,+ AVISITN = dplyr::case_when( |
|
| 283 | +82 | 3x |
- n_pos,+ AVISIT == "SCREENING" ~ -1, |
|
| 284 | +83 | 3x |
- onset_ada,+ AVISIT == "BASELINE" ~ 0, |
|
| 285 | +84 | 3x |
- last_ada- |
- |
| 286 | -- |
- ) %>%+ (grepl("^WEEK", AVISIT) | grepl("^CYCLE", AVISIT)) ~ as.numeric(AVISIT) - 2,
|
||
| 287 | +85 | 3x |
- unique()+ TRUE ~ NA_real_ |
|
| 288 | +86 |
-
+ ) |
||
| 289 | +87 |
- # add flags to ADAB dataset- |
- ||
| 290 | -3x | -
- adab <- adab %>%- |
- ||
| 291 | -3x | -
- dplyr::left_join(adab_subj, by = c("USUBJID", "NFRLT"))
+ ) |
||
| 292 | +88 | |||
| 293 | -- |
- # derive subject-level variables- |
- ||
| 294 | -3x | -
- adab[!(adab$PARAM %in% visit_lvl_params), ] <- adab %>%- |
- ||
| 295 | -3x | -
- dplyr::filter(!(PARAM %in% visit_lvl_params)) %>%- |
- ||
| 296 | -3x | -
- dplyr::mutate(- |
- ||
| 297 | +89 |
- # nolint start indentation_linter+ # assign related variable values: PARAMxPARAMCD are related |
||
| 298 | +90 | 3x |
- AVALC = dplyr::case_when(+ adqs <- adqs %>% rel_var( |
|
| 299 | +91 | 3x |
- (PARAM == "ADA Status of a patient" & any_pos_postbl) ~ "POSITIVE",+ var_name = "PARAMCD", |
|
| 300 | +92 | 3x |
- (PARAM == "ADA Status of a patient" & !any_pos_postbl) ~ "NEGATIVE",+ related_var = "PARAM", |
|
| 301 | +93 | 3x |
- (PARAM == "Treatment induced ADA" & !pos_bl & any_pos_postbl) ~ "Y",+ var_values = param_init_list$relvar2 |
|
| 302 | -3x | +|||
| 94 | +
- (PARAM == "Treatment enhanced ADA" & pos_bl & inc_postbl > 0) ~ "Y",+ ) |
|||
| 303 | -3x | +|||
| 95 | +
- (PARAM == "Treatment unaffected" & pos_bl & (inc_postbl == 0 | !any_pos_postbl)) ~ "Y",+ |
|||
| 304 | +96 | 3x |
- (PARAM == "Treatment Emergent - Positive" &+ adqs$AVAL <- stats::rnorm(nrow(adqs), mean = 50, sd = 8) + adqs$AVISITN * stats::rnorm(nrow(adqs), mean = 5, sd = 2) |
|
| 305 | -3x | +|||
| 97 | +
- ((!pos_bl & any_pos_postbl) | (pos_bl & inc_postbl > 0))) ~ "Y",+ |
|||
| 306 | -3x | +|||
| 98 | +
- (PARAM == "Treatment Emergent - Negative" &+ # order to prepare for change from screening and baseline values |
|||
| 307 | +99 | 3x |
- !((!pos_bl & any_pos_postbl) | (pos_bl & inc_postbl > 0))) ~ "Y",+ adqs <- adqs[order(adqs$STUDYID, adqs$USUBJID, adqs$PARAMCD, adqs$AVISITN), ] |
|
| 308 | -3x | +|||
| 100 | +
- (PARAM == "Persistent ADA" & pos_last_postbl) ~ "Y",+ |
|||
| 309 | +101 | 3x |
- (PARAM == "Transient ADA" &+ adqs <- Reduce( |
|
| 310 | +102 | 3x |
- (n_pos - pos_bl - pos_last_postbl == 1 | n_pos > 1)) ~ "Y",+ rbind, |
|
| 311 | +103 | 3x |
- (PARAM == "Baseline" & pos_bl) ~ "POSITIVE",+ lapply( |
|
| 312 | +104 | 3x |
- (PARAM == "Baseline" & !pos_bl) ~ "NEGATIVE",+ split(adqs, adqs$USUBJID), |
|
| 313 | +105 | 3x |
- (PARAM == "Time to onset of ADA") ~ as.character(onset_ada / 7),+ function(x) {
|
|
| 314 | -3x | +106 | +30x |
- (PARAM == "ADA Duration") ~ as.character((last_ada - onset_ada) / 7),+ x$STUDYID <- adsl$STUDYID[which(adsl$USUBJID == x$USUBJID[1])] |
| 315 | -3x | +107 | +30x |
- (PARAM == "NAB Status of a patient" & any_pos_postbl_nab) ~ "POSITIVE",+ x$ABLFL2 <- ifelse(x$AVISIT == "SCREENING", "Y", "") |
| 316 | -3x | +108 | +30x |
- (PARAM == "NAB Status of a patient" & !any_pos_postbl_nab) ~ "NEGATIVE",+ x$ABLFL <- ifelse( |
| 317 | -3x | +109 | +30x |
- (PARAM == "Treatment induced ADA, Neutralizing Antibody" &+ toupper(visit_format) == "WEEK" & x$AVISIT == "BASELINE", |
| 318 | -3x | +110 | +30x |
- !pos_bl_nab & any_pos_postbl_nab) ~ "Y",+ "Y", |
| 319 | -3x | +111 | +30x |
- (PARAM == "Treatment enhanced ADA, Neutralizing Antibody" &+ ifelse( |
| 320 | -3x | +112 | +30x |
- pos_bl_nab & inc_postbl_nab > 0) ~ "Y",+ toupper(visit_format) == "CYCLE" & x$AVISIT == "CYCLE 1 DAY 1", |
| 321 | -3x | +113 | +30x |
- (PARAM == "Baseline, Neutralizing Antibody" & pos_bl_nab) ~ "POSITIVE",+ "Y", |
| 322 | -3x | +|||
| 114 | +
- (PARAM == "Baseline, Neutralizing Antibody" & !pos_bl_nab) ~ "NEGATIVE",+ "" |
|||
| 323 | -3x | +|||
| 115 | +
- (PARAM == "Treatment unaffected, Neutralizing Antibody" & pos_bl_nab &+ ) |
|||
| 324 | -3x | +|||
| 116 | +
- (inc_postbl_nab == 0 | !any_pos_postbl_nab)) ~ "Y",+ ) |
|||
| 325 | -3x | +117 | +30x |
- (PARAM == "Treatment Emergent - Positive, Neutralizing Antibody" &+ x$LOQFL <- ifelse(x$AVAL < 32, "Y", "N") |
| 326 | -3x | +118 | +30x |
- ((!pos_bl_nab & any_pos_postbl_nab) | (pos_bl_nab & inc_postbl_nab > 0))) ~ "Y",+ x |
| 327 | -3x | +|||
| 119 | +
- (PARAM == "Treatment Emergent - Negative, Neutralizing Antibody" &+ } |
|||
| 328 | -3x | +|||
| 120 | +
- !((!pos_bl_nab & any_pos_postbl_nab) | (pos_bl_nab & inc_postbl_nab > 0))) ~ "Y",+ ) |
|||
| 329 | -3x | +|||
| 121 | +
- TRUE ~ "N"+ ) |
|||
| 330 | +122 |
- ),+ |
||
| 331 | +123 | 3x |
- AVAL = dplyr::case_when(+ adqs$BASE2 <- retain(adqs, adqs$AVAL, adqs$ABLFL2 == "Y") |
|
| 332 | +124 | 3x |
- (PARAM == "ADA Status of a patient" & any_pos_postbl) ~ 1,+ adqs$BASE <- ifelse(adqs$ABLFL2 != "Y", retain(adqs, adqs$AVAL, adqs$ABLFL == "Y"), NA) |
|
| 333 | -3x | +|||
| 125 | +
- (PARAM == "Treatment induced ADA" & !pos_bl & any_pos_postbl) ~ 1,+ |
|||
| 334 | +126 | 3x |
- (PARAM == "Treatment enhanced ADA" & pos_bl & inc_postbl > 0) ~ 1,+ adqs <- adqs %>% |
|
| 335 | +127 | 3x |
- (PARAM == "Treatment unaffected" & pos_bl & (inc_postbl == 0 | !any_pos_postbl)) ~ 1,+ dplyr::mutate(CHG2 = AVAL - BASE2) %>% |
|
| 336 | +128 | 3x |
- (PARAM == "Treatment Emergent - Positive" &+ dplyr::mutate(PCHG2 = 100 * (CHG2 / BASE2)) %>% |
|
| 337 | +129 | 3x |
- ((!pos_bl & any_pos_postbl) | (pos_bl & inc_postbl > 0))) ~ 1,+ dplyr::mutate(CHG = AVAL - BASE) %>% |
|
| 338 | +130 | 3x |
- (PARAM == "Treatment Emergent - Negative" &+ dplyr::mutate(PCHG = 100 * (CHG / BASE)) %>% |
|
| 339 | +131 | 3x |
- !((!pos_bl & any_pos_postbl) | (pos_bl & inc_postbl > 0))) ~ 1,+ var_relabel( |
|
| 340 | +132 | 3x |
- (PARAM == "Persistent ADA" & pos_last_postbl) ~ 1,+ STUDYID = attr(adsl$STUDYID, "label"), |
|
| 341 | +133 | 3x |
- (PARAM == "Transient ADA" &+ USUBJID = attr(adsl$USUBJID, "label") |
|
| 342 | -3x | +|||
| 134 | +
- (n_pos - ifelse(pos_bl, 1, 0) - ifelse(pos_last_postbl, 1, 0) == 1 | n_pos > 1)) ~ 1,+ ) |
|||
| 343 | -3x | +|||
| 135 | +
- (PARAM == "Baseline" & pos_bl) ~ 1,+ |
|||
| 344 | +136 | 3x |
- (PARAM == "Time to onset of ADA") ~ onset_ada / 7,+ adqs <- var_relabel( |
|
| 345 | +137 | 3x |
- (PARAM == "ADA Duration") ~ (last_ada - onset_ada) / 7,+ adqs, |
|
| 346 | +138 | 3x |
- (PARAM == "NAB Status of a patient" & any_pos_postbl_nab) ~ 1,+ STUDYID = "Study Identifier", |
|
| 347 | +139 | 3x |
- (PARAM == "Treatment induced ADA, Neutralizing Antibody" &+ USUBJID = "Unique Subject Identifier" |
|
| 348 | -3x | +|||
| 140 | +
- !pos_bl_nab & any_pos_postbl_nab) ~ 1,+ ) |
|||
| 349 | -3x | +|||
| 141 | +
- (PARAM == "Treatment enhanced ADA, Neutralizing Antibody" &+ |
|||
| 350 | -3x | +|||
| 142 | +
- pos_bl_nab & inc_postbl_nab > 0) ~ 1,+ # merge ADSL to be able to add QS date and study day variables |
|||
| 351 | +143 | 3x |
- (PARAM == "Baseline, Neutralizing Antibody" & pos_bl_nab) ~ 1,+ adqs <- dplyr::inner_join( |
|
| 352 | +144 | 3x |
- (PARAM == "Treatment unaffected, Neutralizing Antibody" & pos_bl_nab &+ adqs, |
|
| 353 | +145 | 3x |
- (inc_postbl_nab == 0 | !any_pos_postbl_nab)) ~ 1,+ adsl, |
|
| 354 | +146 | 3x |
- (PARAM == "Treatment Emergent - Positive, Neutralizing Antibody" &+ by = c("STUDYID", "USUBJID")
+ |
+ |
| 147 | ++ |
+ ) %>% |
||
| 355 | +148 | 3x |
- ((!pos_bl_nab & any_pos_postbl_nab) | (pos_bl_nab & inc_postbl_nab > 0))) ~ 1,+ dplyr::rowwise() %>% |
|
| 356 | +149 | 3x |
- (PARAM == "Treatment Emergent - Negative, Neutralizing Antibody" &+ dplyr::mutate(TRTENDT = lubridate::date(dplyr::case_when( |
|
| 357 | +150 | 3x |
- !((!pos_bl_nab & any_pos_postbl_nab) | (pos_bl_nab & inc_postbl_nab > 0))) ~ 1,+ is.na(TRTEDTM) ~ lubridate::floor_date(lubridate::date(TRTSDTM) + study_duration_secs, unit = "day"), |
|
| 358 | +151 | 3x |
- TRUE ~ 0+ TRUE ~ TRTEDTM |
|
| 359 | +152 |
- ),+ ))) %>%+ |
+ ||
| 153 | +3x | +
+ ungroup() |
||
| 360 | +154 |
- # nolint end indentation_linter+ |
||
| 361 | +155 | 3x |
- PARCAT1 = dplyr::case_when(+ adqs <- adqs %>% |
|
| 362 | +156 | 3x |
- PARAM %in% c(+ group_by(USUBJID) %>% |
|
| 363 | +157 | 3x |
- "Neutralizing Antibody titer units", "NAB interpreted per sample result",+ arrange(USUBJID, AVISITN) %>% |
|
| 364 | +158 | 3x |
- "NAB Status of a patient", "Treatment induced ADA, Neutralizing Antibody",+ dplyr::mutate(ADTM = rep( |
|
| 365 | +159 | 3x |
- "Treatment enhanced ADA, Neutralizing Antibody",+ sort(sample( |
|
| 366 | +160 | 3x |
- "Treatment Emergent - Negative, Neutralizing Antibody",+ seq(lubridate::as_datetime(TRTSDTM[1]), lubridate::as_datetime(TRTENDT[1]), by = "day"), |
|
| 367 | +161 | 3x |
- "Treatment Emergent - Positive, Neutralizing Antibody",+ size = nlevels(AVISIT) |
|
| 368 | -3x | +|||
| 162 | +
- "Treatment unaffected, Neutralizing Antibody"+ )), |
|||
| 369 | +163 | 3x |
- ) ~ "A: Drug X Neutralizing Antibody",+ each = n() / nlevels(AVISIT)+ |
+ |
| 164 | ++ |
+ )) %>% |
||
| 370 | +165 | 3x |
- TRUE ~ PARCAT1+ dplyr::ungroup() %>% |
|
| 371 | -+ | |||
| 166 | +3x |
- )+ dplyr::mutate(ADY = ceiling(difftime(ADTM, TRTSDTM, units = "days"))) %>% |
||
| 372 | -+ | |||
| 167 | +3x |
- )+ dplyr::select(-TRTENDT) %>% |
||
| 373 | -+ | |||
| 168 | +3x |
-
+ dplyr::arrange(STUDYID, USUBJID, ADTM) |
||
| 374 | +169 |
- # remove intermediate flag variables from adab+ |
||
| 375 | +170 | 3x |
- adab <- adab %>%+ adqs <- adqs %>% |
|
| 376 | +171 | 3x |
- dplyr::select(-c(+ dplyr::group_by(USUBJID) %>% |
|
| 377 | +172 | 3x |
- pos_bl,+ dplyr::mutate(QSSEQ = seq_len(dplyr::n())) %>% |
|
| 378 | +173 | 3x |
- pos_bl_nab,+ dplyr::mutate(ASEQ = QSSEQ) %>% |
|
| 379 | +174 | 3x |
- any_pos_postbl,+ dplyr::ungroup() %>% |
|
| 380 | +175 | 3x |
- any_pos_postbl_nab,+ dplyr::arrange( |
|
| 381 | +176 | 3x |
- pos_last_postbl,+ STUDYID, |
|
| 382 | +177 | 3x |
- inc_postbl,+ USUBJID, |
|
| 383 | +178 | 3x |
- inc_postbl_nab,+ PARAMCD, |
|
| 384 | +179 | 3x |
- n_pos,+ AVISITN, |
|
| 385 | +180 | 3x |
- onset_ada,+ ADTM, |
|
| 386 | +181 | 3x |
- last_ada+ QSSEQ |
|
| 387 | +182 |
- ))+ ) |
||
| 388 | +183 | |||
| 389 | +184 | 3x |
if (length(na_vars) > 0 && na_percentage > 0) {
|
|
| 390 | +185 | ! |
- adab <- mutate_na(ds = adab, na_vars = na_vars, na_percentage = na_percentage)+ adqs <- mutate_na(ds = adqs, na_vars = na_vars, na_percentage = na_percentage) |
|
| 391 | +186 |
} |
||
| 392 | +187 | |||
| 188 | ++ |
+ # apply metadata+ |
+ ||
| 393 | +189 | 3x |
- adab <- apply_metadata(adab, "metadata/ADAB.yml")+ adqs <- apply_metadata(adqs, "metadata/ADQS.yml") |
|
| 394 | +190 | ++ | + + | +|
| 191 | +3x | +
+ return(adqs)+ |
+ ||
| 192 |
}diff --git a/main/coverage-report/lib/datatables-binding-0.31/datatables.js b/main/coverage-report/lib/datatables-binding-0.32/datatables.js similarity index 96% rename from main/coverage-report/lib/datatables-binding-0.31/datatables.js rename to main/coverage-report/lib/datatables-binding-0.32/datatables.js index d21dff0b..6a3c3d5c 100644 --- a/main/coverage-report/lib/datatables-binding-0.31/datatables.js +++ b/main/coverage-report/lib/datatables-binding-0.32/datatables.js @@ -348,6 +348,15 @@ HTMLWidgets.widget({ var table = $table.DataTable(options); $el.data('datatable', table); + if ('rowGroup' in options) { + // Maintain RowGroup dataSrc when columns are reordered (#1109) + table.on('column-reorder', function(e, settings, details) { + var oldDataSrc = table.rowGroup().dataSrc(); + var newDataSrc = details.mapping[oldDataSrc]; + table.rowGroup().dataSrc(newDataSrc); + }); + } + // Unregister previous Crosstalk event subscriptions, if they exist if (instance.ctfilterSubscription) { instance.ctfilterHandle.off("change", instance.ctfilterSubscription); @@ -438,6 +447,7 @@ HTMLWidgets.widget({ }; if (data.filter !== 'none') { + if (!data.hasOwnProperty('filterSettings')) data.filterSettings = {}; filterRow.each(function(i, td) { @@ -501,7 +511,7 @@ HTMLWidgets.widget({ } }); var $input2 = $x.children('select'); - filter = $input2.selectize({ + filter = $input2.selectize($.extend({ options: $input2.data('options').map(function(v, i) { return ({text: v, value: v}); }), @@ -520,8 +530,7 @@ HTMLWidgets.widget({ $td.data('filter', value.length > 0); table.draw(); // redraw table, and filters will be applied } - }); - if (searchCol) filter[0].selectize.setValue(JSON.parse(searchCol)); + }, data.filterSettings.select)); filter[0].selectize.on('blur', function() { $x.hide().trigger('hide'); $input.parent().show(); $input.trigger('blur'); }); @@ -530,10 +539,12 @@ HTMLWidgets.widget({ var fun = function() { searchColumn(i, $input.val()).draw(); }; - if (server) { - fun = $.fn.dataTable.util.throttle(fun, options.searchDelay); - } - $input.on('input', fun); + // throttle searching for server-side processing + var throttledFun = $.fn.dataTable.util.throttle(fun, options.searchDelay); + $input.on('input', function(e, immediate) { + // always bypass throttling when immediate = true (via the updateSearch method) + (immediate || !server) ? fun() : throttledFun(); + }); } else if (inArray(type, ['number', 'integer', 'date', 'time'])) { var $x0 = $x; $x = $x0.children('div').first(); @@ -619,13 +630,11 @@ HTMLWidgets.widget({ filter.val(v); } }); - var formatDate = function(d, isoFmt) { + var formatDate = function(d) { d = scaleBack(d, scale); if (type === 'number') return d; if (type === 'integer') return parseInt(d); var x = new Date(+d); - var fmt = ('filterDateFmt' in data) ? data.filterDateFmt[i] : undefined; - if (fmt !== undefined && isoFmt === false) return x[fmt.method].apply(x, fmt.params); if (type === 'date') { var pad0 = function(x) { return ('0' + x).substr(-2, 2); @@ -646,7 +655,7 @@ HTMLWidgets.widget({ start: [r1, r2], range: {min: r1, max: r2}, connect: true - }, opts)); + }, opts, data.filterSettings.slider)); if (scale > 1) (function() { var t1 = r1, t2 = r2; var val = filter.val(); @@ -661,13 +670,28 @@ HTMLWidgets.widget({ start: [t1, t2], range: {min: t1, max: t2}, connect: true - }, opts), true); + }, opts, data.filterSettings.slider), true); val = filter.val(); } r1 = t1; r2 = t2; })(); + // format with active column renderer, if defined + var colDef = data.options.columnDefs.find(function(def) { + return (def.targets === i || inArray(i, def.targets)) && 'render' in def; + }); var updateSliderText = function(v1, v2) { - $span1.text(formatDate(v1, false)); $span2.text(formatDate(v2, false)); + // we only know how to use function renderers + if (colDef && typeof colDef.render === 'function') { + var restore = function(v) { + v = scaleBack(v, scale); + return inArray(type, ['date', 'time']) ? new Date(+v) : v; + } + $span1.text(colDef.render(restore(v1), 'display')); + $span2.text(colDef.render(restore(v2), 'display')); + } else { + $span1.text(formatDate(v1)); + $span2.text(formatDate(v2)); + } }; updateSliderText(r1, r2); var updateSlider = function(e) { @@ -700,7 +724,7 @@ HTMLWidgets.widget({ // processing if (server) { // if a search string has been pre-set, search now - if (searchCol) searchColumn(i, searchCol).draw(); + if (searchCol) $input.trigger('input').trigger('change'); return; } @@ -746,15 +770,7 @@ HTMLWidgets.widget({ $.fn.dataTable.ext.search.push(customFilter); // search for the preset search strings if it is non-empty - if (searchCol) { - if (inArray(type, ['factor', 'logical'])) { - filter[0].selectize.setValue(JSON.parse(searchCol)); - } else if (type === 'character') { - $input.trigger('input'); - } else if (inArray(type, ['number', 'integer', 'date', 'time'])) { - $input.trigger('change'); - } - } + if (searchCol) $input.trigger('input').trigger('change'); }); @@ -1402,8 +1418,9 @@ HTMLWidgets.widget({ console.log('The search keyword for column ' + i + ' is undefined') return; } - $(td).find('input').first().val(v).trigger('input'); - searchColumn(i, v); + // Update column search string and values on linked filter widgets. + // 'input' for factor and char filters, 'change' for numeric filters. + $(td).find('input').first().val(v).trigger('input', [true]).trigger('change'); }); table.draw(); } |