| 1 |
- #' Laboratory Data Analysis Dataset (ADLB)+ #' Load Cached Data |
|||
| 3 |
- #' @description `r lifecycle::badge("stable")`
+ #' Return data attached to package. |
|||
| 5 |
- #' Function for generating a random Laboratory Data Analysis Dataset for a given+ #' @keywords internal |
|||
| 6 |
- #' Subject-Level Analysis Dataset.+ #' @noRd |
|||
| 7 |
- #'+ get_cached_data <- function(dataname) {
|
|||
| 8 | -+ | 22x |
- #' @details One record per subject per parameter per analysis visit per analysis date.+ checkmate::assert_string(dataname) |
|
| 9 | -+ | 22x |
- #'+ if (!("package:random.cdisc.data" %in% search())) {
|
|
| 10 | -+ | 1x |
- #' Keys: `STUDYID`, `USUBJID`, `PARAMCD`, `BASETYPE`, `AVISITN`, `ATPTN`, `DTYPE`, `ADTM`, `LBSEQ`, `ASPID`+ stop("cached data can only be loaded if the random.cdisc.data package is attached.",
|
|
| 11 | -+ | 1x |
- #+ "Please run library(random.cdisc.data) before loading cached data.", |
|
| 12 | -+ | 1x |
- #' @inheritParams argument_convention+ call. = FALSE |
|
| 13 |
- #' @param lbcat (`character vector`)\cr LB category values.+ ) |
|||
| 14 |
- #' @param max_n_lbs (`integer`)\cr Maximum number of labs per patient. Defaults to 10.+ } else {
|
|||
| 15 | -+ | 21x |
- #' @template param_cached+ get(dataname, envir = asNamespace("random.cdisc.data"))
|
|
| 16 |
- #' @templateVar data adlb+ } |
|||
| 17 |
- #'+ } |
|||
| 18 |
- #' @return `data.frame`+ |
|||
| 19 |
- #' @export+ #' Create a Factor with Random Elements of x |
|||
| 21 |
- #' @author tomlinsj, npaszty, Xuefeng Hou+ #' Sample elements from `x` with replacement to build a factor. |
|||
| 23 |
- #' @examples+ #' @param x (`character vector` or `factor`)\cr If character vector then it is also used |
|||
| 24 |
- #' adsl <- radsl(N = 10, seed = 1, study_duration = 2)+ #' as levels of the returned factor. If factor then the levels are used as the new levels. |
|||
| 25 |
- #'+ #' @param N (`numeric`)\cr Number of items to choose. |
|||
| 26 |
- #' adlb <- radlb(adsl, visit_format = "WEEK", n_assessments = 7L, seed = 2)+ #' @param ... Additional arguments to be passed to `sample`. |
|||
| 27 |
- #' adlb+ #' |
|||
| 28 |
- #'+ #' @return A factor of length `N`. |
|||
| 29 |
- #' adlb <- radlb(adsl, visit_format = "CYCLE", n_assessments = 2L, seed = 2)+ #' @export |
|||
| 30 |
- #' adlb+ #' |
|||
| 31 |
- radlb <- function(adsl,+ #' @examples |
|||
| 32 |
- lbcat = c("CHEMISTRY", "CHEMISTRY", "IMMUNOLOGY"),
+ #' sample_fct(letters[1:3], 10) |
|||
| 33 |
- param = c(+ #' sample_fct(iris$Species, 10) |
|||
| 34 |
- "Alanine Aminotransferase Measurement",+ sample_fct <- function(x, N, ...) { # nolint
|
|||
| 35 | -+ | 296x |
- "C-Reactive Protein Measurement",+ checkmate::assert_number(N) |
|
| 36 |
- "Immunoglobulin A Measurement"+ |
|||
| 37 | -+ | 296x |
- ),+ factor(sample(x, N, replace = TRUE, ...), levels = if (is.factor(x)) levels(x) else x) |
|
| 38 |
- paramcd = c("ALT", "CRP", "IGA"),
+ } |
|||
| 39 |
- paramu = c("U/L", "mg/L", "g/L"),
+
|
|||
| 40 |
- aval_mean = c(18, 9, 2.9),+ #' Related Variables: Initialize |
|||
| 41 |
- visit_format = "WEEK",+ #' |
|||
| 42 |
- n_assessments = 5L,+ #' Verify and initialize related variable values. |
|||
| 43 |
- n_days = 5L,+ #' For example, `relvar_init("Alanine Aminotransferase Measurement", "ALT")`.
|
|||
| 44 |
- max_n_lbs = 10L,+ #' |
|||
| 45 |
- lookup = NULL,+ #' @param relvar1 (`list` of `character`)\cr List of n elements. |
|||
| 46 |
- seed = NULL,+ #' @param relvar2 (`list` of `character`)\cr List of n elements. |
|||
| 47 |
- na_percentage = 0,+ #' |
|||
| 48 |
- na_vars = list(+ #' @return A vector of n elements. |
|||
| 49 |
- 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),+ #' @keywords internal |
|||
| 51 |
- CHG2 = c(1235, 0.1), PCHG2 = c(1235, 0.1), CHG = c(1234, 0.1), PCHG = c(1234, 0.1)+ relvar_init <- function(relvar1, relvar2) {
|
|||
| 52 | -+ | 64x |
- ),+ checkmate::assert_character(relvar1, min.len = 1, any.missing = FALSE) |
|
| 53 | -+ | 64x |
- cached = FALSE) {
+ checkmate::assert_character(relvar2, min.len = 1, any.missing = FALSE) |
|
| 54 | -4x | +
- checkmate::assert_flag(cached)+ |
||
| 55 | -4x | +64x |
- if (cached) {
+ if (length(relvar1) != length(relvar2)) {
|
|
| 56 | 1x |
- return(get_cached_data("cadlb"))
+ message(simpleError( |
||
| 57 | -+ | 1x |
- }+ "The argument value length of relvar1 and relvar2 differ. They must contain the same number of elements." |
|
| 58 |
-
+ )) |
|||
| 59 | -3x | +! |
- checkmate::assert_data_frame(adsl)+ return(NA) |
|
| 60 | -3x | +
- checkmate::assert_character(param, min.len = 1, any.missing = FALSE)+ } |
||
| 61 | -3x | +63x |
- checkmate::assert_character(paramcd, min.len = 1, any.missing = FALSE)+ return(list("relvar1" = relvar1, "relvar2" = relvar2))
|
|
| 62 | -3x | +
- checkmate::assert_character(paramu, min.len = 1, any.missing = FALSE)+ } |
||
| 63 | -3x | +
- checkmate::assert_character(lbcat, min.len = 1, any.missing = FALSE)+ |
||
| 64 | -3x | +
- checkmate::assert_string(visit_format)+ #' Related Variables: Assign |
||
| 65 | -3x | +
- checkmate::assert_integer(n_assessments, len = 1, any.missing = FALSE)+ #' |
||
| 66 | -3x | +
- checkmate::assert_integer(n_days, len = 1, any.missing = FALSE)+ #' Assign values to a related variable within a domain. |
||
| 67 | -3x | +
- checkmate::assert_integer(max_n_lbs, len = 1, any.missing = FALSE)+ #' |
||
| 68 | -3x | +
- checkmate::assert_data_frame(lookup, null.ok = TRUE)+ #' @param df (`data.frame`)\cr Data frame containing the related variables. |
||
| 69 | -3x | +
- checkmate::assert_number(seed, null.ok = TRUE)+ #' @param var_name (`character`)\cr Name of variable related to `rel_var` to add to `df`. |
||
| 70 | -3x | +
- checkmate::assert_number(na_percentage, lower = 0, upper = 1)+ #' @param var_values (`any`)\cr Vector of values related to values of `related_var`. |
||
| 71 | -3x | +
- checkmate::assert_true(na_percentage < 1)+ #' @param related_var (`character`)\cr Name of variable within `df` with values to which values |
||
| 72 |
-
+ #' of `var_name` must relate. |
|||
| 73 |
- # validate and initialize related variables+ #' |
|||
| 74 | -3x | +
- lbcat_init_list <- relvar_init(param, lbcat)+ #' @return `df` with added factor variable `var_name` containing `var_values` corresponding to `related_var`. |
||
| 75 | -3x | +
- param_init_list <- relvar_init(param, paramcd)+ #' @export |
||
| 76 | -3x | +
- unit_init_list <- relvar_init(param, paramu)+ #' |
||
| 77 |
-
+ #' @examples |
|||
| 78 | -3x | +
- if (!is.null(seed)) {
+ #' # Example with data.frame. |
||
| 79 | -3x | +
- set.seed(seed)+ #' params <- c("Level A", "Level B", "Level C")
|
||
| 80 |
- }+ #' adlb_df <- data.frame( |
|||
| 81 | -3x | +
- study_duration_secs <- lubridate::seconds(attr(adsl, "study_duration_secs"))+ #' ID = 1:9, |
||
| 82 |
-
+ #' PARAM = factor( |
|||
| 83 | -3x | +
- adlb <- expand.grid(+ #' rep(c("Level A", "Level B", "Level C"), 3),
|
||
| 84 | -3x | +
- STUDYID = unique(adsl$STUDYID),+ #' levels = params |
||
| 85 | -3x | +
- USUBJID = adsl$USUBJID,+ #' ) |
||
| 86 | -3x | +
- PARAM = as.factor(param_init_list$relvar1),+ #' ) |
||
| 87 | -3x | +
- AVISIT = visit_schedule(visit_format = visit_format, n_assessments = n_assessments, n_days = n_days),+ #' rel_var( |
||
| 88 | -3x | +
- stringsAsFactors = FALSE+ #' df = adlb_df, |
||
| 89 |
- )+ #' var_name = "PARAMCD", |
|||
| 90 |
-
+ #' var_values = c("A", "B", "C"),
|
|||
| 91 |
- # assign AVAL based on different tests+ #' related_var = "PARAM" |
|||
| 92 | -3x | +
- adlb <- adlb %>% mutate(AVAL = case_when(+ #' ) |
||
| 93 | -3x | +
- PARAM == param[1] ~ abs(stats::rnorm(nrow(adlb), mean = aval_mean[1], sd = 10)),+ #' |
||
| 94 | -3x | +
- PARAM == param[2] ~ abs(stats::rnorm(nrow(adlb), mean = aval_mean[2], sd = 1)),+ #' # Example with tibble. |
||
| 95 | -3x | +
- PARAM == param[3] ~ abs(stats::rnorm(nrow(adlb), mean = aval_mean[3], sd = 0.1))+ #' adlb_tbl <- tibble::tibble( |
||
| 96 |
- ))+ #' ID = 1:9, |
|||
| 97 |
-
+ #' PARAM = factor( |
|||
| 98 |
- # assign related variable values: PARAMxLBCAT are related+ #' rep(c("Level A", "Level B", "Level C"), 3),
|
|||
| 99 | -3x | +
- adlb <- adlb %>% rel_var(+ #' levels = params |
||
| 100 | -3x | +
- var_name = "LBCAT",+ #' ) |
||
| 101 | -3x | +
- related_var = "PARAM",+ #' ) |
||
| 102 | -3x | +
- var_values = lbcat_init_list$relvar2+ #' rel_var( |
||
| 103 |
- )+ #' df = adlb_tbl, |
|||
| 104 |
-
+ #' var_name = "PARAMCD", |
|||
| 105 |
- # assign related variable values: PARAMxPARAMCD are related+ #' var_values = c("A", "B", "C"),
|
|||
| 106 | -3x | +
- adlb <- adlb %>% rel_var(+ #' related_var = "PARAM" |
||
| 107 | -3x | +
- var_name = "PARAMCD",+ #' ) |
||
| 108 | -3x | +
- related_var = "PARAM",+ rel_var <- function(df, var_name, related_var, var_values = NULL) {
|
||
| 109 | -3x | +64x |
- var_values = param_init_list$relvar2+ checkmate::assert_data_frame(df) |
|
| 110 | -+ | 64x |
- )+ checkmate::assert_string(var_name) |
|
| 111 | -+ | 64x |
-
+ checkmate::assert_string(related_var) |
|
| 112 | -3x | +64x |
- adlb <- adlb %>%+ n_relvar1 <- length(unique(df[, related_var, drop = TRUE])) |
|
| 113 | -3x | +64x |
- dplyr::mutate(LBTESTCD = PARAMCD) %>%+ checkmate::assert_vector(var_values, null.ok = TRUE, len = n_relvar1, any.missing = FALSE) |
|
| 114 | -3x | +1x |
- dplyr::mutate(LBTEST = PARAM)+ if (is.null(var_values)) var_values <- rep(NA, n_relvar1) |
|
| 116 | -3x | +64x |
- adlb <- adlb %>% dplyr::mutate(AVISITN = dplyr::case_when(+ relvar1 <- unique(df[, related_var, drop = TRUE]) |
|
| 117 | -3x | +64x |
- AVISIT == "SCREENING" ~ -1,+ relvar2_values <- rep(NA, nrow(df)) |
|
| 118 | -3x | +64x |
- AVISIT == "BASELINE" ~ 0,+ for (r in seq_len(n_relvar1)) {
|
|
| 119 | -3x | +538x |
- (grepl("^WEEK", AVISIT) | grepl("^CYCLE", AVISIT)) ~ as.numeric(AVISIT) - 2,
+ matched <- which(df[, related_var, drop = TRUE] == relvar1[r]) |
|
| 120 | -3x | +538x |
- TRUE ~ NA_real_+ relvar2_values[matched] <- var_values[r] |
|
| 121 |
- ))+ } |
|||
| 122 | -+ | 64x |
-
+ df[[var_name]] <- factor(relvar2_values) |
|
| 123 | -3x | +64x |
- adlb <- adlb %>% rel_var(+ return(df) |
|
| 124 | -3x | +
- var_name = "AVALU",+ } |
||
| 125 | -3x | +
- related_var = "PARAM",+ |
||
| 126 | -3x | +
- var_values = unit_init_list$relvar2+ #' Create Visit Schedule |
||
| 127 |
- )+ #' |
|||
| 128 |
-
+ #' Create a visit schedule as a factor. |
|||
| 129 | -3x | +
- adlb <- adlb %>%+ #' |
||
| 130 | -3x | +
- dplyr::mutate(AVISITN = dplyr::case_when(+ #' X number of visits, or X number of cycles and Y number of days. |
||
| 131 | -3x | +
- AVISIT == "SCREENING" ~ -1,+ #' |
||
| 132 | -3x | +
- AVISIT == "BASELINE" ~ 0,+ #' @inheritParams argument_convention |
||
| 133 | -3x | +
- (grepl("^WEEK", AVISIT) | grepl("^CYCLE", AVISIT)) ~ as.numeric(AVISIT) - 2,
+ #' |
||
| 134 | -3x | +
- TRUE ~ NA_real_+ #' @return A factor of length `n_assessments`. |
||
| 135 |
- ))+ #' @export |
|||
| 136 |
-
+ #' |
|||
| 137 |
- # order to prepare for change from screening and baseline values+ #' @examples |
|||
| 138 | -3x | +
- adlb <- adlb[order(adlb$STUDYID, adlb$USUBJID, adlb$PARAMCD, adlb$AVISITN), ]+ #' visit_schedule(visit_format = "WEeK", n_assessments = 10L) |
||
| 139 |
-
+ #' visit_schedule(visit_format = "CyCLE", n_assessments = 5L, n_days = 2L) |
|||
| 140 | -3x | +
- adlb <- Reduce(rbind, lapply(split(adlb, adlb$USUBJID), function(x) {
+ visit_schedule <- function(visit_format = "WEEK", |
||
| 141 | -30x | +
- x$STUDYID <- adsl$STUDYID[which(adsl$USUBJID == x$USUBJID[1])]+ n_assessments = 10L, |
||
| 142 | -30x | +
- x$ABLFL2 <- ifelse(x$AVISIT == "SCREENING", "Y", "")+ n_days = 5L) {
|
||
| 143 | -30x | +56x |
- x$ABLFL <- ifelse(toupper(visit_format) == "WEEK" & x$AVISIT == "BASELINE",+ checkmate::assert_string(visit_format, pattern = "^WEEK$|^CYCLE$", ignore.case = TRUE) |
|
| 144 | -30x | +56x |
- "Y",+ checkmate::assert_integer(n_assessments, len = 1, any.missing = FALSE) |
|
| 145 | -30x | +56x |
- ifelse(toupper(visit_format) == "CYCLE" & x$AVISIT == "CYCLE 1 DAY 1", "Y", "")+ checkmate::assert_integer(n_days, len = 1, any.missing = FALSE) |
|
| 146 |
- )+ |
|||
| 147 | -30x | +56x |
- x+ if (toupper(visit_format) == "WEEK") {
|
|
| 148 |
- }))+ # numeric vector of n assessments/cycles/days |
|||
| 149 | -+ | 49x |
-
+ assessments <- 1:n_assessments |
|
| 150 | -3x | +
- adlb$BASE2 <- retain(adlb, adlb$AVAL, adlb$ABLFL2 == "Y")+ # numeric vector for ordering including screening (-1) and baseline (0) place holders |
||
| 151 | -3x | +49x |
- adlb$BASE <- ifelse(adlb$ABLFL2 != "Y", retain(adlb, adlb$AVAL, adlb$ABLFL == "Y"), NA)+ assessments_ord <- -1:n_assessments |
|
| 152 |
-
+ # character vector of nominal visit values |
|||
| 153 | -3x | +49x |
- adlb <- adlb %>%+ visit_values <- c("SCREENING", "BASELINE", paste(toupper(visit_format), assessments, "DAY", (assessments * 7) + 1))
|
|
| 154 | -3x | +7x |
- dplyr::mutate(CHG2 = AVAL - BASE2) %>%+ } else if (toupper(visit_format) == "CYCLE") {
|
|
| 155 | -3x | +7x |
- dplyr::mutate(PCHG2 = 100 * (CHG2 / BASE2)) %>%+ cycles <- sort(rep(1:n_assessments, times = 1, each = n_days)) |
|
| 156 | -3x | +7x |
- dplyr::mutate(CHG = AVAL - BASE) %>%+ days <- rep(seq(1:n_days), times = n_assessments, each = 1) |
|
| 157 | -3x | +7x |
- dplyr::mutate(PCHG = 100 * (CHG / BASE)) %>%+ assessments_ord <- 0:(n_assessments * n_days) |
|
| 158 | -3x | +7x |
- dplyr::mutate(BASETYPE = "LAST") %>%+ visit_values <- c("SCREENING", paste(toupper(visit_format), cycles, "DAY", days))
|
|
| 159 | -3x | +
- dplyr::mutate(ANRLO = dplyr::case_when(+ } |
||
| 160 | -3x | +
- PARAMCD == "ALT" ~ 7,+ |
||
| 161 | -3x | +
- PARAMCD == "CRP" ~ 8,+ # create and order factor variable to return from function |
||
| 162 | -3x | +56x |
- PARAMCD == "IGA" ~ 0.8+ visit_values <- stats::reorder(factor(visit_values), assessments_ord) |
|
| 163 |
- )) %>%+ } |
|||
| 164 | -3x | +
- dplyr::mutate(ANRHI = dplyr::case_when(+ |
||
| 165 | -3x | +
- PARAMCD == "ALT" ~ 55,+ #' Primary Keys: Retain Values |
||
| 166 | -3x | +
- PARAMCD == "CRP" ~ 10,+ #' |
||
| 167 | -3x | +
- PARAMCD == "IGA" ~ 3+ #' Retain values within primary keys. |
||
| 168 |
- )) %>%+ #' |
|||
| 169 | -3x | +
- dplyr::mutate(ANRIND = factor(dplyr::case_when(+ #' @param df (`data.frame`)\cr Data frame in which to apply the retain. |
||
| 170 | -3x | +
- AVAL < ANRLO ~ "LOW",+ #' @param value_var (`any`)\cr Variable in `df` containing the value to be retained. |
||
| 171 | -3x | +
- AVAL > ANRHI ~ "HIGH",+ #' @param event (`expression`)\cr Expression returning a logical value to trigger the retain. |
||
| 172 | -3x | +
- TRUE ~ "NORMAL"+ #' @param outside (`any`)\cr Additional value to retain. Defaults to `NA`. |
||
| 173 |
- ))) %>%+ #' @return A vector of values where expression is true. |
|||
| 174 | -3x | +
- dplyr::mutate(LBSTRESC = factor(dplyr::case_when(+ #' @keywords internal |
||
| 175 | -3x | +
- PARAMCD == "ALT" ~ "<7",+ retain <- function(df, value_var, event, outside = NA) {
|
||
| 176 | -3x | +31x |
- PARAMCD == "CRP" ~ "<8",+ indices <- c(1, which(event == TRUE), nrow(df) + 1) |
|
| 177 | -3x | +31x |
- PARAMCD == "IGA" ~ ">3"+ values <- c(outside, value_var[event == TRUE]) |
|
| 178 | -+ | 31x |
- ))) %>%+ rep(values, diff(indices)) |
|
| 179 | -3x | +
- dplyr::rowwise() %>%+ } |
||
| 180 | -3x | +
- dplyr::mutate(LOQFL = factor(+ |
||
| 181 | -3x | +
- ifelse(eval(parse(text = paste(AVAL, LBSTRESC))), "Y", "N")+ #' Primary Keys: Labels |
||
| 182 |
- )) %>%+ #' |
|||
| 183 | -3x | +
- dplyr::ungroup() %>%+ #' @description Shallow copy of `formatters::var_relabel()`. Used mainly internally to |
||
| 184 | -3x | +
- dplyr::group_by(USUBJID, PARAMCD, BASETYPE) %>%+ #' relabel a subset of variables in a data set. |
||
| 185 | -3x | +
- dplyr::mutate(BNRIND = ANRIND[ABLFL == "Y"]) %>%+ #' |
||
| 186 | -3x | +
- dplyr::ungroup() %>%+ #' @param x (`data.frame`)\cr Data frame containing variables to which labels are applied. |
||
| 187 | -3x | +
- dplyr::mutate(SHIFT1 = factor(ifelse(+ #' @param ... (`named character`)\cr Name-Value pairs, where name corresponds to a variable |
||
| 188 | -3x | +
- AVISITN > 0,+ #' name in `x` and the value to the new variable label. |
||
| 189 | -3x | +
- paste(+ #' @return x (`data.frame`)\cr Data frame with labels applied. |
||
| 190 | -3x | +
- retain(+ #' |
||
| 191 | -3x | +
- adlb, as.character(BNRIND),+ #' @keywords internal |
||
| 192 | -3x | +
- AVISITN == 0+ rcd_var_relabel <- function(x, ...) {
|
||
| 193 | -+ | 79x |
- ),+ stopifnot(is.data.frame(x)) |
|
| 194 | -3x | +79x |
- ANRIND,+ if (missing(...)) {
|
|
| 195 | -3x | +! |
- sep = " to "+ return(x) |
|
| 196 |
- ),+ } |
|||
| 197 | -+ | 79x |
- ""+ dots <- list(...) |
|
| 198 | -+ | 79x |
- ))) %>%+ varnames <- names(dots) |
|
| 199 | -3x | +79x |
- dplyr::mutate(ATOXGR = factor(dplyr::case_when(+ if (is.null(varnames)) {
|
|
| 200 | -3x | +1x |
- ANRIND == "LOW" ~ sample(+ stop("missing variable declarations")
|
|
| 201 | -3x | +
- c("-1", "-2", "-3", "-4", "-5"),
+ } |
||
| 202 | -3x | +78x |
- nrow(adlb),+ map_varnames <- match(varnames, colnames(x)) |
|
| 203 | -3x | +78x |
- replace = TRUE,+ if (any(is.na(map_varnames))) {
|
|
| 204 | -3x | +! |
- prob = c(0.30, 0.25, 0.20, 0.15, 0)+ stop("variables: ", paste(varnames[is.na(map_varnames)], collapse = ", "), " not found")
|
|
| 205 |
- ),+ } |
|||
| 206 | -3x | +78x |
- ANRIND == "HIGH" ~ sample(+ if (any(vapply(dots, Negate(is.character), logical(1)))) {
|
|
| 207 | -3x | +! |
- c("1", "2", "3", "4", "5"),
+ stop("all variable labels must be of type character")
|
|
| 208 | -3x | +
- nrow(adlb),+ } |
||
| 209 | -3x | +78x |
- replace = TRUE,+ for (i in seq_along(map_varnames)) {
|
|
| 210 | -3x | +155x |
- prob = c(0.30, 0.25, 0.20, 0.15, 0)+ attr(x[[map_varnames[[i]]]], "label") <- dots[[i]] |
|
| 211 |
- ),+ } |
|||
| 212 | -3x | +78x |
- ANRIND == "NORMAL" ~ "0"+ x |
|
| 213 |
- ))) %>%+ } |
|||
| 214 | -3x | +
- dplyr::group_by(USUBJID, PARAMCD, BASETYPE) %>%+ |
||
| 215 | -3x | +
- dplyr::mutate(BTOXGR = ATOXGR[ABLFL == "Y"]) %>%+ #' Apply Metadata |
||
| 216 | -3x | +
- dplyr::ungroup() %>%+ #' |
||
| 217 | -3x | +
- dplyr::mutate(ATPTN = 1) %>%+ #' Apply label and variable ordering attributes to domains. |
||
| 218 | -3x | +
- dplyr::mutate(DTYPE = NA) %>%+ #' |
||
| 219 | -3x | +
- dplyr::mutate(BTOXGRL = factor(dplyr::case_when(+ #' @param df (`data.frame`)\cr Data frame to which metadata is applied. |
||
| 220 | -3x | +
- BTOXGR == "0" ~ "0",+ #' @param filename (`yaml`)\cr File containing domain metadata. |
||
| 221 | -3x | +
- BTOXGR == "-1" ~ "1",+ #' @param add_adsl (`logical`)\cr Should ADSL data be merged to domain. |
||
| 222 | -3x | +
- BTOXGR == "-2" ~ "2",+ #' @param adsl_filename (`yaml`)\cr File containing ADSL metadata. |
||
| 223 | -3x | +
- BTOXGR == "-3" ~ "3",+ #' @return Data frame with metadata applied. |
||
| 224 | -3x | +
- BTOXGR == "-4" ~ "4",+ #' |
||
| 225 | -3x | +
- BTOXGR == "1" ~ "<Missing>",+ #' @export |
||
| 226 | -3x | +
- BTOXGR == "2" ~ "<Missing>",+ #' @examples |
||
| 227 | -3x | +
- BTOXGR == "3" ~ "<Missing>",+ #' seed <- 1 |
||
| 228 | -3x | +
- BTOXGR == "4" ~ "<Missing>"+ #' adsl <- radsl(seed = seed) |
||
| 229 |
- ))) %>%+ #' adsub <- radsub(adsl, seed = seed) |
|||
| 230 | -3x | +
- dplyr::mutate(BTOXGRH = factor(dplyr::case_when(+ #' yaml_path <- file.path(path.package("random.cdisc.data"), "inst", "metadata")
|
||
| 231 | -3x | +
- BTOXGR == "0" ~ "0",+ #' adsl <- apply_metadata(adsl, file.path(yaml_path, "ADSL.yml"), FALSE) |
||
| 232 | -3x | +
- BTOXGR == "1" ~ "1",+ #' adsub <- apply_metadata( |
||
| 233 | -3x | +
- BTOXGR == "2" ~ "2",+ #' adsub, file.path(yaml_path, "ADSUB.yml"), TRUE, |
||
| 234 | -3x | +
- BTOXGR == "3" ~ "3",+ #' file.path(yaml_path, "ADSL.yml") |
||
| 235 | -3x | +
- BTOXGR == "4" ~ "4",+ #' ) |
||
| 236 | -3x | +
- BTOXGR == "-1" ~ "<Missing>",+ apply_metadata <- function(df, filename, add_adsl = TRUE, adsl_filename = "metadata/ADSL.yml") {
|
||
| 237 | -3x | +90x |
- BTOXGR == "-2" ~ "<Missing>",+ checkmate::assert_data_frame(df) |
|
| 238 | -3x | +90x |
- BTOXGR == "-3" ~ "<Missing>",+ checkmate::assert_string(filename) |
|
| 239 | -3x | +90x |
- BTOXGR == "-4" ~ "<Missing>",+ checkmate::assert_flag(add_adsl) |
|
| 240 | -+ | 90x |
- ))) %>%+ checkmate::assert_string(adsl_filename) |
|
| 241 | -3x | +
- dplyr::mutate(ATOXGRL = factor(dplyr::case_when(+ |
||
| 242 | -3x | +90x |
- ATOXGR == "0" ~ "0",+ apply_type <- function(df, var, type) {
|
|
| 243 | -3x | +5986x |
- ATOXGR == "-1" ~ "1",+ if (is.null(type)) {
|
|
| 244 | -3x | +! |
- ATOXGR == "-2" ~ "2",+ return() |
|
| 245 | -3x | +
- ATOXGR == "-3" ~ "3",+ } |
||
| 246 | -3x | +
- ATOXGR == "-4" ~ "4",+ |
||
| 247 | -3x | +5986x |
- ATOXGR == "1" ~ "<Missing>",+ if (type == "character" && !is.character(df[[var]])) {
|
|
| 248 | -3x | +12x |
- ATOXGR == "2" ~ "<Missing>",+ df[[var]] <- as.character(df[[var]]) |
|
| 249 | -3x | +5974x |
- ATOXGR == "3" ~ "<Missing>",+ } else if (type == "factor" && !is.factor(df[[var]])) {
|
|
| 250 | -3x | +730x |
- ATOXGR == "4" ~ "<Missing>",+ df[[var]] <- as.factor(df[[var]]) |
|
| 251 | -+ | 5244x |
- ))) %>%+ } else if (type == "integer" && !is.integer(df[[var]])) {
|
|
| 252 | -3x | +225x |
- dplyr::mutate(ATOXGRH = factor(dplyr::case_when(+ df[[var]] <- as.integer(df[[var]]) |
|
| 253 | -3x | +5019x |
- ATOXGR == "0" ~ "0",+ } else if (type == "numeric" && !is.numeric(df[[var]])) {
|
|
| 254 | 3x |
- ATOXGR == "1" ~ "1",+ df[[var]] <- as.numeric(df[[var]]) |
||
| 255 | -3x | +5016x |
- ATOXGR == "2" ~ "2",+ } else if (type == "logical" && !is.logical(df[[var]])) {
|
|
| 256 | -3x | +! |
- ATOXGR == "3" ~ "3",+ df[[var]] <- as.logical(df[[var]]) |
|
| 257 | -3x | +5016x |
- ATOXGR == "4" ~ "4",+ } else if (type == "datetime" && !lubridate::is.POSIXct(df[[var]])) {
|
|
| 258 | -3x | +9x |
- ATOXGR == "-1" ~ "<Missing>",+ df[[var]] <- as.POSIXct(df[[var]]) |
|
| 259 | -3x | +5007x |
- ATOXGR == "-2" ~ "<Missing>",+ } else if (type == "date" && !lubridate::is.Date(df[[var]])) {
|
|
| 260 | -3x | +! |
- ATOXGR == "-3" ~ "<Missing>",+ df[[var]] <- as.Date(df[[var]]) |
|
| 261 | -3x | +
- ATOXGR == "-4" ~ "<Missing>",+ } |
||
| 262 | -+ | 5986x |
- ))) %>%+ return(df) |
|
| 263 | -3x | +
- var_relabel(+ } |
||
| 264 | -3x | +
- STUDYID = attr(adsl$STUDYID, "label"),+ |
||
| 265 | -3x | +
- USUBJID = attr(adsl$USUBJID, "label")+ # remove existing attributes |
||
| 266 | -+ | 90x |
- )+ for (i in base::setdiff(names(attributes(df)), names(attributes(data.frame())))) {
|
|
| 267 | -+ | 3x |
-
+ attr(df, i) <- NULL |
|
| 268 |
- # High and low descriptions of the different PARAMCD values+ } |
|||
| 269 |
- # This is currently hard coded as the GDSR does not have these descriptions yet+ |
|||
| 270 | -3x | +
- grade_lookup <- tibble::tribble(+ # get metadata |
||
| 271 | -3x | +90x |
- ~PARAMCD, ~ATOXDSCL, ~ATOXDSCH,+ metadata <- yaml::yaml.load_file(system.file(filename, package = "random.cdisc.data")) |
|
| 272 | -3x | +90x |
- "ALB", "Hypoalbuminemia", NA_character_,+ adsl_metadata <- if (add_adsl) {
|
|
| 273 | -3x | +64x |
- "ALKPH", NA_character_, "Alkaline phosphatase increased",+ yaml::yaml.load_file(system.file(adsl_filename, package = "random.cdisc.data")) |
|
| 274 | -3x | +
- "ALT", NA_character_, "Alanine aminotransferase increased",+ } else {
|
||
| 275 | -3x | +26x |
- "AST", NA_character_, "Aspartate aminotransferase increased",+ NULL |
|
| 276 | -3x | +
- "BILI", NA_character_, "Blood bilirubin increased",+ } |
||
| 277 | -3x | +90x |
- "CA", "Hypocalcemia", "Hypercalcemia",+ metadata_variables <- append(adsl_metadata$variables, metadata$variables) |
|
| 278 | -3x | +90x |
- "CHOLES", NA_character_, "Cholesterol high",+ metadata_varnames <- names(metadata_variables) |
|
| 279 | -3x | +
- "CK", NA_character_, "CPK increased",+ |
||
| 280 | -3x | +
- "CREAT", NA_character_, "Creatinine increased",+ # find variables that does not have labels and are not it metadata |
||
| 281 | -3x | +90x |
- "CRP", NA_character_, "C reactive protein increased",+ missing_vars_map <- vapply( |
|
| 282 | -3x | +90x |
- "GGT", NA_character_, "GGT increased",+ names(df), |
|
| 283 | -3x | +90x |
- "GLUC", "Hypoglycemia", "Hyperglycemia",+ function(x) {
|
|
| 284 | -3x | +5986x |
- "HGB", "Anemia", "Hemoglobin increased",+ !(x %in% c("STUDYID", "USUBJID", metadata_varnames)) && is.null(attr(df[[x]], "label"))
|
|
| 285 | -3x | +
- "IGA", NA_character_, "Immunoglobulin A increased",+ }, |
||
| 286 | -3x | +90x |
- "POTAS", "Hypokalemia", "Hyperkalemia",+ logical(1) |
|
| 287 | -3x | +
- "LYMPH", "CD4 lymphocytes decreased", NA_character_,+ ) |
||
| 288 | -3x | +90x |
- "PHOS", "Hypophosphatemia", NA_character_,+ missing_vars <- names(df)[missing_vars_map] |
|
| 289 | -3x | +90x |
- "PLAT", "Platelet count decreased", NA_character_,+ if (length(missing_vars) > 0) {
|
|
| 290 | -3x | +! |
- "SODIUM", "Hyponatremia", "Hypernatremia",+ msg <- paste0( |
|
| 291 | -3x | +! |
- "WBC", "White blood cell decreased", "Leukocytosis",+ "Following variables does not have label or are not found in ", |
|
| 292 | -+ | ! |
- )+ filename, |
|
| 293 |
-
+ ": ", |
|||
| 294 | -+ | ! |
- # merge grade_lookup onto adlb+ paste0(missing_vars, collapse = ", ") |
|
| 295 | -3x | +
- adlb <- dplyr::left_join(adlb, grade_lookup, by = "PARAMCD")+ ) |
||
| 296 | -+ | ! |
-
+ warning(msg) |
|
| 297 | -3x | +
- adlb <- var_relabel(+ } |
||
| 298 | -3x | +
- adlb,+ |
||
| 299 | -3x | +90x |
- STUDYID = "Study Identifier",+ if (!all(metadata_varnames %in% names(df))) {
|
|
| 300 | -3x | +6x |
- USUBJID = "Unique Subject Identifier"+ metadata_varnames <- metadata_varnames[metadata_varnames %in% names(df)] |
|
| 301 |
- )+ } |
|||
| 303 |
- # merge ADSL to be able to add LB date and study day variables+ # assign labels to variables |
|||
| 304 | -3x | +90x |
- adlb <- dplyr::inner_join(+ for (var in metadata_varnames) {
|
|
| 305 | -3x | +5986x |
- adlb,+ df <- apply_type(df, var, metadata_variables[[var]]$type) |
|
| 306 | -3x | +5986x |
- adsl,+ attr(df[[var]], "label") <- metadata_variables[[var]]$label |
|
| 307 | -3x | +
- by = c("STUDYID", "USUBJID")
+ } |
||
| 308 |
- ) %>%+ |
|||
| 309 | -3x | +
- dplyr::rowwise() %>%+ # reorder data frame columns to expected BDS order |
||
| 310 | -3x | +90x |
- dplyr::mutate(TRTENDT = lubridate::date(dplyr::case_when(+ df <- df[, unique(c("STUDYID", "USUBJID", metadata_varnames, names(df)))]
|
|
| 311 | -3x | -
- is.na(TRTEDTM) ~ lubridate::floor_date(lubridate::date(TRTSDTM) + study_duration_secs, unit = "day"),- |
- ||
| 312 | -3x | +
- TRUE ~ TRTEDTM+ |
||
| 313 | +312 |
- ))) %>%+ # assign label to data frame |
||
| 314 | -3x | +313 | +90x |
- dplyr::ungroup()+ attr(df, "label") <- metadata$domain$label |
| 315 | +314 | |||
| 315 | +90x | +
+ df+ |
+ ||
| 316 | -3x | +
- adlb <- adlb %>%+ } |
||
| 317 | -3x | +
- dplyr::group_by(USUBJID) %>%+ |
||
| 318 | -3x | +
- dplyr::arrange(USUBJID, AVISITN) %>%+ #' Replace Values in a Vector by NA |
||
| 319 | -3x | +
- dplyr::mutate(ADTM = rep(+ #' |
||
| 320 | -3x | +
- sort(sample(+ #' @description `r lifecycle::badge("stable")`
|
||
| 321 | -3x | +
- seq(lubridate::as_datetime(TRTSDTM[1]), lubridate::as_datetime(TRTENDT[1]), by = "day"),+ #' |
||
| 322 | -3x | +
- size = nlevels(AVISIT)+ #' Randomized replacement of values by `NA`. |
||
| 323 |
- )),+ #' |
|||
| 324 | -3x | +
- each = n() / nlevels(AVISIT)+ #' @inheritParams argument_convention |
||
| 325 |
- )) %>%+ #' @param v (`any`)\cr Vector of any type. |
|||
| 326 | -3x | +
- dplyr::ungroup() %>%+ #' @param percentage (`proportion`)\cr Value between 0 and 1 defining |
||
| 327 | -3x | +
- dplyr::mutate(ADY = ceiling(difftime(ADTM, TRTSDTM, units = "days"))) %>%+ #' how much of the vector shall be replaced by `NA`. This number |
||
| 328 | -3x | +
- dplyr::select(-TRTENDT) %>%+ #' is randomized by +/- 5% to have full randomization. |
||
| 329 | -3x | +
- dplyr::arrange(STUDYID, USUBJID, ADTM)+ #' |
||
| 330 |
-
+ #' @return The input vector `v` where a certain number of values are replaced by `NA`. |
|||
| 331 | -3x | +
- adlb <- adlb %>%+ #' |
||
| 332 | -3x | +
- dplyr::mutate(ASPID = sample(seq_len(dplyr::n()))) %>%+ #' @export |
||
| 333 | -3x | +
- dplyr::group_by(USUBJID) %>%+ replace_na <- function(v, percentage = 0.05, seed = NULL) {
|
||
| 334 | -3x | +9x |
- dplyr::mutate(LBSEQ = seq_len(dplyr::n())) %>%+ checkmate::assert_number(percentage, lower = 0, upper = 1) |
|
| 335 | -3x | +
- dplyr::mutate(ASEQ = LBSEQ) %>%+ |
||
| 336 | -3x | +9x |
- dplyr::ungroup() %>%+ if (percentage == 0) {
|
|
| 337 | -3x | +1x |
- dplyr::arrange(+ return(v) |
|
| 338 | -3x | +
- STUDYID,+ } |
||
| 339 | -3x | +
- USUBJID,+ |
||
| 340 | -3x | +8x |
- PARAMCD,+ if (!is.null(seed) && !is.na(seed)) {
|
|
| 341 | -3x | +8x |
- BASETYPE,+ set.seed(seed) |
|
| 342 | -3x | +
- AVISITN,+ } |
||
| 343 | -3x | +
- ATPTN,+ |
||
| 344 | -3x | +
- DTYPE,+ # randomize the percentage |
||
| 345 | -3x | +8x |
- ADTM,+ ind <- sample(seq_along(v), round(length(v) * percentage)) |
|
| 346 | -3x | +
- LBSEQ,+ |
||
| 347 | -3x | +8x |
- ASPID+ v[ind] <- NA |
|
| 348 |
- )+ |
|||
| 349 | -+ | 8x |
-
+ return(v) |
|
| 350 | -3x | +
- adlb <- adlb %>% dplyr::mutate(ONTRTFL = factor(dplyr::case_when(+ } |
||
| 351 | -3x | +
- !AVISIT %in% c("SCREENING", "BASELINE") ~ "Y",
+
|
||
| 352 | -3x | +
- TRUE ~ ""+ #' Replace Values with NA |
||
| 353 |
- )))+ #' |
|||
| 354 |
-
+ #' @description `r lifecycle::badge("stable")`
|
|||
| 355 | -3x | +
- flag_variables <- function(data,+ #' |
||
| 356 | -3x | +
- apply_grouping,+ #' Replace column values with `NA`s. |
||
| 357 | -3x | +
- apply_filter,+ #' |
||
| 358 | -3x | +
- apply_mutate) {
+ #' @inheritParams argument_convention |
||
| 359 | -15x | +
- data_compare <- data %>%+ #' @param ds (`data.frame`)\cr Any data set. |
||
| 360 | -15x | +
- dplyr::mutate(row_check = seq_len(nrow(data)))+ #' |
||
| 361 |
-
+ #' @return dataframe without `NA` values. |
|||
| 362 | -15x | +
- data <- data_compare %>%+ #' |
||
| 363 |
- {
+ #' @export |
|||
| 364 | -15x | +
- if (apply_grouping == TRUE) {
+ mutate_na <- function(ds, na_vars = NULL, na_percentage = 0.05) {
|
||
| 365 | -9x | +5x |
- dplyr::group_by(., USUBJID, PARAMCD, BASETYPE, AVISIT)+ if (!is.null(na_vars)) {
|
|
| 366 | -+ | 4x |
- } else {
+ stopifnot(is.list(na_vars)) # any list is OK; as values can be left NA |
|
| 367 | -6x | +4x |
- dplyr::group_by(., USUBJID, PARAMCD, BASETYPE)+ stopifnot(length(names(na_vars)) == length(na_vars)) # names for all elements |
|
| 368 |
- }+ } else {
|
|||
| 369 | -+ | 1x |
- } %>%+ na_vars <- names(ds) |
|
| 370 | -15x | +
- dplyr::arrange(ADTM, ASPID, LBSEQ) %>%+ } |
||
| 371 |
- {
+
|
|||
| 372 | -15x | +5x |
- if (apply_filter == TRUE) {
+ stopifnot(is.numeric(na_percentage)) |
|
| 373 | -6x | +5x |
- dplyr::filter(+ stopifnot(na_percentage >= 0 && na_percentage < 1) |
|
| 374 |
- .,+ |
|||
| 375 | -6x | +5x |
- (AVISIT != "BASELINE" & AVISIT != "SCREENING") &+ for (na_var in names(na_vars)) {
|
|
| 376 | -6x | +8x |
- (ONTRTFL == "Y" | ADTM <= TRTSDTM)+ if (!is.na(na_var)) {
|
|
| 377 | -+ | 8x |
- ) %>%+ if (!na_var %in% names(ds)) {
|
|
| 378 | -6x | +1x |
- dplyr::filter(ATOXGR == max(as.numeric(as.character(ATOXGR))))+ warning(paste(na_var, "not in column names")) |
|
| 379 | -9x | +
- } else if (apply_filter == FALSE) {
+ } else {
|
||
| 380 | -6x | +7x |
- dplyr::filter(+ ds <- ds %>% |
|
| 381 | -+ | 7x |
- .,+ ungroup_rowwise_df() %>% |
|
| 382 | -6x | +7x |
- (AVISIT != "BASELINE" & AVISIT != "SCREENING") &+ dplyr::mutate( |
|
| 383 | -6x | +7x |
- (ONTRTFL == "Y" | ADTM <= TRTSDTM)+ !!na_var := ds[[na_var]] %>% |
|
| 384 | -+ | 7x |
- ) %>%+ replace_na( |
|
| 385 | -6x | +7x |
- dplyr::filter(ATOXGR == min(as.numeric(as.character(ATOXGR))))+ percentage = ifelse(is.na(na_vars[[na_var]][2]), na_percentage, na_vars[[na_var]][2]), |
|
| 386 | -+ | 7x |
- } else {
+ seed = na_vars[[na_var]][1] |
|
| 387 | -3x | +
- dplyr::filter(+ ) |
||
| 388 |
- .,+ ) |
|||
| 389 | -3x | +
- AVAL == min(AVAL) &+ } |
||
| 390 | -3x | +
- (AVISIT != "BASELINE" & AVISIT != "SCREENING") &+ } |
||
| 391 | -3x | +
- (ONTRTFL == "Y" | ADTM <= TRTSDTM)+ } |
||
| 392 | -+ | 5x |
- )+ return(ds) |
|
| 393 |
- }+ } |
|||
| 394 |
- } %>%+ |
|||
| 395 | -15x | +
- dplyr::slice(1) %>%+ ungroup_rowwise_df <- function(x) {
|
||
| 396 | -+ | 7x |
- {
+ class(x) <- c("tbl", "tbl_df", "data.frame")
|
|
| 397 | -15x | +7x |
- if (apply_mutate == TRUE) {
+ return(x) |
|
| 398 | -12x | +
- dplyr::mutate(., new_var = ifelse(is.na(DTYPE), "Y", ""))+ } |
||
| 399 |
- } else {
+
|
|||
| 400 | -3x | +
- dplyr::mutate(., new_var = ifelse(is.na(AVAL) == FALSE & is.na(DTYPE), "Y", ""))+ #' Zero-Truncated Poisson Distribution |
||
| 401 |
- }+ #' |
|||
| 402 |
- } %>%+ #' @description `r lifecycle::badge("stable")`
|
|||
| 403 | -15x | +
- dplyr::ungroup()+ #' |
||
| 404 |
-
+ #' This generates random numbers from a zero-truncated Poisson distribution, |
|||
| 405 | -15x | +
- data_compare$new_var <- ifelse(data_compare$row_check %in% data$row_check, "Y", "")+ #' i.e. from `X | X > 0` when `X ~ Poisson(lambda)`. The advantage here is that |
||
| 406 |
-
+ #' we guarantee to return exactly `n` numbers and without using a loop internally. |
|||
| 407 | -15x | +
- data_compare <- data_compare[, -which(names(data_compare) %in% c("row_check"))]
+ #' This solution was provided in a post by |
||
| 408 |
-
+ #' [Peter Dalgaard](https://stat.ethz.ch/pipermail/r-help/2005-May/070680.html). |
|||
| 409 | -15x | +
- return(data_compare)+ #' |
||
| 410 |
- }+ #' @param n (`numeric`)\cr Number of random numbers. |
|||
| 411 |
-
+ #' @param lambda (`numeric`)\cr Non-negative mean(s). |
|||
| 412 | -3x | +
- adlb <- flag_variables(adlb, TRUE, "ELSE", FALSE) %>% dplyr::rename(WORS01FL = "new_var")+ #' |
||
| 413 | -3x | +
- adlb <- flag_variables(adlb, FALSE, TRUE, TRUE) %>% dplyr::rename(WGRHIFL = "new_var")+ #' @return The random numbers. |
||
| 414 | -3x | +
- adlb <- flag_variables(adlb, FALSE, FALSE, TRUE) %>% dplyr::rename(WGRLOFL = "new_var")+ #' @export |
||
| 415 | -3x | +
- adlb <- flag_variables(adlb, TRUE, TRUE, TRUE) %>% dplyr::rename(WGRHIVFL = "new_var")+ #' |
||
| 416 | -3x | +
- adlb <- flag_variables(adlb, TRUE, FALSE, TRUE) %>% dplyr::rename(WGRLOVFL = "new_var")+ #' @examples |
||
| 417 |
-
+ #' x <- rpois(1e6, lambda = 5) |
|||
| 418 | -3x | +
- adlb <- adlb %>% dplyr::mutate(ANL01FL = ifelse(+ #' x <- x[x > 0] |
||
| 419 | -3x | +
- (ABLFL == "Y" | (WORS01FL == "Y" & is.na(DTYPE))) &+ #' hist(x) |
||
| 420 | -3x | +
- (AVISIT != "SCREENING"),+ #' |
||
| 421 | -3x | +
- "Y",+ #' y <- rtpois(1e6, lambda = 5) |
||
| 422 |
- ""+ #' hist(y) |
|||
| 423 |
- ))+ rtpois <- function(n, lambda) {
|
|||
| 424 | -+ | 121x |
-
+ stats::qpois(stats::runif(n, stats::dpois(0, lambda), 1), lambda) |
|
| 425 | -3x | +
- if (length(na_vars) > 0 && na_percentage > 0) {
+ } |
||
| 426 | -! | +
- adlb <- mutate_na(ds = adlb, na_vars = na_vars, na_percentage = na_percentage)+ |
||
| 427 |
- }+ #' Truncated Exponential Distribution |
|||
| 428 |
-
+ #' |
|||
| 429 |
- # apply metadata+ #' @description `r lifecycle::badge("stable")`
|
|||
| 430 |
-
+ #' |
|||
| 431 | -3x | +
- adlb <- apply_metadata(adlb, "metadata/ADLB.yml")+ #' This generates random numbers from a truncated Exponential distribution, |
||
| 432 |
-
+ #' i.e. from `X | X > l` or `X | X < r` when `X ~ Exp(rate)`. The advantage here is that |
|||
| 433 | -3x | +
- return(adlb)+ #' we guarantee to return exactly `n` numbers and without using a loop internally. |
||
| 434 |
- }+ #' This can be derived from the quantile functions of the left- and right-truncated |
| 1 | +435 |
- #' EORTC QLQ-C30 V3 Analysis Dataset (ADQLQC)+ #' Exponential distributions. |
|
| 2 | +436 |
#' |
|
| 3 | +437 |
- #' @description `r lifecycle::badge("stable")`
+ #' @param n (`numeric`)\cr Number of random numbers. |
|
| 4 | +438 |
- #'+ #' @param rate (`numeric`)\cr Non-negative rate. |
|
| 5 | +439 |
- #' Function for generating a random EORTC QLQ-C30 V3 Analysis Dataset for a given+ #' @param l (`numeric`)\cr Positive left-hand truncation parameter. |
|
| 6 | +440 |
- #' Subject-Level Analysis Dataset.+ #' @param r (`numeric`)\cr Positive right-hand truncation parameter. |
|
| 7 | +441 |
#' |
|
| 8 | +442 |
- #' @details+ #' @return The random numbers. If neither `l` nor `r` are provided then the usual Exponential |
|
| 9 | +443 |
- #'+ #' distribution is used. |
|
| 10 | +444 |
- #' Keys: `STUDYID`, `USUBJID`, `PARCAT1N`, `PARAMCD`, `BASETYPE`, `AVISITN`, `ATPTN`, `ADTM`, `QSSEQ`+ #' @export |
|
| 11 | +445 |
#' |
|
| 12 | -- |
- #' @inheritParams argument_convention- |
- |
| 13 | +446 |
- #' @param percent (`numeric`)\cr Completion - Completed at least y percent of questions, 1 record per visit+ #' @examples |
|
| 14 | +447 |
- #' @param number (`numeric`)\cr Completion - Completed at least x question(s), 1 record per visit+ #' x <- stats::rexp(1e6, rate = 5) |
|
| 15 | +448 |
- #' @template param_cached+ #' x <- x[x > 0.5] |
|
| 16 | +449 |
- #' @templateVar data adqlqc+ #' hist(x) |
|
| 17 | +450 |
#' |
|
| 18 | +451 |
- #' @return `data.frame`+ #' y <- rtexp(1e6, rate = 5, l = 0.5) |
|
| 19 | +452 |
- #' @export+ #' hist(y) |
|
| 20 | +453 |
#' |
|
| 21 | +454 |
- #' @examples+ #' z <- rtexp(1e6, rate = 5, r = 0.5) |
|
| 22 | +455 |
- #' adsl <- radsl(N = 10, study_duration = 2, seed = 1)+ #' hist(z) |
|
| 23 | +456 |
- #'+ rtexp <- function(n, rate, l = NULL, r = NULL) {
|
|
| 24 | -+ | ||
| 457 | +123x |
- #' adqlqc <- radqlqc(adsl, seed = 1, percent = 80, number = 2)+ if (!is.null(l)) {
|
|
| 25 | -+ | ||
| 458 | +1x |
- #' adqlqc+ l - log(1 - stats::runif(n)) / rate |
|
| 26 | -+ | ||
| 459 | +122x |
- radqlqc <- function(adsl,+ } else if (!is.null(r)) {
|
|
| 27 | -+ | ||
| 460 | +121x |
- percent,+ -log(1 - stats::runif(n) * (1 - exp(-r * rate))) / rate |
|
| 28 | +461 |
- number,+ } else {
+ |
+ |
| 462 | +1x | +
+ stats::rexp(n, rate)+ |
+ |
| 463 | ++ |
+ }+ |
+ |
| 464 | ++ |
+ }+ |
+
| 1 | ++ |
+ #' Medical History Analysis Dataset (ADMH)+ |
+ |
| 2 | ++ |
+ #'+ |
+ |
| 3 | ++ |
+ #' @description `r lifecycle::badge("stable")`
+ |
+ |
| 4 | ++ |
+ #'+ |
+ |
| 5 | ++ |
+ #' Function for generating a random Medical History Analysis Dataset for a given+ |
+ |
| 6 | ++ |
+ #' Subject-Level Analysis Dataset.+ |
+ |
| 7 | ++ |
+ #'+ |
+ |
| 8 | ++ |
+ #' @details One record per each record in the corresponding SDTM domain.+ |
+ |
| 9 | ++ |
+ #'+ |
+ |
| 10 | ++ |
+ #' Keys: `STUDYID`, `USUBJID`, `ASTDTM`, `MHSEQ`+ |
+ |
| 11 | ++ |
+ #'+ |
+ |
| 12 | ++ |
+ #' @inheritParams argument_convention+ |
+ |
| 13 | ++ |
+ #' @param max_n_mhs (`integer`)\cr Maximum number of MHs per patient. Defaults to 10.+ |
+ |
| 14 | ++ |
+ #' @template param_cached+ |
+ |
| 15 | ++ |
+ #' @templateVar data admh+ |
+ |
| 16 | ++ |
+ #'+ |
+ |
| 17 | ++ |
+ #' @return `data.frame`+ |
+ |
| 18 | ++ |
+ #' @export+ |
+ |
| 19 | ++ |
+ #'+ |
+ |
| 20 | ++ |
+ #' @examples+ |
+ |
| 21 | ++ |
+ #' adsl <- radsl(N = 10, study_duration = 2, seed = 1)+ |
+ |
| 22 | ++ |
+ #'+ |
+ |
| 23 | ++ |
+ #' admh <- radmh(adsl, seed = 2)+ |
+ |
| 24 | ++ |
+ #' admh+ |
+ |
| 25 | ++ |
+ radmh <- function(adsl,+ |
+ |
| 26 | ++ |
+ max_n_mhs = 10L,+ |
+ |
| 27 | ++ |
+ lookup = NULL,+ |
+ |
| 28 | ++ |
+ seed = NULL, |
|
| 29 |
- seed = NULL,+ na_percentage = 0, |
||
| 30 |
- cached = FALSE) {
+ na_vars = list(MHBODSYS = c(NA, 0.1), MHDECOD = c(1234, 0.1)), |
||
| 31 | -4x | +
- checkmate::assert_flag(cached)+ cached = FALSE) {
|
|
| 32 | 4x |
- if (cached) {
+ checkmate::assert_flag(cached) |
|
| 33 | -1x | +4x |
- return(get_cached_data("cadqlqc"))
+ if (cached) {
|
| 34 | -+ | 1x |
- }+ return(get_cached_data("cadmh"))
|
| 35 |
-
+ } |
||
| 36 | -3x | +
- checkmate::assert_data_frame(adsl)+ |
|
| 37 | 3x |
- checkmate::assert_number(percent, lower = 1, upper = 100)+ checkmate::assert_data_frame(adsl) |
|
| 38 | 3x |
- checkmate::assert_number(number, lower = 1)+ checkmate::assert_integer(max_n_mhs, len = 1, any.missing = FALSE) |
|
| 39 | -+ | 3x |
-
+ checkmate::assert_number(seed, null.ok = TRUE) |
| 40 | 3x |
- if (!is.null(seed)) {
+ checkmate::assert_number(na_percentage, lower = 0, upper = 1) |
|
| 41 | 3x |
- set.seed(seed)+ checkmate::assert_true(na_percentage < 1) |
|
| 42 |
- }+ |
||
| 43 | -+ | 3x |
-
+ checkmate::assert_data_frame(lookup, null.ok = TRUE) |
| 44 | -+ | 3x |
- # ADQLQC data -------------------------------------------------------------+ lookup_mh <- if (!is.null(lookup)) {
|
| 45 | -3x | +! |
- qs <- get_qs_data(adsl, n_assessments = 5L, seed = seed, na_percentage = 0.1)+ lookup |
| 46 |
- # prepare ADaM ADQLQC data+ } else {
|
||
| 47 | 3x |
- adqlqc1 <- prep_adqlqc(df = qs)+ tibble::tribble( |
|
| 48 | -+ | 3x |
- # derive AVAL and AVALC+ ~MHBODSYS, ~MHDECOD, ~MHSOC, |
| 49 | 3x |
- adqlqc1 <- mutate(+ "cl A", "trm A_1/2", "cl A", |
|
| 50 | 3x |
- adqlqc1,+ "cl A", "trm A_2/2", "cl A", |
|
| 51 | 3x |
- AVAL = as.numeric(QSSTRESC),+ "cl B", "trm B_1/3", "cl B", |
|
| 52 | 3x |
- AVALC = case_when(+ "cl B", "trm B_2/3", "cl B", |
|
| 53 | 3x |
- QSTESTCD == "QSALL" ~ QSREASND,+ "cl B", "trm B_3/3", "cl B", |
|
| 54 | 3x |
- TRUE ~ QSORRES+ "cl C", "trm C_1/2", "cl C", |
|
| 55 | -+ | 3x |
- ),+ "cl C", "trm C_2/2", "cl C", |
| 56 | 3x |
- AVISIT = VISIT,+ "cl D", "trm D_1/3", "cl D", |
|
| 57 | 3x |
- AVISITN = VISITNUM,+ "cl D", "trm D_2/3", "cl D", |
|
| 58 | 3x |
- ADTM = QSDTC+ "cl D", "trm D_3/3", "cl D" |
|
| 59 |
- )+ ) |
||
| 60 |
- # include scale calculation+ } |
||
| 61 | -3x | +
- adqlqc_tmp <- calc_scales(adqlqc1)+ |
|
| 62 | -+ | 3x |
- # order to prepare for change from screening and baseline values+ if (!is.null(seed)) {
|
| 63 | 3x |
- adqlqc_tmp <- adqlqc_tmp[order(adqlqc_tmp$STUDYID, adqlqc_tmp$USUBJID, adqlqc_tmp$PARAMCD, adqlqc_tmp$AVISITN), ]+ set.seed(seed) |
|
| 64 |
-
+ } |
||
| 65 | 3x |
- adqlqc_tmp <- Reduce(+ study_duration_secs <- lubridate::seconds(attr(adsl, "study_duration_secs")) |
|
| 66 | -3x | +
- rbind,+ |
|
| 67 | 3x |
- lapply(+ admh <- Map( |
|
| 68 | 3x |
- split(adqlqc_tmp, adqlqc_tmp$USUBJID),+ function(id, sid) {
|
|
| 69 | -3x | +30x |
- function(x) {
+ n_mhs <- sample(0:max_n_mhs, 1) |
| 70 | 30x |
- x$STUDYID <- adsl$STUDYID[which(adsl$USUBJID == x$USUBJID[1])]+ i <- sample(seq_len(nrow(lookup_mh)), n_mhs, TRUE) |
|
| 71 | 30x |
- x$ABLFL2 <- ifelse(x$AVISIT == "SCREENING", "Y", "")+ dplyr::mutate( |
|
| 72 | 30x |
- x$ABLFL <- ifelse(+ lookup_mh[i, ], |
|
| 73 | 30x |
- x$AVISIT == "BASELINE" &+ USUBJID = id, |
|
| 74 | 30x |
- x$PARAMCD != "EX028",+ STUDYID = sid |
|
| 75 | -30x | +
- "Y",+ ) |
|
| 76 | -30x | +
- ifelse(+ }, |
|
| 77 | -30x | +3x |
- x$AVISIT == "CYCLE 1 DAY 1" &+ adsl$USUBJID, |
| 78 | -30x | +3x |
- x$PARAMCD != "EX028",+ adsl$STUDYID |
| 79 | -30x | +
- "Y",+ ) %>% |
|
| 80 | -+ | 3x |
- ""+ Reduce(rbind, .) %>% |
| 81 | -+ | 3x |
- )+ `[`(c(4, 5, 1, 2, 3)) %>% |
| 82 | -+ | 3x |
- )+ dplyr::mutate(MHTERM = MHDECOD) |
| 83 | -30x | +
- x+ |
|
| 84 | -+ | 3x |
- }+ admh <- rcd_var_relabel( |
| 85 | -+ | 3x |
- )+ admh, |
| 86 | -+ | 3x |
- )+ STUDYID = "Study Identifier", |
| 87 | -+ | 3x |
-
+ USUBJID = "Unique Subject Identifier" |
| 88 | -3x | +
- adqlqc_tmp$BASE2 <- ifelse(+ ) |
|
| 89 | -3x | +
- str_detect(adqlqc_tmp$PARCAT2, "Completion", negate = TRUE),+ |
|
| 90 | -3x | +
- retain(+ # merge ADSL to be able to add MH date and study day variables |
|
| 91 | 3x |
- df = adqlqc_tmp,+ admh <- dplyr::inner_join( |
|
| 92 | 3x |
- value_var = adqlqc_tmp$AVAL,+ admh, |
|
| 93 | 3x |
- event = adqlqc_tmp$ABLFL2 == "Y"+ adsl, |
|
| 94 | -+ | 3x |
- ),+ by = c("STUDYID", "USUBJID")
|
| 95 | -3x | +
- NA+ ) %>% |
|
| 96 | -+ | 3x |
- )+ dplyr::rowwise() %>% |
| 97 | -+ | 3x |
-
+ dplyr::mutate(TRTENDT = lubridate::date(dplyr::case_when( |
| 98 | 3x |
- adqlqc_tmp$BASE <- ifelse(+ is.na(TRTEDTM) ~ lubridate::floor_date(lubridate::date(TRTSDTM) + study_duration_secs, unit = "day"), |
|
| 99 | 3x |
- adqlqc_tmp$ABLFL2 != "Y" &+ TRUE ~ TRTEDTM |
|
| 100 | -3x | +
- str_detect(adqlqc_tmp$PARCAT2, "Completion", negate = TRUE),+ ))) %>% |
|
| 101 | 3x |
- retain(+ dplyr::mutate(ASTDTM = sample( |
|
| 102 | 3x |
- adqlqc_tmp,+ seq(lubridate::as_datetime(TRTSDTM), lubridate::as_datetime(TRTENDT), by = "day"), |
|
| 103 | 3x |
- adqlqc_tmp$AVAL,+ size = 1 |
|
| 104 | -3x | +
- adqlqc_tmp$ABLFL == "Y"+ )) %>% |
|
| 105 | -+ | 3x |
- ),+ dplyr::mutate(ASTDY = ceiling(difftime(ASTDTM, TRTSDTM, units = "days"))) %>% |
| 106 | -3x | +
- NA+ # add 1 to end of range incase both values passed to sample() are the same |
|
| 107 | -+ | 3x |
- )+ dplyr::mutate(AENDTM = sample( |
| 108 | -+ | 3x |
-
+ seq(lubridate::as_datetime(ASTDTM), lubridate::as_datetime(TRTENDT + 1), by = "day"), |
| 109 | 3x |
- adqlqc_tmp <- adqlqc_tmp %>%+ size = 1 |
|
| 110 | -3x | +
- dplyr::mutate(CHG2 = AVAL - BASE2) %>%+ )) %>% |
|
| 111 | 3x |
- dplyr::mutate(PCHG2 = 100 * (CHG2 / BASE2)) %>%+ dplyr::mutate(AENDY = ceiling(difftime(AENDTM, TRTSDTM, units = "days"))) %>% |
|
| 112 | 3x |
- dplyr::mutate(CHG = AVAL - BASE) %>%+ select(-TRTENDT) %>% |
|
| 113 | 3x |
- dplyr::mutate(PCHG = 100 * (CHG / BASE)) %>%+ dplyr::ungroup() %>% |
|
| 114 | 3x |
- var_relabel(+ dplyr::arrange(STUDYID, USUBJID, ASTDTM, MHTERM) %>% |
|
| 115 | 3x |
- STUDYID = attr(adsl$STUDYID, "label"),+ dplyr::mutate(MHDISTAT = sample( |
|
| 116 | 3x |
- USUBJID = attr(adsl$USUBJID, "label")+ x = c("Resolved", "Ongoing with treatment", "Ongoing without treatment"),
|
|
| 117 | -+ | 3x |
- )+ prob = c(0.6, 0.2, 0.2), |
| 118 | -+ | 3x |
- # derive CHGCAT1 ----------------------------------------------------------+ size = dplyr::n(), |
| 119 | 3x |
- adqlqc_tmp <- derv_chgcat1(dataset = adqlqc_tmp)+ replace = TRUE |
|
| 120 |
-
+ )) %>% |
||
| 121 | 3x |
- adqlqc_tmp <- var_relabel(+ dplyr::mutate(ATIREL = dplyr::case_when( |
|
| 122 | 3x |
- adqlqc_tmp,+ (AENDTM < TRTSDTM | (is.na(AENDTM) & MHDISTAT == "Resolved")) ~ "PRIOR", |
|
| 123 | 3x |
- STUDYID = "Study Identifier",+ (AENDTM >= TRTSDTM | (is.na(AENDTM) & grepl("Ongoing", MHDISTAT))) ~ "PRIOR_CONCOMITANT"
|
|
| 124 | -3x | +
- USUBJID = "Unique Subject Identifier"+ )) |
|
| 125 |
- )+ |
||
| 126 | -+ | 3x |
-
+ admh <- admh %>% |
| 127 | 3x |
- adqlqc_tmp <- arrange(+ dplyr::group_by(USUBJID) %>% |
|
| 128 | 3x |
- adqlqc_tmp,+ dplyr::mutate(MHSEQ = seq_len(dplyr::n())) %>% |
|
| 129 | 3x |
- USUBJID,+ dplyr::mutate(ASEQ = MHSEQ) %>% |
|
| 130 | 3x |
- AVISITN+ dplyr::ungroup() %>% |
|
| 131 | -+ | 3x |
- )+ dplyr::arrange(STUDYID, USUBJID, ASTDTM, MHSEQ) |
| 132 |
- # Merge ADSL --------------------------------------------------------------+ |
||
| 133 | -+ | 3x |
- # ADSL variables needed for ADQLQC+ if (length(na_vars) > 0 && na_percentage > 0 && na_percentage <= 1) {
|
| 134 | -3x | +! |
- adsl_vars <- c(+ admh <- mutate_na(ds = admh, na_vars = na_vars, na_percentage = na_percentage) |
| 135 | -3x | +
- "STUDYID", "USUBJID", "SUBJID", "SITEID", "REGION1", "COUNTRY", "ETHNIC", "AGE",+ } |
|
| 136 | -3x | +
- "AGEU", "AAGE", "AAGEU", "AGEGR1", "AGEGR2", "AGEGR3", "STRATwNM", "STRATw", "STRATwV",+ |
|
| 137 | -3x | +
- "SEX", "RACE", "ITTFL", "SAFFL", "PPROTFL", "TRT01P", "TRT01A",+ # apply metadata |
|
| 138 | 3x |
- "TRTSEQP", "TRTSEQA", "TRTSDTM", "TRTSDT", "TRTEDTM", "TRTEDT", "DCUTDT"+ admh <- apply_metadata(admh, "metadata/ADMH.yml") |
|
| 139 |
- )+ |
||
| 140 | 3x |
- adsl <- select(+ return(admh) |
|
| 141 | -3x | +
- adsl,+ } |
|
| 142 | -3x | +
| 1 | +
- any_of(adsl_vars)+ #' Tumor Response Analysis Dataset (ADTR) |
|||
| 143 | +2 |
- )+ #' |
||
| 144 | -3x | +|||
| 3 | +
- adqlqc <- dplyr::inner_join(+ #' @description `r lifecycle::badge("stable")`
|
|||
| 145 | -3x | +|||
| 4 | +
- adqlqc_tmp,+ #' |
|||
| 146 | -3x | +|||
| 5 | +
- adsl,+ #' Function for generating a random Tumor Response Analysis Dataset for a given |
|||
| 147 | -3x | +|||
| 6 | +
- by = c("STUDYID", "USUBJID")
+ #' Subject-Level Analysis Dataset. |
|||
| 148 | +7 |
- ) %>%+ #' |
||
| 149 | -3x | +|||
| 8 | +
- dplyr::mutate(+ #' @details One record per subject per parameter per analysis visit per analysis date. |
|||
| 150 | -3x | +|||
| 9 | +
- ADY_der = ceiling(difftime(ADTM, TRTSDTM, units = "days")),+ #' |
|||
| 151 | -3x | +|||
| 10 | +
- ADY = case_when(+ #' Keys: `STUDYID`, `USUBJID`, `PARAMCD`, `BASETYPE`, `AVISITN`, `DTYPE` |
|||
| 152 | -3x | +|||
| 11 | +
- ADY_der >= 0 ~ ADY_der + 1,+ #' |
|||
| 153 | -3x | +|||
| 12 | +
- TRUE ~ ADY_der+ #' @inheritParams argument_convention |
|||
| 154 | +13 |
- )+ #' @param ... Additional arguments to be passed to `radrs`. |
||
| 155 | +14 |
- ) %>%+ #' @template param_cached |
||
| 156 | -3x | +|||
| 15 | +
- select(-ADY_der)+ #' @templateVar data adtr |
|||
| 157 | +16 |
-
+ #' |
||
| 158 | +17 |
- # get compliance data ---------------------------------------------------+ #' @return `data.frame` |
||
| 159 | -3x | +|||
| 18 | +
- compliance_data <- comp_derv(+ #' @export |
|||
| 160 | -3x | +|||
| 19 | +
- dataset = adqlqc,+ #' |
|||
| 161 | -3x | +|||
| 20 | +
- percent = percent,+ #' @author tomlinsj, npaszty, Xuefeng Hou, dipietrc |
|||
| 162 | -3x | +|||
| 21 | +
- number = number+ #' |
|||
| 163 | +22 |
- )+ #' @examples |
||
| 164 | +23 |
- # add ADSL variables+ #' adsl <- radsl(N = 10, seed = 1, study_duration = 2) |
||
| 165 | -3x | +|||
| 24 | +
- compliance_data <- left_join(+ #' |
|||
| 166 | -3x | +|||
| 25 | +
- compliance_data,+ #' adtr <- radtr(adsl, seed = 2) |
|||
| 167 | -3x | +|||
| 26 | +
- adsl,+ #' adtr |
|||
| 168 | -3x | +|||
| 27 | +
- by = c("STUDYID", "USUBJID")
+ radtr <- function(adsl, |
|||
| 169 | +28 |
- )+ param = c("Sum of Longest Diameter by Investigator"),
|
||
| 170 | +29 |
- # add completion to ADQLQC+ paramcd = c("SLDINV"),
+ |
+ ||
| 30 | ++ |
+ seed = NULL,+ |
+ ||
| 31 | ++ |
+ cached = FALSE,+ |
+ ||
| 32 | ++ |
+ ...) {
|
||
| 171 | -3x | +33 | +4x |
- adqlqc <- bind_rows(+ checkmate::assert_flag(cached) |
| 172 | -3x | +34 | +4x |
- adqlqc,+ if (cached) {
|
| 173 | -3x | +35 | +1x |
- compliance_data+ return(get_cached_data("cadtr"))
|
| 174 | +36 |
- ) %>%+ } |
||
| 175 | +37 | 3x |
- arrange(+ checkmate::assert_data_frame(adsl) |
|
| 176 | +38 | 3x |
- USUBJID,+ checkmate::assert_character(param, min.len = 1, any.missing = FALSE) |
|
| 177 | +39 | 3x |
- AVISITN,+ checkmate::assert_character(paramcd, min.len = 1, any.missing = FALSE) |
|
| 178 | +40 | 3x |
- QSTESTCD+ checkmate::assert_number(seed, null.ok = TRUE)+ |
+ |
| 41 | +3x | +
+ stopifnot(length(param) == length(paramcd)) |
||
| 179 | +42 |
- )+ # validate and initialize related variables |
||
| 180 | +43 |
- # find first set of questionnaire observations+ |
||
| 181 | +44 | 3x |
- adqlqc_x <- arrange(+ if (!is.null(seed)) {
|
|
| 182 | +45 | 3x |
- adqlqc,+ set.seed(seed) |
|
| 183 | -3x | +|||
| 46 | +
- USUBJID,+ } |
|||
| 184 | -3x | +|||
| 47 | +
- ADTM+ |
|||
| 185 | +48 |
- ) %>%+ # Make times consistent with ADRS at ADY and ADTM. |
||
| 186 | +49 | 3x |
- filter(+ adrs <- radrs(adsl, seed = seed, ...) %>% |
|
| 187 | +50 | 3x |
- PARAMCD != "QSALL" &+ dplyr::filter(PARAMCD == "OVRINV") %>% |
|
| 188 | +51 | 3x |
- !str_detect(AVISIT, "SCREENING|UNSCHEDULED")+ dplyr::select( |
|
| 189 | -+ | |||
| 52 | +3x |
- ) %>%+ "STUDYID", |
||
| 190 | +53 | 3x |
- group_by(+ "USUBJID", |
|
| 191 | +54 | 3x |
- USUBJID,+ "AVISIT", |
|
| 192 | +55 | 3x |
- ADTM+ "AVISITN", |
|
| 193 | -+ | |||
| 56 | +3x |
- ) %>%+ "ADTM", |
||
| 194 | +57 | 3x |
- summarise(first_date = first(ADTM), .groups = "drop")+ "ADY" |
|
| 195 | +58 | ++ |
+ )+ |
+ |
| 59 | ||||
| 196 | +60 | 3x |
- adqlqc <- left_join(+ adtr <- Map(function(parcd, par) {
|
|
| 197 | +61 | 3x |
- adqlqc,+ df <- adrs |
|
| 198 | +62 | 3x |
- adqlqc_x,+ df$AVAL <- stats::rnorm(nrow(df), mean = 150, sd = 30) |
|
| 199 | +63 | 3x |
- by = c("USUBJID", "ADTM")
+ df$PARAMCD <- parcd |
|
| 200 | -+ | |||
| 64 | +3x |
- ) %>%+ df$PARAM <- par |
||
| 201 | +65 | 3x |
- mutate(+ df |
|
| 202 | +66 | 3x |
- ANL01FL = case_when(+ }, paramcd, param) %>% |
|
| 203 | +67 | 3x |
- PARAMCD != "QSALL" & ABLFL == "Y" ~ "Y",+ Reduce(rbind, .) |
|
| 204 | -3x | +|||
| 68 | +
- PARAMCD != "QSALL" &+ |
|||
| 205 | +69 | 3x |
- !str_detect(AVISIT, "UNSCHEDULED") &+ adtr_base <- adtr %>% |
|
| 206 | +70 | 3x |
- !is.na(first_date) ~ "Y"+ dplyr::filter(AVISITN == 0) %>% |
|
| 207 | -+ | |||
| 71 | +3x |
- )+ dplyr::group_by(USUBJID, PARAMCD) %>% |
||
| 208 | -+ | |||
| 72 | +3x |
- ) %>%+ dplyr::mutate(BASE = AVAL) %>% |
||
| 209 | +73 | 3x |
- select(-first_date)+ dplyr::select("STUDYID", "USUBJID", "BASE", "PARAMCD")
|
|
| 210 | +74 | |||
| 211 | -+ | |||
| 75 | +3x |
- # final dataset -----------------------------------------------------------+ adtr_postbase <- adtr %>% |
||
| 212 | +76 | 3x |
- adqlqc_final <- adqlqc %>%+ dplyr::filter(AVISITN > 0) %>% |
|
| 213 | +77 | 3x |
- dplyr::group_by(USUBJID) %>%+ dplyr::filter(!is.na(AVAL)) %>% |
|
| 214 | +78 | 3x |
- dplyr::mutate(ASEQ = row_number()) %>%+ dplyr::group_by(USUBJID, PARAMCD) %>% |
|
| 215 | +79 | 3x |
- dplyr::ungroup() %>%+ dplyr::filter(AVAL == min(AVAL)) %>% |
|
| 216 | +80 | 3x |
- dplyr::arrange(+ dplyr::slice(1) %>% |
|
| 217 | +81 | 3x |
- STUDYID,+ dplyr::mutate(AVISIT = "POST-BASELINE MINIMUM") %>% |
|
| 218 | +82 | 3x |
- USUBJID,+ dplyr::mutate(DTYPE = "MINIMUM") %>% |
|
| 219 | +83 | 3x |
- AVISITN+ dplyr::ungroup() |
|
| 220 | +84 |
- ) %>%+ |
||
| 221 | +85 | 3x |
- select(+ adtr_lastobs <- adtr %>% |
|
| 222 | +86 | 3x |
- -c("BASE2", "CHG2", "PCHG2", "ABLFL2")
- |
- |
| 223 | -- |
- ) %>%+ dplyr::filter(AVISITN > 0) %>% |
||
| 224 | +87 | 3x |
- ungroup()- |
- |
| 225 | -- |
-
+ dplyr::filter(!is.na(AVAL)) %>% |
||
| 226 | +88 | 3x |
- adam_vars <- c(+ dplyr::group_by(USUBJID, PARAMCD) %>% |
|
| 227 | +89 | 3x |
- adsl_vars, "QSSEQ", "QSCAT", "QSSCAT", "QSDTC", "QSSPID", "QSSTAT", "QSSTRESN",+ dplyr::filter(ADTM == max(ADTM, na.rm = TRUE)) %>% |
|
| 228 | +90 | 3x |
- "QSSTRESC", "QSSTRESU", "QSORRES", "QSORRESU", "QSTEST", "QSTESTCD", "QSTPT",+ dplyr::slice(1) %>% |
|
| 229 | +91 | 3x |
- "QSTPTNUM", "QSTPTREF", "QSDY", "QSREASND", "QSTSTDTL", "QSEVAL", "VISIT", "VISITNUM",+ dplyr::mutate(LAST_VISIT = AVISIT) %>% |
|
| 230 | +92 | 3x |
- "PARAM", "PARAMCD", "PARCAT1", "PARCAT1N", "PARCAT2", "AVAL", "AVALC", "AREASND",+ dplyr::ungroup() %>% |
|
| 231 | +93 | 3x |
- "BASE", "BASETYPE", "ABLFL", "CHG", "PCHG", "CHGCAT1", "CRIT1", "CRIT1FL", "DTYPE",+ dplyr::select( |
|
| 232 | +94 | 3x |
- "ADTM", "ADT", "ADY", "ADTF", "ATMF", "ATPT", "ATPTN", "AVISIT", "AVISITN", "APHASE",+ "STUDYID", |
|
| 233 | +95 | 3x |
- "APHASEN", "APERIOD", "APERIODC", "APERIODC", "ASPER", "ASPERC", "PERADY", "TRTP",+ "USUBJID", |
|
| 234 | +96 | 3x |
- "TRTA", "ONTRTFL", "LAST02FL", "FIRS02FL", "ANL01FL", "ANL02FL", "ANL03FL",+ "PARAMCD", |
|
| 235 | +97 | 3x |
- "ANL04FL", "CGCAT1NX"+ "LAST_VISIT" |
|
| 236 | +98 |
- )+ ) |
||
| 237 | +99 |
- # order variables in mapped qs by variables in adam_vars+ |
||
| 238 | +100 | 3x |
- adqlqc_name_ordered <- names(adqlqc_final)[order(match(names(adqlqc_final), adam_vars))]+ adtr <- rbind(adtr %>% dplyr::mutate(DTYPE = ""), adtr_postbase) |
|
| 239 | +101 |
- # adqlqc with variables ordered per gdsr+ |
||
| 240 | +102 | 3x |
- adqlqc_final <- adqlqc_final %>%+ adtr <- merge(adtr, adtr_base, by = c("STUDYID", "USUBJID", "PARAMCD")) %>%
|
|
| 241 | +103 | 3x |
- select(+ dplyr::mutate( |
|
| 242 | +104 | 3x |
- any_of(adqlqc_name_ordered)- |
- |
| 243 | -- |
- )- |
- ||
| 244 | -- |
-
+ ABLFL = dplyr::case_when(AVISIT == "BASELINE" ~ "Y", TRUE ~ ""), |
||
| 245 | +105 | 3x |
- adqlqc_final <- relocate(adqlqc_final, "QSEVLINT", .after = "QSTESTCD") %>%+ AVAL = dplyr::case_when(AVISIT == "BASELINE" ~ NA_real_, TRUE ~ AVAL), |
|
| 246 | +106 | 3x |
- arrange(+ CHG = dplyr::case_when(AVISITN > 0 ~ AVAL - BASE, TRUE ~ NA_real_), |
|
| 247 | +107 | 3x |
- USUBJID,+ PCHG = dplyr::case_when(AVISITN > 0 ~ CHG / BASE * 100, TRUE ~ NA_real_), |
|
| 248 | +108 | 3x |
- AVISITN,+ AVALC = as.character(AVAL), |
|
| 249 | +109 | 3x |
- ASEQ,+ AVALU = "mm" |
|
| 250 | -3x | +|||
| 110 | +
- QSTESTCD+ ) |
|||
| 251 | +111 |
- )+ |
||
| 252 | +112 |
- # apply metadata+ # ensure PCHG does not exceed 200%, nor go below -100% (double in size, or complete remission of tumor). |
||
| 253 | +113 | 3x |
- adqlqc_final <- apply_metadata(adqlqc_final, "metadata/ADQLQC.yml")+ adtr <- adtr %>% |
|
| 254 | +114 | 3x |
- return(adqlqc_final)+ dplyr::mutate( |
|
| 255 | -+ | |||
| 115 | +3x |
- }+ PCHG_DUM = PCHG, |
||
| 256 | -+ | |||
| 116 | +3x |
-
+ PCHG = dplyr::case_when( |
||
| 257 | -+ | |||
| 117 | +3x |
- #' Helper Functions for Constructing ADQLQC+ PCHG_DUM > 200 ~ 200, |
||
| 258 | -+ | |||
| 118 | +3x |
- #'+ PCHG_DUM < -100 ~ -100, |
||
| 259 | -+ | |||
| 119 | +3x |
- #' Internal functions used by `radqlqc`.+ TRUE ~ PCHG |
||
| 260 | +120 |
- #'+ ), |
||
| 261 | -+ | |||
| 121 | +3x |
- #' @inheritParams argument_convention+ AVAL = dplyr::case_when( |
||
| 262 | -+ | |||
| 122 | +3x |
- #' @inheritParams radqlqc+ PCHG_DUM > 200 ~ 3 * BASE, |
||
| 263 | -+ | |||
| 123 | +3x |
- #'+ PCHG_DUM < -100 ~ 0, |
||
| 264 | -+ | |||
| 124 | +3x |
- #' @examples+ TRUE ~ AVAL |
||
| 265 | +125 |
- #' adsl <- radsl(N = 10, study_duration = 2, seed = 1)+ ), |
||
| 266 | -+ | |||
| 126 | +3x |
- #' adqlqc <- radqlqc(adsl, seed = 1, percent = 80, number = 2)+ CHG = dplyr::case_when( |
||
| 267 | -+ | |||
| 127 | +3x |
- #'+ PCHG_DUM > 200 ~ 2 * BASE,+ |
+ ||
| 128 | +3x | +
+ PCHG_DUM < -100 ~ -BASE,+ |
+ ||
| 129 | +3x | +
+ TRUE ~ CHG |
||
| 268 | +130 |
- #' @name h_adqlqc+ ) |
||
| 269 | +131 |
- NULL+ ) %>%+ |
+ ||
| 132 | +3x | +
+ dplyr::select(-"PCHG_DUM") |
||
| 270 | +133 | |||
| 271 | -+ | |||
| 134 | +3x |
- #' @describeIn h_adqlqc Questionnaires EORTC QLQ-C30 V3.0 SDTM (QS)+ adtr <- merge(adsl, adtr, by = c("STUDYID", "USUBJID")) %>%
|
||
| 272 | -+ | |||
| 135 | +3x |
- #'+ dplyr::group_by(USUBJID, PARAMCD) %>% |
||
| 273 | -+ | |||
| 136 | +3x |
- #' Function for generating random Questionnaires SDTM domain+ dplyr::mutate( |
||
| 274 | -+ | |||
| 137 | +3x |
- #'+ ONTRTFL = factor(dplyr::case_when( |
||
| 275 | -+ | |||
| 138 | +3x |
- #' @return a dataframe with SDTM questionnaire data+ !AVISIT %in% c("SCREENING", "BASELINE", "FOLLOW UP") ~ "Y",
|
||
| 276 | -+ | |||
| 139 | +3x |
- #' @keywords internal+ TRUE ~ "" |
||
| 277 | +140 |
- get_qs_data <- function(adsl,+ )), |
||
| 278 | -+ | |||
| 141 | +3x |
- visit_format = "CYCLE",+ ANL01FL = dplyr::case_when( |
||
| 279 | -+ | |||
| 142 | +3x |
- n_assessments = 5L,+ DTYPE == "" & AVISITN > 0 ~ "Y", |
||
| 280 | -+ | |||
| 143 | +3x |
- n_days = 1L,+ TRUE ~ "" |
||
| 281 | +144 |
- lookup = NULL,+ ), |
||
| 282 | -+ | |||
| 145 | +3x |
- seed = NULL,+ ANL03FL = dplyr::case_when( |
||
| 283 | -+ | |||
| 146 | +3x |
- na_percentage = 0,+ DTYPE == "MINIMUM" ~ "Y", |
||
| 284 | -+ | |||
| 147 | +3x |
- na_vars = list(+ ABLFL == "Y" ~ "Y", |
||
| 285 | -+ | |||
| 148 | +3x |
- QSORRES = c(1234, 0.2),+ TRUE ~ "" |
||
| 286 | +149 |
- QSSTRESC = c(1234, 0.2)+ ) |
||
| 287 | +150 |
- )) {
+ ) |
||
| 288 | +151 | 3x |
- load(system.file("sysdata.rda", package = "random.cdisc.data"))
+ adtr <- merge(adtr, adtr_lastobs, by = c("STUDYID", "USUBJID", "PARAMCD")) %>%
|
|
| 289 | +152 | 3x |
- checkmate::assert_string(visit_format)+ dplyr::mutate( |
|
| 290 | +153 | 3x |
- checkmate::assert_integer(n_assessments, len = 1, any.missing = FALSE)+ ANL02FL = dplyr::case_when( |
|
| 291 | +154 | 3x |
- checkmate::assert_integer(n_days, len = 1, any.missing = FALSE)+ as.character(AVISIT) == as.character(LAST_VISIT) ~ "Y", |
|
| 292 | +155 | 3x |
- checkmate::assert_number(seed, null.ok = TRUE)+ ABLFL == "Y" ~ "Y", |
|
| 293 | -3x | -
- checkmate::assert_number(na_percentage, lower = 0, upper = 1, na.ok = TRUE)- |
- ||
| 294 | +156 | 3x |
- checkmate::assert_number(na_percentage, lower = 0, upper = 1)+ TRUE ~ "" |
|
| 295 | -3x | +|||
| 157 | +
- checkmate::assert_true(na_percentage < 1)+ ) |
|||
| 296 | +158 |
-
+ ) %>% |
||
| 297 | -+ | |||
| 159 | +3x |
- # get subjects for QS data from ADSL+ dplyr::select(-"LAST_VISIT") |
||
| 298 | +160 |
- # get studyid, subject for QS generation+ # Adding variables that are in ADTR osprey but not RCD. |
||
| 299 | +161 | 3x |
- qs <- select(+ adtr <- adtr %>% |
|
| 300 | +162 | 3x |
- adsl,+ dplyr::mutate( |
|
| 301 | +163 | 3x |
- STUDYID,+ DCSREAS_GRP = ifelse(DCSREAS == "ADVERSE EVENT", "Safety", "Non-Safety"), |
|
| 302 | +164 | 3x |
- USUBJID+ TRTDURD = ifelse( |
|
| 303 | -+ | |||
| 165 | +3x |
- ) %>%+ is.na(TRTSDTM) | is.na(TRTEDTM), |
||
| 304 | +166 | 3x |
- mutate(+ NA, |
|
| 305 | +167 | 3x |
- DOMAIN = "QS"+ TRTEDTM - (TRTSDTM + lubridate::days(1)) |
|
| 306 | +168 |
- )+ ), |
||
| 307 | -+ | |||
| 169 | +3x |
-
+ AGEGR1 = ifelse(AGE < 65, "<65", ">=65") |
||
| 308 | +170 |
- # QS prep -----------------------------------------------------------------+ ) |
||
| 309 | +171 |
- # get questionnaire function for QS+ |
||
| 310 | +172 |
- # QSTESTCD: EOR0101 to EOR0130- |
- ||
| 311 | -3x | -
- eortc_qlq_c30_sub <- filter(- |
- ||
| 312 | -3x | -
- eortc_qlq_c30,+ # apply metadata |
||
| 313 | +173 | 3x |
- as.numeric(str_extract(QSTESTCD, "\\d+$")) >= 101 &+ adtr <- apply_metadata(adtr, "metadata/ADTR.yml") |
|
| 314 | +174 | 3x |
- as.numeric(str_extract(QSTESTCD, "\\d+$")) <= 130+ return(adtr) |
|
| 315 | +175 |
- ) %>%- |
- ||
| 316 | -3x | -
- select(-publication_name)+ } |
| 317 | +1 |
-
+ #' EORTC QLQ-C30 V3 Analysis Dataset (ADQLQC) |
||
| 318 | +2 |
- # validate and initialize QSTEST vectors- |
- ||
| 319 | -3x | -
- qstest_init_list <- relvar_init(+ #' |
||
| 320 | -3x | +|||
| 3 | +
- unique(eortc_qlq_c30_sub$QSTEST),+ #' @description `r lifecycle::badge("stable")`
|
|||
| 321 | -3x | +|||
| 4 | +
- unique(eortc_qlq_c30_sub$QSTESTCD)+ #' |
|||
| 322 | +5 |
- )+ #' Function for generating a random EORTC QLQ-C30 V3 Analysis Dataset for a given |
||
| 323 | +6 |
-
+ #' Subject-Level Analysis Dataset. |
||
| 324 | -3x | +|||
| 7 | +
- if (!is.null(seed)) {
+ #' |
|||
| 325 | -3x | +|||
| 8 | +
- set.seed(seed)+ #' @details |
|||
| 326 | +9 |
- }+ #' |
||
| 327 | +10 |
-
+ #' Keys: `STUDYID`, `USUBJID`, `PARCAT1N`, `PARAMCD`, `BASETYPE`, `AVISITN`, `ATPTN`, `ADTM`, `QSSEQ` |
||
| 328 | -3x | +|||
| 11 | +
- checkmate::assert_data_frame(lookup, null.ok = TRUE)+ #' |
|||
| 329 | +12 |
-
+ #' @inheritParams argument_convention |
||
| 330 | -3x | +|||
| 13 | +
- lookup_qs <- if (!is.null(lookup)) {
+ #' @param percent (`numeric`)\cr Completion - Completed at least y percent of questions, 1 record per visit |
|||
| 331 | -! | +|||
| 14 | +
- lookup+ #' @param number (`numeric`)\cr Completion - Completed at least x question(s), 1 record per visit |
|||
| 332 | +15 |
- } else {
+ #' @template param_cached |
||
| 333 | -3x | +|||
| 16 | +
- expand.grid(+ #' @templateVar data adqlqc |
|||
| 334 | -3x | +|||
| 17 | +
- STUDYID = unique(qs$STUDYID),+ #' |
|||
| 335 | -3x | +|||
| 18 | +
- USUBJID = qs$USUBJID,+ #' @return `data.frame` |
|||
| 336 | -3x | +|||
| 19 | +
- QSTEST = qstest_init_list$relvar1,+ #' @export |
|||
| 337 | -3x | +|||
| 20 | +
- VISIT = visit_schedule(+ #' |
|||
| 338 | -3x | +|||
| 21 | +
- visit_format = visit_format,+ #' @examples |
|||
| 339 | -3x | +|||
| 22 | +
- n_assessments = n_assessments,+ #' adsl <- radsl(N = 10, study_duration = 2, seed = 1) |
|||
| 340 | -3x | +|||
| 23 | +
- n_days = n_days+ #' |
|||
| 341 | +24 |
- ),+ #' adqlqc <- radqlqc(adsl, seed = 1, percent = 80, number = 2) |
||
| 342 | -3x | +|||
| 25 | +
- stringsAsFactors = FALSE+ #' adqlqc |
|||
| 343 | +26 |
- )+ radqlqc <- function(adsl, |
||
| 344 | +27 |
- }+ percent, |
||
| 345 | +28 |
-
+ number, |
||
| 346 | +29 |
- # assign related variable values: QSTESTxQSTESTCD are related+ seed = NULL, |
||
| 347 | -3x | +|||
| 30 | +
- lookup_qs <- lookup_qs %>% rel_var(+ cached = FALSE) {
|
|||
| 348 | -3x | +31 | +4x |
- var_name = "QSTESTCD",+ checkmate::assert_flag(cached) |
| 349 | -3x | +32 | +4x |
- related_var = "QSTEST",+ if (cached) {
|
| 350 | -3x | +33 | +1x |
- var_values = qstest_init_list$relvar2+ return(get_cached_data("cadqlqc"))
|
| 351 | +34 |
- )+ } |
||
| 352 | +35 | |||
| 353 | +36 | 3x |
- lookup_qs <- left_join(+ checkmate::assert_data_frame(adsl) |
|
| 354 | +37 | 3x |
- lookup_qs,+ checkmate::assert_number(percent, lower = 1, upper = 100) |
|
| 355 | +38 | 3x |
- eortc_qlq_c30_sub,+ checkmate::assert_number(number, lower = 1) |
|
| 356 | -3x | +|||
| 39 | +
- by = c(+ |
|||
| 357 | +40 | 3x |
- "QSTEST",+ if (!is.null(seed)) {
|
|
| 358 | +41 | 3x |
- "QSTESTCD"+ set.seed(seed) |
|
| 359 | +42 |
- ),+ } |
||
| 360 | -3x | +|||
| 43 | +
- multiple = "all",+ + |
+ |||
| 44 | ++ |
+ # ADQLQC data ------------------------------------------------------------- |
||
| 361 | +45 | 3x |
- relationship = "many-to-many"+ qs <- get_qs_data(adsl, n_assessments = 5L, seed = seed, na_percentage = 0.1) |
|
| 362 | +46 |
- )+ # prepare ADaM ADQLQC data+ |
+ ||
| 47 | +3x | +
+ adqlqc1 <- prep_adqlqc(df = qs) |
||
| 363 | +48 |
-
+ # derive AVAL and AVALC |
||
| 364 | +49 | 3x |
- lookup_qs <- dplyr::mutate(+ adqlqc1 <- mutate( |
|
| 365 | +50 | 3x |
- lookup_qs,+ adqlqc1, |
|
| 366 | +51 | 3x |
- VISITNUM = dplyr::case_when(+ AVAL = as.numeric(QSSTRESC), |
|
| 367 | +52 | 3x |
- VISIT == "SCREENING" ~ -1,+ AVALC = case_when( |
|
| 368 | +53 | 3x |
- VISIT == "BASELINE" ~ 0,+ QSTESTCD == "QSALL" ~ QSREASND, |
|
| 369 | +54 | 3x |
- (grepl("^WEEK", VISIT) | grepl("^CYCLE", VISIT)) ~ as.numeric(VISIT) - 2,
+ TRUE ~ QSORRES+ |
+ |
| 55 | ++ |
+ ), |
||
| 370 | +56 | 3x |
- TRUE ~ NA_real_+ AVISIT = VISIT, |
|
| 371 | -+ | |||
| 57 | +3x |
- )+ AVISITN = VISITNUM, |
||
| 372 | +58 | 3x |
- ) %>% arrange(USUBJID)+ ADTM = QSDTC |
|
| 373 | +59 |
-
+ ) |
||
| 374 | +60 |
- # # prep QSALL --------------------------------------------------------------+ # include scale calculation+ |
+ ||
| 61 | +3x | +
+ adqlqc_tmp <- calc_scales(adqlqc1) |
||
| 375 | +62 |
- # get last subject and visit for QSALL+ # order to prepare for change from screening and baseline values |
||
| 376 | +63 | 3x |
- last_subj_vis <- select(lookup_qs, USUBJID, VISIT) %>%+ adqlqc_tmp <- adqlqc_tmp[order(adqlqc_tmp$STUDYID, adqlqc_tmp$USUBJID, adqlqc_tmp$PARAMCD, adqlqc_tmp$AVISITN), ] |
|
| 377 | -3x | +|||
| 64 | +
- distinct() %>%+ |
|||
| 378 | +65 | 3x |
- slice(n())+ adqlqc_tmp <- Reduce( |
|
| 379 | +66 | 3x |
- last_subj_vis_full <- filter(+ rbind, |
|
| 380 | +67 | 3x |
- lookup_qs,+ lapply( |
|
| 381 | +68 | 3x |
- USUBJID == last_subj_vis$USUBJID,+ split(adqlqc_tmp, adqlqc_tmp$USUBJID), |
|
| 382 | +69 | 3x |
- VISIT == last_subj_vis$VISIT- |
- |
| 383 | -- |
- )+ function(x) {
|
||
| 384 | -+ | |||
| 70 | +30x |
-
+ x$STUDYID <- adsl$STUDYID[which(adsl$USUBJID == x$USUBJID[1])] |
||
| 385 | -3x | +71 | +30x |
- qsall_data1 <- tibble::tibble(+ x$ABLFL2 <- ifelse(x$AVISIT == "SCREENING", "Y", "") |
| 386 | -3x | +72 | +30x |
- STUDYID = unique(last_subj_vis_full$STUDYID),+ x$ABLFL <- ifelse( |
| 387 | -3x | +73 | +30x |
- USUBJID = unique(last_subj_vis_full$USUBJID),+ x$AVISIT == "BASELINE" & |
| 388 | -3x | +74 | +30x |
- VISIT = unique(last_subj_vis_full$VISIT),+ x$PARAMCD != "EX028", |
| 389 | -3x | +75 | +30x |
- VISITNUM = unique(last_subj_vis_full$VISITNUM),+ "Y", |
| 390 | -3x | +76 | +30x |
- QSTESTCD = "QSALL",+ ifelse( |
| 391 | -3x | +77 | +30x |
- QSTEST = "Questionnaires",+ x$AVISIT == "CYCLE 1 DAY 1" & |
| 392 | -3x | +78 | +30x |
- QSSTAT = "NOT DONE",+ x$PARAMCD != "EX028", |
| 393 | -3x | +79 | +30x |
- QSREASND = "SUBJECT REFUSED"+ "Y", |
| 394 | +80 |
- )+ "" |
||
| 395 | +81 |
-
+ ) |
||
| 396 | +82 |
- # remove last subject and visit from main data- |
- ||
| 397 | -3x | -
- lookup_qs_sub <- anti_join(+ ) |
||
| 398 | -3x | +83 | +30x |
- lookup_qs,+ x |
| 399 | -3x | +|||
| 84 | +
- last_subj_vis_full,+ } |
|||
| 400 | -3x | +|||
| 85 | +
- by = c("USUBJID", "VISIT")
+ ) |
|||
| 401 | +86 |
) |
||
| 402 | +87 | |||
| 403 | +88 | 3x |
- set.seed(seed)+ adqlqc_tmp$BASE2 <- ifelse( |
|
| 404 | +89 | 3x |
- lookup_qs_sub_x <- lookup_qs_sub %>%+ str_detect(adqlqc_tmp$PARCAT2, "Completion", negate = TRUE), |
|
| 405 | +90 | 3x |
- group_by(+ retain( |
|
| 406 | +91 | 3x |
- USUBJID,+ df = adqlqc_tmp, |
|
| 407 | +92 | 3x |
- QSTESTCD,+ value_var = adqlqc_tmp$AVAL, |
|
| 408 | +93 | 3x |
- VISIT+ event = adqlqc_tmp$ABLFL2 == "Y" |
|
| 409 | +94 |
- ) %>%+ ), |
||
| 410 | +95 | 3x |
- slice_sample(n = 1) %>%+ NA+ |
+ |
| 96 | ++ |
+ )+ |
+ ||
| 97 | ++ | + | ||
| 411 | +98 | 3x |
- ungroup() %>%+ adqlqc_tmp$BASE <- ifelse( |
|
| 412 | +99 | 3x |
- as.data.frame()+ adqlqc_tmp$ABLFL2 != "Y" & |
|
| 413 | -+ | |||
| 100 | +3x |
-
+ str_detect(adqlqc_tmp$PARCAT2, "Completion", negate = TRUE), |
||
| 414 | +101 | 3x |
- lookup_qs_sub_x <- arrange(+ retain( |
|
| 415 | +102 | 3x |
- lookup_qs_sub_x,+ adqlqc_tmp, |
|
| 416 | +103 | 3x |
- USUBJID,+ adqlqc_tmp$AVAL, |
|
| 417 | +104 | 3x |
- VISITNUM+ adqlqc_tmp$ABLFL == "Y" |
|
| 418 | +105 |
- )+ ), |
||
| 419 | -+ | |||
| 106 | +3x |
-
+ NA |
||
| 420 | +107 |
- # add date: QSDTC ---------------------------------------------------------+ ) |
||
| 421 | +108 |
- # get treatment dates from ADSL+ |
||
| 422 | +109 | 3x |
- adsl_trt <- select(+ adqlqc_tmp <- adqlqc_tmp %>% |
|
| 423 | +110 | 3x |
- adsl,+ dplyr::mutate(CHG2 = AVAL - BASE2) %>% |
|
| 424 | +111 | 3x |
- USUBJID,+ dplyr::mutate(PCHG2 = 100 * (CHG2 / BASE2)) %>% |
|
| 425 | +112 | 3x |
- TRTSDTM,+ dplyr::mutate(CHG = AVAL - BASE) %>% |
|
| 426 | +113 | 3x |
- TRTEDTM+ dplyr::mutate(PCHG = 100 * (CHG / BASE)) %>% |
|
| 427 | -+ | |||
| 114 | +3x |
- )+ rcd_var_relabel(+ |
+ ||
| 115 | +3x | +
+ STUDYID = attr(adsl$STUDYID, "label"),+ |
+ ||
| 116 | +3x | +
+ USUBJID = attr(adsl$USUBJID, "label") |
||
| 428 | +117 |
- # use to derive QSDTC+ ) |
||
| 429 | +118 |
- # if no treatment end date, create an arbituary one+ # derive CHGCAT1 ---------------------------------------------------------- |
||
| 430 | +119 | 3x |
- trt_end_date <- max(adsl_trt$TRTEDTM, na.rm = TRUE)+ adqlqc_tmp <- derv_chgcat1(dataset = adqlqc_tmp) |
|
| 431 | +120 | |||
| 432 | +121 | 3x |
- lookup_qs_sub_x <- left_join(+ adqlqc_tmp <- rcd_var_relabel( |
|
| 433 | +122 | 3x |
- lookup_qs_sub_x,+ adqlqc_tmp, |
|
| 434 | +123 | 3x |
- adsl_trt,+ STUDYID = "Study Identifier", |
|
| 435 | +124 | 3x |
- by = "USUBJID"+ USUBJID = "Unique Subject Identifier" |
|
| 436 | +125 |
- ) %>%- |
- ||
| 437 | -3x | -
- group_by(- |
- ||
| 438 | -3x | -
- USUBJID+ ) |
||
| 439 | +126 |
- ) %>%+ |
||
| 440 | +127 | 3x |
- mutate(QSDTC = get_random_dates_between(+ adqlqc_tmp <- arrange( |
|
| 441 | +128 | 3x |
- from = TRTSDTM,+ adqlqc_tmp, |
|
| 442 | +129 | 3x |
- to = ifelse(+ USUBJID, |
|
| 443 | +130 | 3x |
- is.na(TRTEDTM),+ AVISITN |
|
| 444 | -3x | +|||
| 131 | +
- trt_end_date,+ ) |
|||
| 445 | -3x | +|||
| 132 | +
- TRTEDTM+ # Merge ADSL -------------------------------------------------------------- |
|||
| 446 | +133 |
- ),+ # ADSL variables needed for ADQLQC |
||
| 447 | +134 | 3x |
- visit_id = VISITNUM+ adsl_vars <- c( |
|
| 448 | -+ | |||
| 135 | +3x |
- )) %>%+ "STUDYID", "USUBJID", "SUBJID", "SITEID", "REGION1", "COUNTRY", "ETHNIC", "AGE", |
||
| 449 | +136 | 3x |
- select(-c("TRTSDTM", "TRTEDTM"))
+ "AGEU", "AAGE", "AAGEU", "AGEGR1", "AGEGR2", "AGEGR3", "STRATwNM", "STRATw", "STRATwV", |
|
| 450 | -+ | |||
| 137 | +3x |
-
+ "SEX", "RACE", "ITTFL", "SAFFL", "PPROTFL", "TRT01P", "TRT01A",+ |
+ ||
| 138 | +3x | +
+ "TRTSEQP", "TRTSEQA", "TRTSDTM", "TRTSDT", "TRTEDTM", "TRTEDT", "DCUTDT" |
||
| 451 | +139 |
- # filter out subjects with missing dates+ ) |
||
| 452 | +140 | 3x |
- lookup_qs_sub_x1 <- filter(+ adsl <- select( |
|
| 453 | +141 | 3x |
- lookup_qs_sub_x,+ adsl, |
|
| 454 | +142 | 3x |
- !is.na(QSDTC)+ any_of(adsl_vars) |
|
| 455 | +143 |
) |
||
| 456 | -- | - - | -||
| 457 | -+ | |||
| 144 | +3x |
- # subjects with missing dates+ adqlqc <- dplyr::inner_join( |
||
| 458 | +145 | 3x |
- lookup_qs_sub_x2 <- filter(+ adqlqc_tmp, |
|
| 459 | +146 | 3x |
- lookup_qs_sub_x,+ adsl, |
|
| 460 | +147 | 3x |
- is.na(QSDTC)+ by = c("STUDYID", "USUBJID")
|
|
| 461 | +148 |
) %>% |
||
| 462 | +149 | 3x |
- select(+ dplyr::mutate( |
|
| 463 | +150 | 3x |
- STUDYID,+ ADY_der = ceiling(difftime(ADTM, TRTSDTM, units = "days")), |
|
| 464 | +151 | 3x |
- USUBJID,+ ADY = case_when( |
|
| 465 | +152 | 3x |
- VISIT,+ ADY_der >= 0 ~ ADY_der + 1, |
|
| 466 | +153 | 3x |
- VISITNUM+ TRUE ~ ADY_der |
|
| 467 | +154 | ++ |
+ )+ |
+ |
| 155 |
) %>% |
|||
| 468 | +156 | 3x |
- distinct()+ select(-ADY_der) |
|
| 469 | +157 | |||
| 470 | +158 |
- # generate QSALL for subjects with missing dates- |
- ||
| 471 | -3x | -
- qsall_data2 <- mutate(- |
- ||
| 472 | -3x | -
- lookup_qs_sub_x2,+ # get compliance data --------------------------------------------------- |
||
| 473 | +159 | 3x |
- QSTESTCD = "QSALL",+ compliance_data <- comp_derv( |
|
| 474 | +160 | 3x |
- QSTEST = "Questionnaires",+ dataset = adqlqc, |
|
| 475 | +161 | 3x |
- QSSTAT = "NOT DONE",+ percent = percent, |
|
| 476 | +162 | 3x |
- QSREASND = "SUBJECT REFUSED"+ number = number |
|
| 477 | +163 |
) |
||
| 478 | +164 |
-
+ # add ADSL variables |
||
| 479 | -+ | |||
| 165 | +3x |
- # add qsall data to original item data+ compliance_data <- left_join( |
||
| 480 | +166 | 3x |
- lookup_qs_sub_all <- bind_rows(+ compliance_data, |
|
| 481 | +167 | 3x |
- lookup_qs_sub_x1,+ adsl, |
|
| 482 | +168 | 3x |
- qsall_data1,- |
- |
| 483 | -3x | -
- qsall_data2+ by = c("STUDYID", "USUBJID")
|
||
| 484 | +169 |
) |
||
| 485 | +170 |
-
+ # add completion to ADQLQC |
||
| 486 | +171 | 3x |
- qs_all <- lookup_qs_sub_all %>%+ adqlqc <- bind_rows( |
|
| 487 | +172 | 3x |
- arrange(+ adqlqc, |
|
| 488 | +173 | 3x |
- STUDYID,+ compliance_data |
|
| 489 | -3x | +|||
| 174 | +
- USUBJID,+ ) %>% |
|||
| 490 | +175 | 3x |
- VISITNUM+ arrange( |
|
| 491 | -+ | |||
| 176 | +3x |
- ) %>%+ USUBJID, |
||
| 492 | +177 | 3x |
- dplyr::group_by(USUBJID) %>%+ AVISITN, |
|
| 493 | +178 | 3x |
- dplyr::ungroup()+ QSTESTCD |
|
| 494 | +179 |
-
+ ) |
||
| 495 | +180 |
- # get first and second subject ids+ # find first set of questionnaire observations |
||
| 496 | +181 | 3x |
- first_second_subj <- select(qs_all, USUBJID) %>%+ adqlqc_x <- arrange( |
|
| 497 | +182 | 3x |
- distinct() %>%+ adqlqc, |
|
| 498 | +183 | 3x |
- slice(1:2)+ USUBJID,+ |
+ |
| 184 | +3x | +
+ ADTM |
||
| 499 | +185 |
-
+ ) %>% |
||
| 500 | +186 | 3x |
- qs1 <- filter(+ filter( |
|
| 501 | +187 | 3x |
- qs_all,+ PARAMCD != "QSALL" & |
|
| 502 | +188 | 3x |
- USUBJID %in% first_second_subj$USUBJID+ !str_detect(AVISIT, "SCREENING|UNSCHEDULED") |
|
| 503 | +189 |
- )+ ) %>% |
||
| 504 | -+ | |||
| 190 | +3x |
-
+ group_by( |
||
| 505 | +191 | 3x |
- if (length(na_vars) > 0 && na_percentage > 0) {
+ USUBJID, |
|
| 506 | +192 | 3x |
- qs1 <- mutate_na(ds = qs1, na_vars = na_vars, na_percentage = na_percentage)+ ADTM |
|
| 507 | +193 |
- }+ ) %>% |
||
| 508 | -+ | |||
| 194 | +3x |
-
+ summarise(first_date = first(ADTM), .groups = "drop") |
||
| 509 | +195 |
- # QSSTAT = NOT DONE+ |
||
| 510 | +196 | 3x |
- qs1 <- mutate(+ adqlqc <- left_join( |
|
| 511 | +197 | 3x |
- qs1,+ adqlqc, |
|
| 512 | +198 | 3x |
- QSSTAT = case_when(+ adqlqc_x, |
|
| 513 | +199 | 3x |
- is.na(QSORRES) & is.na(QSSTRESC) ~ "NOT DONE"+ by = c("USUBJID", "ADTM")
|
|
| 514 | +200 |
- )+ ) %>% |
||
| 515 | -+ | |||
| 201 | +3x |
- )+ mutate( |
||
| 516 | -+ | |||
| 202 | +3x |
-
+ ANL01FL = case_when( |
||
| 517 | -+ | |||
| 203 | +3x |
- # remove first and second subjects from main data+ PARAMCD != "QSALL" & ABLFL == "Y" ~ "Y", |
||
| 518 | +204 | 3x |
- qs2 <- anti_join(+ PARAMCD != "QSALL" & |
|
| 519 | +205 | 3x |
- qs_all,+ !str_detect(AVISIT, "UNSCHEDULED") & |
|
| 520 | +206 | 3x |
- qs1,+ !is.na(first_date) ~ "Y"+ |
+ |
| 207 | ++ |
+ )+ |
+ ||
| 208 | ++ |
+ ) %>% |
||
| 521 | +209 | 3x |
- by = c("USUBJID")
+ select(-first_date) |
|
| 522 | +210 |
- )+ |
||
| 523 | +211 |
-
+ # final dataset ----------------------------------------------------------- |
||
| 524 | +212 | 3x |
- final_qs <- rbind(+ adqlqc_final <- adqlqc %>% |
|
| 525 | +213 | 3x |
- qs1,+ dplyr::group_by(USUBJID) %>% |
|
| 526 | +214 | 3x |
- qs2+ dplyr::mutate(ASEQ = row_number()) %>% |
|
| 527 | -+ | |||
| 215 | +3x |
- ) %>%+ dplyr::ungroup() %>% |
||
| 528 | +216 | 3x |
- group_by(USUBJID) %>%+ dplyr::arrange( |
|
| 529 | +217 | 3x |
- dplyr::mutate(QSSEQ = row_number()) %>%+ STUDYID, |
|
| 530 | +218 | 3x |
- arrange(+ USUBJID, |
|
| 531 | +219 | 3x |
- STUDYID,+ AVISITN+ |
+ |
| 220 | ++ |
+ ) %>% |
||
| 532 | +221 | 3x |
- USUBJID,+ select( |
|
| 533 | +222 | 3x |
- VISITNUM+ -c("BASE2", "CHG2", "PCHG2", "ABLFL2")
|
|
| 534 | +223 |
) %>% |
||
| 535 | +224 | 3x |
ungroup() |
|
| 536 | +225 | |||
| 537 | -+ | |||
| 226 | +3x |
- # ordered variables as per gdsr+ adam_vars <- c( |
||
| 538 | +227 | 3x |
- final_qs <- select(+ adsl_vars, "QSSEQ", "QSCAT", "QSSCAT", "QSDTC", "QSSPID", "QSSTAT", "QSSTRESN", |
|
| 539 | +228 | 3x |
- final_qs,+ "QSSTRESC", "QSSTRESU", "QSORRES", "QSORRESU", "QSTEST", "QSTESTCD", "QSTPT", |
|
| 540 | +229 | 3x |
- STUDYID,+ "QSTPTNUM", "QSTPTREF", "QSDY", "QSREASND", "QSTSTDTL", "QSEVAL", "VISIT", "VISITNUM", |
|
| 541 | +230 | 3x |
- USUBJID,+ "PARAM", "PARAMCD", "PARCAT1", "PARCAT1N", "PARCAT2", "AVAL", "AVALC", "AREASND", |
|
| 542 | +231 | 3x |
- QSSEQ,+ "BASE", "BASETYPE", "ABLFL", "CHG", "PCHG", "CHGCAT1", "CRIT1", "CRIT1FL", "DTYPE", |
|
| 543 | +232 | 3x |
- QSTESTCD,+ "ADTM", "ADT", "ADY", "ADTF", "ATMF", "ATPT", "ATPTN", "AVISIT", "AVISITN", "APHASE", |
|
| 544 | +233 | 3x |
- QSTEST,+ "APHASEN", "APERIOD", "APERIODC", "APERIODC", "ASPER", "ASPERC", "PERADY", "TRTP", |
|
| 545 | +234 | 3x |
- QSCAT,+ "TRTA", "ONTRTFL", "LAST02FL", "FIRS02FL", "ANL01FL", "ANL02FL", "ANL03FL", |
|
| 546 | +235 | 3x |
- QSSCAT,+ "ANL04FL", "CGCAT1NX"+ |
+ |
| 236 | ++ |
+ )+ |
+ ||
| 237 | ++ |
+ # order variables in mapped qs by variables in adam_vars |
||
| 547 | +238 | 3x |
- QSORRES,+ adqlqc_name_ordered <- names(adqlqc_final)[order(match(names(adqlqc_final), adam_vars))]+ |
+ |
| 239 | ++ |
+ # adqlqc with variables ordered per gdsr |
||
| 548 | +240 | 3x |
- QSORRESU,+ adqlqc_final <- adqlqc_final %>% |
|
| 549 | +241 | 3x |
- QSSTRESC,+ select( |
|
| 550 | +242 | 3x |
- QSSTRESU,+ any_of(adqlqc_name_ordered)+ |
+ |
| 243 | ++ |
+ )+ |
+ ||
| 244 | ++ | + | ||
| 551 | +245 | 3x |
- QSSTAT,+ adqlqc_final <- relocate(adqlqc_final, "QSEVLINT", .after = "QSTESTCD") %>% |
|
| 552 | +246 | 3x |
- QSREASND,+ arrange( |
|
| 553 | +247 | 3x |
- VISITNUM,+ USUBJID, |
|
| 554 | +248 | 3x |
- VISIT,+ AVISITN, |
|
| 555 | +249 | 3x |
- QSDTC,+ ASEQ, |
|
| 556 | +250 | 3x |
- QSEVLINT+ QSTESTCD |
|
| 557 | +251 |
- )+ )+ |
+ ||
| 252 | ++ |
+ # apply metadata |
||
| 558 | +253 | 3x |
- return(final_qs)+ adqlqc_final <- apply_metadata(adqlqc_final, "metadata/ADQLQC.yml")+ |
+ |
| 254 | +3x | +
+ return(adqlqc_final) |
||
| 559 | +255 |
} |
||
| 560 | +256 | |||
| 561 | +257 |
- #' @describeIn h_adqlqc Function for generating random dates between 2 dates+ #' Helper Functions for Constructing ADQLQC |
||
| 562 | +258 |
#' |
||
| 563 | +259 |
- #' @param from (`datetime vector`)\cr Start date/times.+ #' Internal functions used by `radqlqc`. |
||
| 564 | +260 |
- #' @param to (`datetime vector`)\cr End date/times.+ #' |
||
| 565 | +261 |
- #' @param visit_id (`vector`)\cr Visit identifiers.+ #' @inheritParams argument_convention |
||
| 566 | +262 |
- #'+ #' @inheritParams radqlqc |
||
| 567 | +263 |
- #' @return Data frame with new randomly generated dates variable.+ #' |
||
| 568 | +264 |
- #' @keywords internal+ #' @examples |
||
| 569 | +265 |
- get_random_dates_between <- function(from, to, visit_id) {
+ #' adsl <- radsl(N = 10, study_duration = 2, seed = 1) |
||
| 570 | -30x | +|||
| 266 | +
- min_date <- min(lubridate::as_datetime(from), na.rm = TRUE)+ #' adqlqc <- radqlqc(adsl, seed = 1, percent = 80, number = 2) |
|||
| 571 | -30x | +|||
| 267 | +
- max_date <- max(lubridate::as_datetime(to), na.rm = TRUE)+ #' |
|||
| 572 | -30x | +|||
| 268 | +
- date_seq <- seq(from = min_date + lubridate::days(1), to = max_date, by = "28 days")+ #' @name h_adqlqc |
|||
| 573 | +269 |
-
+ NULL |
||
| 574 | -30x | +|||
| 270 | +
- visit_ids <- unique(visit_id)+ |
|||
| 575 | -30x | +|||
| 271 | +
- out <- sapply(visit_ids, simplify = TRUE, USE.NAMES = TRUE, FUN = function(x) {
+ #' @describeIn h_adqlqc Questionnaires EORTC QLQ-C30 V3.0 SDTM (QS) |
|||
| 576 | -177x | +|||
| 272 | +
- if (x == -1) {
+ #' |
|||
| 577 | -30x | +|||
| 273 | +
- random_days_to_subtract <- lubridate::days(sample(1:10, size = 1))- |
- |||
| 578 | -30x | -
- min_date - random_days_to_subtract- |
- ||
| 579 | -147x | -
- } else if (x == 0) {
- |
- ||
| 580 | -30x | -
- min_date- |
- ||
| 581 | -117x | -
- } else if (x > 0) {
- |
- ||
| 582 | -117x | -
- if (x %in% seq_along(date_seq)) {
- |
- ||
| 583 | -117x | -
- date_seq[[x]]+ #' Function for generating random Questionnaires SDTM domain |
||
| 584 | +274 |
- } else {
- |
- ||
| 585 | -30x | -
- NA+ #' |
||
| 586 | +275 |
- }+ #' @return a dataframe with SDTM questionnaire data |
||
| 587 | +276 |
- }+ #' @keywords internal |
||
| 588 | +277 |
- })- |
- ||
| 589 | -30x | -
- lubridate::as_datetime(out[match(visit_id, visit_ids)])+ get_qs_data <- function(adsl, |
||
| 590 | +278 |
- }+ visit_format = "CYCLE", |
||
| 591 | +279 |
-
+ n_assessments = 5L, |
||
| 592 | +280 |
- #' @describeIn h_adqlqc Prepare ADaM ADQLQC data, adding PARAMCD to SDTM QS data+ n_days = 1L, |
||
| 593 | +281 |
- #'+ lookup = NULL, |
||
| 594 | +282 |
- #' @param df (`data.frame`)\cr SDTM QS dataset.+ seed = NULL, |
||
| 595 | +283 |
- #'+ na_percentage = 0, |
||
| 596 | +284 |
- #' @return `data.frame`+ na_vars = list( |
||
| 597 | +285 |
- #' @keywords internal+ QSORRES = c(1234, 0.2), |
||
| 598 | +286 |
- prep_adqlqc <- function(df) {
+ QSSTRESC = c(1234, 0.2) |
||
| 599 | +287 |
- # create PARAMCD from QSTESTCD+ )) {
|
||
| 600 | +288 | 3x |
- adqlqc <- dplyr::mutate(+ load(system.file("sysdata.rda", package = "random.cdisc.data"))
|
|
| 601 | +289 | 3x |
- df,+ checkmate::assert_string(visit_format) |
|
| 602 | +290 | 3x |
- PARAMCD = case_when(+ checkmate::assert_integer(n_assessments, len = 1, any.missing = FALSE) |
|
| 603 | +291 | 3x |
- QSTESTCD == "EOR0101" ~ "QS02801",+ checkmate::assert_integer(n_days, len = 1, any.missing = FALSE) |
|
| 604 | +292 | 3x |
- QSTESTCD == "EOR0102" ~ "QS02802",+ checkmate::assert_number(seed, null.ok = TRUE) |
|
| 605 | +293 | 3x |
- QSTESTCD == "EOR0103" ~ "QS02803",+ checkmate::assert_number(na_percentage, lower = 0, upper = 1, na.ok = TRUE) |
|
| 606 | +294 | 3x |
- QSTESTCD == "EOR0104" ~ "QS02804",+ checkmate::assert_number(na_percentage, lower = 0, upper = 1) |
|
| 607 | +295 | 3x |
- QSTESTCD == "EOR0105" ~ "QS02805",+ checkmate::assert_true(na_percentage < 1) |
|
| 608 | -3x | +|||
| 296 | +
- QSTESTCD == "EOR0106" ~ "QS02806",+ |
|||
| 609 | -3x | +|||
| 297 | +
- QSTESTCD == "EOR0107" ~ "QS02807",+ # get subjects for QS data from ADSL |
|||
| 610 | -3x | +|||
| 298 | +
- QSTESTCD == "EOR0108" ~ "QS02808",+ # get studyid, subject for QS generation |
|||
| 611 | +299 | 3x |
- QSTESTCD == "EOR0109" ~ "QS02809",+ qs <- select( |
|
| 612 | +300 | 3x |
- QSTESTCD == "EOR0110" ~ "QS02810",+ adsl, |
|
| 613 | +301 | 3x |
- QSTESTCD == "EOR0111" ~ "QS02811",+ STUDYID, |
|
| 614 | +302 | 3x |
- QSTESTCD == "EOR0112" ~ "QS02812",+ USUBJID |
|
| 615 | -3x | +|||
| 303 | +
- QSTESTCD == "EOR0113" ~ "QS02813",+ ) %>% |
|||
| 616 | +304 | 3x |
- QSTESTCD == "EOR0114" ~ "QS02814",+ mutate( |
|
| 617 | +305 | 3x |
- QSTESTCD == "EOR0115" ~ "QS02815",+ DOMAIN = "QS" |
|
| 618 | -3x | +|||
| 306 | +
- QSTESTCD == "EOR0116" ~ "QS02816",+ ) |
|||
| 619 | -3x | +|||
| 307 | +
- QSTESTCD == "EOR0117" ~ "QS02817",+ |
|||
| 620 | -3x | +|||
| 308 | +
- QSTESTCD == "EOR0118" ~ "QS02818",+ # QS prep ----------------------------------------------------------------- |
|||
| 621 | -3x | +|||
| 309 | +
- QSTESTCD == "EOR0119" ~ "QS02819",+ # get questionnaire function for QS |
|||
| 622 | -3x | +|||
| 310 | +
- QSTESTCD == "EOR0120" ~ "QS02820",+ # QSTESTCD: EOR0101 to EOR0130 |
|||
| 623 | +311 | 3x |
- QSTESTCD == "EOR0121" ~ "QS02821",+ eortc_qlq_c30_sub <- filter( |
|
| 624 | +312 | 3x |
- QSTESTCD == "EOR0122" ~ "QS02822",+ eortc_qlq_c30, |
|
| 625 | +313 | 3x |
- QSTESTCD == "EOR0123" ~ "QS02823",+ as.numeric(str_extract(QSTESTCD, "\\d+$")) >= 101 & |
|
| 626 | +314 | 3x |
- QSTESTCD == "EOR0124" ~ "QS02824",+ as.numeric(str_extract(QSTESTCD, "\\d+$")) <= 130 |
|
| 627 | -3x | +|||
| 315 | +
- QSTESTCD == "EOR0125" ~ "QS02825",+ ) %>% |
|||
| 628 | +316 | 3x |
- QSTESTCD == "EOR0126" ~ "QS02826",+ select(-publication_name) |
|
| 629 | -3x | +|||
| 317 | +
- QSTESTCD == "EOR0127" ~ "QS02827",+ |
|||
| 630 | -3x | +|||
| 318 | +
- QSTESTCD == "EOR0128" ~ "QS02828",+ # validate and initialize QSTEST vectors |
|||
| 631 | +319 | 3x |
- QSTESTCD == "EOR0129" ~ "QS02829",+ qstest_init_list <- relvar_init( |
|
| 632 | +320 | 3x |
- QSTESTCD == "EOR0130" ~ "QS02830",+ unique(eortc_qlq_c30_sub$QSTEST), |
|
| 633 | +321 | 3x |
- TRUE ~ QSTESTCD+ unique(eortc_qlq_c30_sub$QSTESTCD) |
|
| 634 | +322 |
- )+ ) |
||
| 635 | +323 |
- )+ |
||
| 636 | +324 | 3x |
- load(system.file("sysdata.rda", package = "random.cdisc.data"))
+ if (!is.null(seed)) {
|
|
| 637 | +325 | 3x |
- adqlqc1 <- dplyr::left_join(+ set.seed(seed) |
|
| 638 | -3x | +|||
| 326 | +
- adqlqc,+ } |
|||
| 639 | -3x | +|||
| 327 | +
- gdsr_param_adqlqc,+ |
|||
| 640 | +328 | 3x |
- by = "PARAMCD"+ checkmate::assert_data_frame(lookup, null.ok = TRUE) |
|
| 641 | +329 |
- )+ |
||
| 642 | +330 | 3x |
- return(adqlqc1)+ lookup_qs <- if (!is.null(lookup)) {
|
|
| 643 | -+ | |||
| 331 | +! |
- }+ lookup |
||
| 644 | +332 |
-
+ } else {
|
||
| 645 | -+ | |||
| 333 | +3x |
- #' @describeIn h_adqlqc Scale calculation for ADQLQC data+ expand.grid( |
||
| 646 | -+ | |||
| 334 | +3x |
- #'+ STUDYID = unique(qs$STUDYID), |
||
| 647 | -+ | |||
| 335 | +3x |
- #' @param adqlqc1 (`data.frame`)\cr Prepared data generated from the [prep_adqlqc()] function.+ USUBJID = qs$USUBJID, |
||
| 648 | -+ | |||
| 336 | +3x |
- #'+ QSTEST = qstest_init_list$relvar1, |
||
| 649 | -+ | |||
| 337 | +3x |
- #' @return `data.frame`+ VISIT = visit_schedule( |
||
| 650 | -+ | |||
| 338 | +3x |
- #' @keywords internal+ visit_format = visit_format,+ |
+ ||
| 339 | +3x | +
+ n_assessments = n_assessments,+ |
+ ||
| 340 | +3x | +
+ n_days = n_days |
||
| 651 | +341 |
- calc_scales <- function(adqlqc1) {
+ ),+ |
+ ||
| 342 | +3x | +
+ stringsAsFactors = FALSE |
||
| 652 | +343 |
- # Prep scale data ---------------------------------------------------------+ ) |
||
| 653 | +344 |
- # parcat2 = scales or global health status+ } |
||
| 654 | +345 |
- # global health status/scales data+ |
||
| 655 | +346 |
- # QSTESTCD: EOR0131 to EOR0145 (global health status and scales)+ # assign related variable values: QSTESTxQSTESTCD are related |
||
| 656 | +347 | 3x |
- load(system.file("sysdata.rda", package = "random.cdisc.data"))
+ lookup_qs <- lookup_qs %>% rel_var( |
|
| 657 | +348 | 3x |
- eortc_qlq_c30_sub <- filter(+ var_name = "QSTESTCD", |
|
| 658 | +349 | 3x |
- eortc_qlq_c30,+ related_var = "QSTEST", |
|
| 659 | +350 | 3x |
- !(as.numeric(str_extract(QSTESTCD, "\\d+$")) >= 101 & as.numeric(str_extract(QSTESTCD, "\\d+$")) <= 130)+ var_values = qstest_init_list$relvar2 |
|
| 660 | +351 |
- ) %>%+ ) |
||
| 661 | -3x | +|||
| 352 | +
- mutate(+ |
|||
| 662 | +353 | 3x |
- PARAMCD = case_when(+ lookup_qs <- left_join( |
|
| 663 | +354 | 3x |
- QSTESTCD == "EOR0131" ~ "QS028QL2",+ lookup_qs, |
|
| 664 | +355 | 3x |
- QSTESTCD == "EOR0132" ~ "QS028PF2",+ eortc_qlq_c30_sub, |
|
| 665 | +356 | 3x |
- QSTESTCD == "EOR0133" ~ "QS028RF2",+ by = c( |
|
| 666 | +357 | 3x |
- QSTESTCD == "EOR0134" ~ "QS028EF",+ "QSTEST", |
|
| 667 | +358 | 3x |
- QSTESTCD == "EOR0135" ~ "QS028CF",+ "QSTESTCD" |
|
| 668 | -3x | +|||
| 359 | +
- QSTESTCD == "EOR0136" ~ "QS028SF",+ ), |
|||
| 669 | +360 | 3x |
- QSTESTCD == "EOR0137" ~ "QS028FA",+ multiple = "all", |
|
| 670 | +361 | 3x |
- QSTESTCD == "EOR0138" ~ "QS028NV",+ relationship = "many-to-many" |
|
| 671 | -3x | +|||
| 362 | +
- QSTESTCD == "EOR0139" ~ "QS028PA",+ ) |
|||
| 672 | -3x | +|||
| 363 | +
- QSTESTCD == "EOR0140" ~ "QS028DY",+ |
|||
| 673 | +364 | 3x |
- QSTESTCD == "EOR0141" ~ "QS028SL",+ lookup_qs <- dplyr::mutate( |
|
| 674 | +365 | 3x |
- QSTESTCD == "EOR0142" ~ "QS028AP",+ lookup_qs, |
|
| 675 | +366 | 3x |
- QSTESTCD == "EOR0143" ~ "QS028CO",+ VISITNUM = dplyr::case_when( |
|
| 676 | +367 | 3x |
- QSTESTCD == "EOR0144" ~ "QS028DI",+ VISIT == "SCREENING" ~ -1, |
|
| 677 | +368 | 3x |
- QSTESTCD == "EOR0145" ~ "QS028FI",+ VISIT == "BASELINE" ~ 0, |
|
| 678 | +369 | 3x |
- TRUE ~ QSTESTCD+ (grepl("^WEEK", VISIT) | grepl("^CYCLE", VISIT)) ~ as.numeric(VISIT) - 2,
|
|
| 679 | -+ | |||
| 370 | +3x |
- )+ TRUE ~ NA_real_ |
||
| 680 | +371 |
- ) %>%+ ) |
||
| 681 | +372 | 3x |
- select(-publication_name)+ ) %>% arrange(USUBJID) |
|
| 682 | +373 | |||
| 683 | +374 |
- # ADaM global health status and scales from gdsr+ # # prep QSALL -------------------------------------------------------------- |
||
| 684 | -3x | +|||
| 375 | +
- gdsr_param_adqlqc <- gdsr_param_adqlqc %>%+ # get last subject and visit for QSALL |
|||
| 685 | +376 | 3x |
- filter(+ last_subj_vis <- select(lookup_qs, USUBJID, VISIT) %>% |
|
| 686 | +377 | 3x |
- !str_detect(PARCAT2, "Original Items|Completion")- |
- |
| 687 | -- |
- )+ distinct() %>% |
||
| 688 | -+ | |||
| 378 | +3x |
-
+ slice(n()) |
||
| 689 | +379 | 3x |
- ghs_scales <- left_join(+ last_subj_vis_full <- filter( |
|
| 690 | +380 | 3x |
- eortc_qlq_c30_sub,+ lookup_qs, |
|
| 691 | +381 | 3x |
- gdsr_param_adqlqc,+ USUBJID == last_subj_vis$USUBJID, |
|
| 692 | +382 | 3x |
- by = "PARAMCD"+ VISIT == last_subj_vis$VISIT |
|
| 693 | +383 |
) |
||
| 694 | +384 |
- # scale data+ |
||
| 695 | +385 | 3x |
- df <- data.frame(index = seq_len(nrow(ghs_scales)))+ qsall_data1 <- tibble::tibble( |
|
| 696 | +386 | 3x |
- df$previous <- list(+ STUDYID = unique(last_subj_vis_full$STUDYID), |
|
| 697 | +387 | 3x |
- c("QS02826", "QS02827"),
+ USUBJID = unique(last_subj_vis_full$USUBJID), |
|
| 698 | +388 | 3x |
- c("QS02811"),
+ VISIT = unique(last_subj_vis_full$VISIT), |
|
| 699 | +389 | 3x |
- c("QS02810", "QS02812", "QS02818"),
+ VISITNUM = unique(last_subj_vis_full$VISITNUM), |
|
| 700 | +390 | 3x |
- c("QS02806", "QS02807"),
+ QSTESTCD = "QSALL", |
|
| 701 | +391 | 3x |
- c("QS02814", "QS02815"),
+ QSTEST = "Questionnaires", |
|
| 702 | +392 | 3x |
- c("QS02808"),
+ QSSTAT = "NOT DONE", |
|
| 703 | +393 | 3x |
- c("QS02817"),
+ QSREASND = "SUBJECT REFUSED" |
|
| 704 | -3x | +|||
| 394 | +
- c("QS02816"),
+ ) |
|||
| 705 | -3x | +|||
| 395 | +
- c("QS02821", "QS02822", "QS02823", "QS02824"),
+
|
|||
| 706 | -3x | +|||
| 396 | +
- c("QS02829", "QS02830"),
+ # remove last subject and visit from main data |
|||
| 707 | +397 | 3x |
- c("QS02813"),
+ lookup_qs_sub <- anti_join( |
|
| 708 | +398 | 3x |
- c("QS02801", "QS02802", "QS02803", "QS02804", "QS02805"),
+ lookup_qs, |
|
| 709 | +399 | 3x |
- c("QS02809", "QS02819"),
+ last_subj_vis_full, |
|
| 710 | +400 | 3x |
- c("QS02820", "QS02825"),
+ by = c("USUBJID", "VISIT")
|
|
| 711 | -3x | +|||
| 401 | +
- c("QS02828")
+ ) |
|||
| 712 | +402 |
- )+ |
||
| 713 | +403 | 3x |
- df$newName <- list(+ set.seed(seed) |
|
| 714 | +404 | 3x |
- "QS028SF",+ lookup_qs_sub_x <- lookup_qs_sub %>% |
|
| 715 | +405 | 3x |
- "QS028SL",+ group_by( |
|
| 716 | +406 | 3x |
- "QS028FA",+ USUBJID, |
|
| 717 | +407 | 3x |
- "QS028RF2",+ QSTESTCD, |
|
| 718 | +408 | 3x |
- "QS028NV",+ VISIT |
|
| 719 | -3x | +|||
| 409 | +
- "QS028DY",+ ) %>% |
|||
| 720 | +410 | 3x |
- "QS028DI",+ slice_sample(n = 1) %>% |
|
| 721 | +411 | 3x |
- "QS028CO",+ ungroup() %>% |
|
| 722 | +412 | 3x |
- "QS028EF",+ as.data.frame() |
|
| 723 | -3x | +|||
| 413 | +
- "QS028QL2",+ |
|||
| 724 | +414 | 3x |
- "QS028AP",+ lookup_qs_sub_x <- arrange( |
|
| 725 | +415 | 3x |
- "QS028PF2",+ lookup_qs_sub_x, |
|
| 726 | +416 | 3x |
- "QS028PA",+ USUBJID, |
|
| 727 | +417 | 3x |
- "QS028CF",+ VISITNUM |
|
| 728 | -3x | +|||
| 418 | +
- "QS028FI"+ ) |
|||
| 729 | +419 |
- )+ |
||
| 730 | -3x | +|||
| 420 | +
- df$newNamelabel <- list(+ # add date: QSDTC --------------------------------------------------------- |
|||
| 731 | -3x | +|||
| 421 | +
- "EORTC QLQ-C30: Social functioning",+ # get treatment dates from ADSL |
|||
| 732 | +422 | 3x |
- "EORTC QLQ-C30: Insomnia",+ adsl_trt <- select( |
|
| 733 | +423 | 3x |
- "EORTC QLQ-C30: Fatigue",+ adsl, |
|
| 734 | +424 | 3x |
- "EORTC QLQ-C30: Role functioning (revised)",+ USUBJID, |
|
| 735 | +425 | 3x |
- "EORTC QLQ-C30: Nausea and vomiting",+ TRTSDTM, |
|
| 736 | +426 | 3x |
- "EORTC QLQ-C30: Dyspnoea",+ TRTEDTM |
|
| 737 | -3x | +|||
| 427 | +
- "EORTC QLQ-C30: Diarrhoea",+ ) |
|||
| 738 | -3x | +|||
| 428 | +
- "EORTC QLQ-C30: Constipation",+ # use to derive QSDTC |
|||
| 739 | -3x | +|||
| 429 | +
- "EORTC QLQ-C30: Emotional functioning",+ # if no treatment end date, create an arbituary one |
|||
| 740 | +430 | 3x |
- "EORTC QLQ-C30: Global health status/QoL (revised)",+ trt_end_date <- max(adsl_trt$TRTEDTM, na.rm = TRUE) |
|
| 741 | -3x | +|||
| 431 | +
- "EORTC QLQ-C30: Appetite loss",+ |
|||
| 742 | +432 | 3x |
- "EORTC QLQ-C30: Physical functioning (revised)",+ lookup_qs_sub_x <- left_join( |
|
| 743 | +433 | 3x |
- "EORTC QLQ-C30: Pain",+ lookup_qs_sub_x, |
|
| 744 | +434 | 3x |
- "EORTC QLQ-C30: Cognitive functioning",+ adsl_trt, |
|
| 745 | +435 | 3x |
- "EORTC QLQ-C30: Financial difficulties"+ by = "USUBJID" |
|
| 746 | +436 |
- )+ ) %>% |
||
| 747 | +437 | 3x |
- df$newNameCategory <- list(+ group_by( |
|
| 748 | +438 | 3x |
- "Functional Scales",+ USUBJID |
|
| 749 | -3x | +|||
| 439 | +
- "Symptom Scales",+ ) %>% |
|||
| 750 | +440 | 3x |
- "Symptom Scales",+ mutate(QSDTC = get_random_dates_between( |
|
| 751 | +441 | 3x |
- "Functional Scales",+ from = TRTSDTM, |
|
| 752 | +442 | 3x |
- "Symptom Scales",+ to = ifelse( |
|
| 753 | +443 | 3x |
- "Symptom Scales",+ is.na(TRTEDTM), |
|
| 754 | +444 | 3x |
- "Symptom Scales",+ trt_end_date, |
|
| 755 | +445 | 3x |
- "Symptom Scales",+ TRTEDTM |
|
| 756 | -3x | +|||
| 446 | +
- "Functional Scales",+ ), |
|||
| 757 | +447 | 3x |
- "Global Health Status",+ visit_id = VISITNUM |
|
| 758 | -3x | +|||
| 448 | +
- "Symptom Scales",+ )) %>% |
|||
| 759 | +449 | 3x |
- "Functional Scales",+ select(-c("TRTSDTM", "TRTEDTM"))
+ |
+ |
| 450 | ++ | + + | +||
| 451 | ++ |
+ # filter out subjects with missing dates |
||
| 760 | +452 | 3x |
- "Symptom Scales",+ lookup_qs_sub_x1 <- filter( |
|
| 761 | +453 | 3x |
- "Functional Scales",+ lookup_qs_sub_x, |
|
| 762 | +454 | 3x |
- "Symptom Scales"+ !is.na(QSDTC) |
|
| 763 | +455 |
) |
||
| 764 | -3x | +|||
| 456 | +
- df$num_param <- list(+ |
|||
| 765 | -3x | +|||
| 457 | +
- "1",+ # subjects with missing dates |
|||
| 766 | +458 | 3x |
- "1",+ lookup_qs_sub_x2 <- filter( |
|
| 767 | +459 | 3x |
- "2",+ lookup_qs_sub_x, |
|
| 768 | +460 | 3x |
- "1",+ is.na(QSDTC) |
|
| 769 | -3x | +|||
| 461 | +
- "1",+ ) %>% |
|||
| 770 | +462 | 3x |
- "1",+ select( |
|
| 771 | +463 | 3x |
- "1",+ STUDYID, |
|
| 772 | +464 | 3x |
- "1",+ USUBJID, |
|
| 773 | +465 | 3x |
- "2",+ VISIT, |
|
| 774 | +466 | 3x |
- "1",+ VISITNUM |
|
| 775 | -3x | +|||
| 467 | +
- "1",+ ) %>% |
|||
| 776 | +468 | 3x |
- "3",+ distinct() |
|
| 777 | -3x | +|||
| 469 | +
- "1",+ |
|||
| 778 | -3x | +|||
| 470 | +
- "1",+ # generate QSALL for subjects with missing dates |
|||
| 779 | +471 | 3x |
- "1"+ qsall_data2 <- mutate( |
|
| 780 | -+ | |||
| 472 | +3x |
- )+ lookup_qs_sub_x2, |
||
| 781 | +473 | 3x |
- df$equation <- list(+ QSTESTCD = "QSALL", |
|
| 782 | +474 | 3x |
- "new_value = (1 - ((temp_val/var_length)-1)/3)*100.0",+ QSTEST = "Questionnaires", |
|
| 783 | +475 | 3x |
- "new_value = ((temp_val/var_length-1)/3)*100.0",+ QSSTAT = "NOT DONE", |
|
| 784 | +476 | 3x |
- "new_value = ((temp_val/var_length-1)/3)*100.0",+ QSREASND = "SUBJECT REFUSED" |
|
| 785 | -3x | +|||
| 477 | +
- "new_value = (1 - ((temp_val/var_length)-1)/3)*100.0",+ ) |
|||
| 786 | -3x | +|||
| 478 | +
- "new_value = ((temp_val/var_length-1)/3)*100.0",+ |
|||
| 787 | -3x | +|||
| 479 | +
- "new_value = ((temp_val/var_length-1)/3)*100.0",+ # add qsall data to original item data |
|||
| 788 | +480 | 3x |
- "new_value = ((temp_val/var_length-1)/3)*100.0",+ lookup_qs_sub_all <- bind_rows( |
|
| 789 | +481 | 3x |
- "new_value = ((temp_val/var_length-1)/3)*100.0",+ lookup_qs_sub_x1, |
|
| 790 | +482 | 3x |
- "new_value = (1 - ((temp_val/var_length)-1)/3)*100.0",+ qsall_data1, |
|
| 791 | +483 | 3x |
- "new_value = ((temp_val/var_length-1)/6)*100.0",+ qsall_data2 |
|
| 792 | -3x | +|||
| 484 | +
- "new_value = ((temp_val/var_length-1)/3)*100.0",+ )+ |
+ |||
| 485 | ++ | + | ||
| 793 | +486 | 3x |
- "new_value = (1 - ((temp_val/var_length)-1)/3)*100.0",+ qs_all <- lookup_qs_sub_all %>% |
|
| 794 | +487 | 3x |
- "new_value = ((temp_val/var_length-1)/3)*100.0",+ arrange( |
|
| 795 | +488 | 3x |
- "new_value = (1 - ((temp_val/var_length)-1)/3)*100.0",+ STUDYID, |
|
| 796 | +489 | 3x |
- "new_value = ((temp_val/var_length-1)/3)*100.0"+ USUBJID, |
|
| 797 | -+ | |||
| 490 | +3x |
- )+ VISITNUM |
||
| 798 | +491 |
-
+ ) %>% |
||
| 799 | +492 | 3x |
- expect_data <- data.frame(+ dplyr::group_by(USUBJID) %>% |
|
| 800 | +493 | 3x |
- PARAM = expect$PARAM,+ dplyr::ungroup() |
|
| 801 | -3x | +|||
| 494 | +
- PARAMCD = expect$PARAMCD,+ |
|||
| 802 | -3x | +|||
| 495 | +
- PARCAT2 = expect$PARCAT2,+ # get first and second subject ids |
|||
| 803 | +496 | 3x |
- PARCAT1N = expect$PARCAT1N,+ first_second_subj <- select(qs_all, USUBJID) %>% |
|
| 804 | +497 | 3x |
- AVAL = c(0, 1),+ distinct() %>% |
|
| 805 | +498 | 3x |
- AVALC = c(+ slice(1:2)+ |
+ |
| 499 | ++ | + | ||
| 806 | +500 | 3x |
- "Not expected to complete questionnaire",+ qs1 <- filter( |
|
| 807 | +501 | 3x |
- "Expected to complete questionnaire"+ qs_all, |
|
| 808 | -+ | |||
| 502 | +3x |
- )+ USUBJID %in% first_second_subj$USUBJID |
||
| 809 | +503 |
) |
||
| 810 | +504 | |||
| 811 | +505 | 3x |
- df_saved <- data.frame()+ if (length(na_vars) > 0 && na_percentage > 0) {
|
|
| 812 | -+ | |||
| 506 | +3x |
-
+ qs1 <- mutate_na(ds = qs1, na_vars = na_vars, na_percentage = na_percentage) |
||
| 813 | -3x | +|||
| 507 | +
- unique_id <- unique(adqlqc1$USUBJID)+ } |
|||
| 814 | +508 | |||
| 815 | -3x | +|||
| 509 | +
- for (id in unique_id) {
+ # QSSTAT = NOT DONE |
|||
| 816 | -30x | +510 | +3x |
- id_data <- adqlqc1[adqlqc1$USUBJID == id, ]+ qs1 <- mutate( |
| 817 | -30x | +511 | +3x |
- unique_avisit <- unique(id_data$AVISIT)+ qs1, |
| 818 | -30x | +512 | +3x |
- for (visit in unique_avisit) {
+ QSSTAT = case_when( |
| 819 | -180x | +513 | +3x |
- if (is.na(visit)) {
+ is.na(QSORRES) & is.na(QSSTRESC) ~ "NOT DONE" |
| 820 | -! | +|||
| 514 | +
- next+ ) |
|||
| 821 | +515 |
- }+ ) |
||
| 822 | -180x | +|||
| 516 | +
- id_data_at_visit <- id_data[id_data$AVISIT == visit, ]+ |
|||
| 823 | +517 |
-
+ # remove first and second subjects from main data |
||
| 824 | -180x | +518 | +3x |
- if (any(id_data_at_visit$PARAMCD != "QSALL")) {
+ qs2 <- anti_join( |
| 825 | -177x | +519 | +3x |
- for (idx in seq_along(df$index)) {
+ qs_all, |
| 826 | -2655x | +520 | +3x |
- previous_names <- df$previous[idx]+ qs1, |
| 827 | -2655x | +521 | +3x |
- current_name <- df$newName[idx]+ by = c("USUBJID")
|
| 828 | -2655x | +|||
| 522 | +
- current_name_label <- df$newNamelabel[idx]+ ) |
|||
| 829 | -2655x | +|||
| 523 | +
- current_name_category <- df$newNameCategory[idx]+ |
|||
| 830 | -2655x | +524 | +3x |
- eqn <- df$equation[idx]+ final_qs <- rbind( |
| 831 | -2655x | +525 | +3x |
- temp_val <- 0+ qs1, |
| 832 | -2655x | +526 | +3x |
- var_length <- 0+ qs2+ |
+
| 527 | ++ |
+ ) %>% |
||
| 833 | -2655x | +528 | +3x |
- for (param_name in previous_names[[1]]) {
+ group_by(USUBJID) %>% |
| 834 | -5310x | +529 | +3x |
- if (param_name %in% id_data_at_visit$PARAMCD) { ####
+ dplyr::mutate(QSSEQ = row_number()) %>% |
| 835 | -5310x | +530 | +3x |
- current_val <- as.numeric(as.character(id_data_at_visit$AVAL[id_data_at_visit$PARAMCD == param_name]))+ arrange( |
| 836 | -5310x | +531 | +3x |
- if (!is.na(current_val)) {
+ STUDYID, |
| 837 | -5094x | +532 | +3x |
- temp_val <- temp_val + current_val ###+ USUBJID, |
| 838 | -5094x | +533 | +3x |
- var_length <- var_length + 1+ VISITNUM |
| 839 | +534 |
- }+ ) %>% |
||
| 840 | -+ | |||
| 535 | +3x |
- } # if+ ungroup() |
||
| 841 | +536 |
- } # param_name+ |
||
| 842 | +537 |
- # eval+ # ordered variables as per gdsr |
||
| 843 | -2655x | +538 | +3x |
- if (var_length >= as.numeric(df$num_param[idx])) {
+ final_qs <- select( |
| 844 | -2604x | +539 | +3x |
- eval(parse(text = eqn)) #####+ final_qs, |
| 845 | -+ | |||
| 540 | +3x |
- } else {
+ STUDYID, |
||
| 846 | -51x | +541 | +3x |
- new_value <- NA+ USUBJID, |
| 847 | -+ | |||
| 542 | +3x |
- }+ QSSEQ, |
||
| 848 | -+ | |||
| 543 | +3x |
-
+ QSTESTCD, |
||
| 849 | -2655x | +544 | +3x |
- new_data_row <- data.frame(+ QSTEST, |
| 850 | -2655x | +545 | +3x |
- study = str_extract(id, "[A-Z]+[0-9]+"),+ QSCAT, |
| 851 | -2655x | +546 | +3x |
- id,+ QSSCAT, |
| 852 | -2655x | +547 | +3x |
- visit,+ QSORRES, |
| 853 | -2655x | +548 | +3x |
- id_data_at_visit$AVISITN[1],+ QSORRESU, |
| 854 | -2655x | +549 | +3x |
- id_data_at_visit$QSDTC[1],+ QSSTRESC, |
| 855 | -2655x | +550 | +3x |
- current_name_category,+ QSSTRESU, |
| 856 | -2655x | +551 | +3x |
- current_name_label,+ QSSTAT, |
| 857 | -2655x | +552 | +3x |
- current_name,+ QSREASND, |
| 858 | -2655x | +553 | +3x |
- new_value,+ VISITNUM, |
| 859 | -2655x | +554 | +3x |
- NA,+ VISIT, |
| 860 | -2655x | -
- stringsAsFactors = FALSE- |
- ||
| 861 | -+ | 555 | +3x |
- )+ QSDTC, |
| 862 | -2655x | +556 | +3x |
- colnames(new_data_row) <- c(+ QSEVLINT |
| 863 | -2655x | +|||
| 557 | +
- "STUDYID", "USUBJID", "AVISIT", "AVISITN",+ ) |
|||
| 864 | -2655x | +558 | +3x |
- "ADTM", "PARCAT2", "PARAM", "PARAMCD",+ return(final_qs) |
| 865 | -2655x | +|||
| 559 | +
- "AVAL", "AVALC"+ } |
|||
| 866 | +560 |
- ) ###+ |
||
| 867 | -2655x | +|||
| 561 | +
- df_saved <- rbind(df_saved, new_data_row) #####+ #' @describeIn h_adqlqc Function for generating random dates between 2 dates |
|||
| 868 | +562 |
- } # idx+ #' |
||
| 869 | +563 |
- }+ #' @param from (`datetime vector`)\cr Start date/times. |
||
| 870 | +564 |
- # add expect data+ #' @param to (`datetime vector`)\cr End date/times. |
||
| 871 | -180x | +|||
| 565 | +
- expect_value <- sample(expect_data$AVAL, 1, prob = c(0.10, 0.90))+ #' @param visit_id (`vector`)\cr Visit identifiers. |
|||
| 872 | -180x | +|||
| 566 | +
- expect_valuec <- expect_data$AVALC[expect_data$AVAL == expect_value]+ #' |
|||
| 873 | +567 |
-
+ #' @return Data frame with new randomly generated dates variable. |
||
| 874 | -180x | +|||
| 568 | +
- new_data_row <- data.frame(+ #' @keywords internal |
|||
| 875 | -180x | +|||
| 569 | +
- study = str_extract(id, "[A-Z]+[0-9]+"),+ get_random_dates_between <- function(from, to, visit_id) {
|
|||
| 876 | -180x | +570 | +30x |
- id,+ min_date <- min(lubridate::as_datetime(from), na.rm = TRUE) |
| 877 | -180x | +571 | +30x |
- visit,+ max_date <- max(lubridate::as_datetime(to), na.rm = TRUE) |
| 878 | -180x | +572 | +30x |
- id_data_at_visit$AVISITN[1],+ date_seq <- seq(from = min_date + lubridate::days(1), to = max_date, by = "28 days") |
| 879 | -180x | +|||
| 573 | +
- datetime = NA,+ |
|||
| 880 | -180x | +574 | +30x |
- expect_data$PARCAT2[1],+ visit_ids <- unique(visit_id) |
| 881 | -180x | +575 | +30x |
- expect_data$PARAM[1],+ out <- sapply(visit_ids, simplify = TRUE, USE.NAMES = TRUE, FUN = function(x) {
|
| 882 | -180x | +576 | +177x |
- expect_data$PARAMCD[1],+ if (x == -1) {
|
| 883 | -180x | +577 | +30x |
- expect_value,+ random_days_to_subtract <- lubridate::days(sample(1:10, size = 1)) |
| 884 | -180x | +578 | +30x |
- expect_valuec,+ min_date - random_days_to_subtract |
| 885 | -180x | -
- stringsAsFactors = FALSE- |
- ||
| 886 | -+ | 579 | +147x |
- )+ } else if (x == 0) {
|
| 887 | -180x | +580 | +30x |
- colnames(new_data_row) <- c(+ min_date |
| 888 | -180x | +581 | +117x |
- "STUDYID", "USUBJID", "AVISIT", "AVISITN",+ } else if (x > 0) {
|
| 889 | -180x | +582 | +117x |
- "ADTM", "PARCAT2", "PARAM", "PARAMCD", "AVAL",+ if (x %in% seq_along(date_seq)) {
|
| 890 | -180x | +583 | +117x |
- "AVALC"+ date_seq[[x]] |
| 891 | +584 |
- ) ###+ } else {
|
||
| 892 | -180x | +585 | +30x |
- df_saved <- rbind(df_saved, new_data_row)+ NA |
| 893 | +586 |
- } # visit+ } |
||
| 894 | +587 |
- } # id+ } |
||
| 895 | +588 |
-
+ }) |
||
| 896 | -3x | +589 | +30x |
- df_saved1 <- left_join(+ lubridate::as_datetime(out[match(visit_id, visit_ids)]) |
| 897 | -3x | +|||
| 590 | +
- df_saved,+ } |
|||
| 898 | -3x | +|||
| 591 | +
- ghs_scales,+ |
|||
| 899 | -3x | +|||
| 592 | +
- by = c(+ #' @describeIn h_adqlqc Prepare ADaM ADQLQC data, adding PARAMCD to SDTM QS data |
|||
| 900 | -3x | +|||
| 593 | +
- "PARAM",+ #' |
|||
| 901 | -3x | +|||
| 594 | +
- "PARAMCD",+ #' @param df (`data.frame`)\cr SDTM QS dataset. |
|||
| 902 | -3x | +|||
| 595 | +
- "PARCAT2"+ #' |
|||
| 903 | +596 |
- )+ #' @return `data.frame` |
||
| 904 | +597 |
- ) %>%+ #' @keywords internal |
||
| 905 | -3x | +|||
| 598 | +
- mutate(+ prep_adqlqc <- function(df) {
|
|||
| 906 | -3x | +|||
| 599 | +
- AVALC = ifelse(is.na(AVALC), as.character(AVAL), AVALC),+ # create PARAMCD from QSTESTCD |
|||
| 907 | +600 | 3x |
- PARCAT1 = ifelse(PARAMCD == "EX028", expect$PARCAT1, PARCAT1),+ adqlqc <- dplyr::mutate( |
|
| 908 | +601 | 3x |
- PARCAT1N = ifelse(PARAMCD == "EX028", expect$PARCAT1N, PARCAT1N)- |
- |
| 909 | -- |
- )- |
- ||
| 910 | -- |
-
+ df, |
||
| 911 | +602 | 3x |
- adqlqc_tmp <- bind_rows(adqlqc1, df_saved1) %>%+ PARAMCD = case_when( |
|
| 912 | +603 | 3x |
- arrange(+ QSTESTCD == "EOR0101" ~ "QS02801", |
|
| 913 | +604 | 3x |
- USUBJID,+ QSTESTCD == "EOR0102" ~ "QS02802", |
|
| 914 | +605 | 3x |
- AVISITN,+ QSTESTCD == "EOR0103" ~ "QS02803", |
|
| 915 | +606 | 3x |
- QSTESTCD- |
- |
| 916 | -- |
- )+ QSTESTCD == "EOR0104" ~ "QS02804", |
||
| 917 | +607 | 3x |
- return(adqlqc_tmp)+ QSTESTCD == "EOR0105" ~ "QS02805", |
|
| 918 | -+ | |||
| 608 | +3x |
- }+ QSTESTCD == "EOR0106" ~ "QS02806", |
||
| 919 | -+ | |||
| 609 | +3x |
-
+ QSTESTCD == "EOR0107" ~ "QS02807", |
||
| 920 | -+ | |||
| 610 | +3x |
- #' @describeIn h_adqlqc Calculate Change from Baseline Category 1+ QSTESTCD == "EOR0108" ~ "QS02808", |
||
| 921 | -+ | |||
| 611 | +3x |
- #'+ QSTESTCD == "EOR0109" ~ "QS02809", |
||
| 922 | -+ | |||
| 612 | +3x |
- #' @param dataset (`data.frame`)\cr ADaM dataset.+ QSTESTCD == "EOR0110" ~ "QS02810", |
||
| 923 | -+ | |||
| 613 | +3x |
- #'+ QSTESTCD == "EOR0111" ~ "QS02811", |
||
| 924 | -+ | |||
| 614 | +3x |
- #' @return `data.frame`+ QSTESTCD == "EOR0112" ~ "QS02812", |
||
| 925 | -+ | |||
| 615 | +3x |
- #' @keywords internal+ QSTESTCD == "EOR0113" ~ "QS02813", |
||
| 926 | -+ | |||
| 616 | +3x |
- derv_chgcat1 <- function(dataset) {
+ QSTESTCD == "EOR0114" ~ "QS02814", |
||
| 927 | -+ | |||
| 617 | +3x |
- # derivation of CHGCAT1+ QSTESTCD == "EOR0115" ~ "QS02815", |
||
| 928 | +618 | 3x |
- check_vars <- c("PARCAT2", "CHG")
+ QSTESTCD == "EOR0116" ~ "QS02816", |
|
| 929 | -+ | |||
| 619 | +3x |
-
+ QSTESTCD == "EOR0117" ~ "QS02817", |
||
| 930 | +620 | 3x |
- if (all(check_vars %in% names(dataset))) {
+ QSTESTCD == "EOR0118" ~ "QS02818", |
|
| 931 | +621 | 3x |
- dataset$CHGCAT1 <- ifelse(+ QSTESTCD == "EOR0119" ~ "QS02819", |
|
| 932 | +622 | 3x |
- dataset$PARCAT2 == "Symptom Scales" & !is.na(dataset$CHG) & dataset$CHG <= -10,+ QSTESTCD == "EOR0120" ~ "QS02820", |
|
| 933 | +623 | 3x |
- "Improved", ""+ QSTESTCD == "EOR0121" ~ "QS02821", |
|
| 934 | -+ | |||
| 624 | +3x |
- )+ QSTESTCD == "EOR0122" ~ "QS02822", |
||
| 935 | +625 | 3x |
- dataset$CHGCAT1 <- ifelse(+ QSTESTCD == "EOR0123" ~ "QS02823", |
|
| 936 | +626 | 3x |
- dataset$PARCAT2 == "Symptom Scales" & !is.na(dataset$CHG) & dataset$CHG >= 10,+ QSTESTCD == "EOR0124" ~ "QS02824", |
|
| 937 | +627 | 3x |
- "Worsened", dataset$CHGCAT1+ QSTESTCD == "EOR0125" ~ "QS02825", |
|
| 938 | -+ | |||
| 628 | +3x |
- )+ QSTESTCD == "EOR0126" ~ "QS02826", |
||
| 939 | +629 | 3x |
- dataset$CHGCAT1 <- ifelse(+ QSTESTCD == "EOR0127" ~ "QS02827", |
|
| 940 | +630 | 3x |
- dataset$PARCAT2 == "Symptom Scales" &+ QSTESTCD == "EOR0128" ~ "QS02828", |
|
| 941 | +631 | 3x |
- !is.na(dataset$CHG) & dataset$CHG > -10 &+ QSTESTCD == "EOR0129" ~ "QS02829", |
|
| 942 | +632 | 3x |
- dataset$CHG < 10,+ QSTESTCD == "EOR0130" ~ "QS02830", |
|
| 943 | +633 | 3x |
- "No change", dataset$CHGCAT1+ TRUE ~ QSTESTCD |
|
| 944 | +634 |
) |
||
| 945 | +635 |
-
+ ) |
||
| 946 | +636 | 3x |
- dataset$CHGCAT1 <- ifelse(+ load(system.file("sysdata.rda", package = "random.cdisc.data"))
|
|
| 947 | +637 | 3x |
- dataset$PARCAT2 %in% c("Functional Scales", "Global Health Status") &
+ adqlqc1 <- dplyr::left_join( |
|
| 948 | +638 | 3x |
- !is.na(dataset$CHG) & dataset$CHG >= 10,+ adqlqc, |
|
| 949 | +639 | 3x |
- "Improved", dataset$CHGCAT1- |
- |
| 950 | -- |
- )+ gdsr_param_adqlqc, |
||
| 951 | +640 | 3x |
- dataset$CHGCAT1 <- ifelse(+ by = "PARAMCD" |
|
| 952 | -3x | +|||
| 641 | +
- dataset$PARCAT2 %in% c("Functional Scales", "Global Health Status") &
+ ) |
|||
| 953 | +642 | 3x |
- !is.na(dataset$CHG) & dataset$CHG <= -10,+ return(adqlqc1) |
|
| 954 | -3x | +|||
| 643 | +
- "Worsened", dataset$CHGCAT1+ } |
|||
| 955 | +644 |
- )+ |
||
| 956 | -3x | +|||
| 645 | +
- dataset$CHGCAT1 <- ifelse(+ #' @describeIn h_adqlqc Scale calculation for ADQLQC data |
|||
| 957 | -3x | +|||
| 646 | +
- dataset$PARCAT2 %in% c("Functional Scales", "Global Health Status") &
+ #' |
|||
| 958 | -3x | +|||
| 647 | +
- !is.na(dataset$CHG) &+ #' @param adqlqc1 (`data.frame`)\cr Prepared data generated from the [prep_adqlqc()] function. |
|||
| 959 | -3x | +|||
| 648 | +
- dataset$CHG > -10 & dataset$CHG < 10,+ #' |
|||
| 960 | -3x | +|||
| 649 | +
- "No change", dataset$CHGCAT1+ #' @return `data.frame` |
|||
| 961 | +650 |
- )+ #' @keywords internal |
||
| 962 | +651 |
-
+ calc_scales <- function(adqlqc1) {
|
||
| 963 | -3x | +|||
| 652 | +
- dataset$CHGCAT1 <- ifelse(+ # Prep scale data --------------------------------------------------------- |
|||
| 964 | -3x | +|||
| 653 | +
- dataset$PARAMCD %in% c("QS02829", "QS02830") & dataset$CHG == 6,
+ # parcat2 = scales or global health status |
|||
| 965 | -3x | +|||
| 654 | +
- "Improved by six levels", dataset$CHGCAT1+ # global health status/scales data |
|||
| 966 | +655 |
- )+ # QSTESTCD: EOR0131 to EOR0145 (global health status and scales) |
||
| 967 | +656 | 3x |
- dataset$CHGCAT1 <- ifelse(+ load(system.file("sysdata.rda", package = "random.cdisc.data"))
|
|
| 968 | +657 | 3x |
- dataset$PARAMCD %in% c("QS02829", "QS02830") & dataset$CHG == 5,
+ eortc_qlq_c30_sub <- filter( |
|
| 969 | +658 | 3x |
- "Improved by five levels", dataset$CHGCAT1+ eortc_qlq_c30,+ |
+ |
| 659 | +3x | +
+ !(as.numeric(str_extract(QSTESTCD, "\\d+$")) >= 101 & as.numeric(str_extract(QSTESTCD, "\\d+$")) <= 130) |
||
| 970 | +660 |
- )+ ) %>% |
||
| 971 | +661 | 3x |
- dataset$CHGCAT1 <- ifelse(+ mutate( |
|
| 972 | +662 | 3x |
- dataset$PARAMCD %in% c("QS02829", "QS02830") & dataset$CHG == 4,
+ PARAMCD = case_when( |
|
| 973 | +663 | 3x |
- "Improved by four levels", dataset$CHGCAT1- |
- |
| 974 | -- |
- )+ QSTESTCD == "EOR0131" ~ "QS028QL2", |
||
| 975 | +664 | 3x |
- dataset$CHGCAT1 <- ifelse(+ QSTESTCD == "EOR0132" ~ "QS028PF2", |
|
| 976 | +665 | 3x |
- dataset$PARAMCD %in% c("QS02829", "QS02830") & dataset$CHG == 3,
+ QSTESTCD == "EOR0133" ~ "QS028RF2", |
|
| 977 | +666 | 3x |
- "Improved by three levels", dataset$CHGCAT1+ QSTESTCD == "EOR0134" ~ "QS028EF", |
|
| 978 | -+ | |||
| 667 | +3x |
- )+ QSTESTCD == "EOR0135" ~ "QS028CF", |
||
| 979 | +668 | 3x |
- dataset$CHGCAT1 <- ifelse(+ QSTESTCD == "EOR0136" ~ "QS028SF", |
|
| 980 | +669 | 3x |
- dataset$PARAMCD %in% c("QS02829", "QS02830") & dataset$CHG == 2,
+ QSTESTCD == "EOR0137" ~ "QS028FA", |
|
| 981 | +670 | 3x |
- "Improved by two levels", dataset$CHGCAT1+ QSTESTCD == "EOR0138" ~ "QS028NV", |
|
| 982 | -+ | |||
| 671 | +3x |
- )+ QSTESTCD == "EOR0139" ~ "QS028PA", |
||
| 983 | +672 | 3x |
- dataset$CHGCAT1 <- ifelse(+ QSTESTCD == "EOR0140" ~ "QS028DY", |
|
| 984 | +673 | 3x |
- dataset$PARAMCD %in% c("QS02829", "QS02830") & dataset$CHG == 1,
+ QSTESTCD == "EOR0141" ~ "QS028SL", |
|
| 985 | +674 | 3x |
- "Improved by one level", dataset$CHGCAT1+ QSTESTCD == "EOR0142" ~ "QS028AP", |
|
| 986 | -+ | |||
| 675 | +3x |
- )+ QSTESTCD == "EOR0143" ~ "QS028CO", |
||
| 987 | +676 | 3x |
- dataset$CHGCAT1 <- ifelse(+ QSTESTCD == "EOR0144" ~ "QS028DI", |
|
| 988 | +677 | 3x |
- dataset$PARAMCD %in% c("QS02829", "QS02830") & dataset$CHG == 0,
+ QSTESTCD == "EOR0145" ~ "QS028FI", |
|
| 989 | +678 | 3x |
- "No change", dataset$CHGCAT1+ TRUE ~ QSTESTCD |
|
| 990 | +679 |
- )+ ) |
||
| 991 | -3x | +|||
| 680 | +
- dataset$CHGCAT1 <- ifelse(+ ) %>% |
|||
| 992 | +681 | 3x |
- dataset$PARAMCD %in% c("QS02829", "QS02830") & dataset$CHG == -1,
+ select(-publication_name) |
|
| 993 | -3x | +|||
| 682 | +
- "Worsened by one level", dataset$CHGCAT1+ |
|||
| 994 | +683 |
- )+ # ADaM global health status and scales from gdsr |
||
| 995 | +684 | 3x |
- dataset$CHGCAT1 <- ifelse(+ gdsr_param_adqlqc <- gdsr_param_adqlqc %>% |
|
| 996 | +685 | 3x |
- dataset$PARAMCD %in% c("QS02829", "QS02830") & dataset$CHG == -2,
+ filter( |
|
| 997 | +686 | 3x |
- "Worsened by two levels", dataset$CHGCAT1+ !str_detect(PARCAT2, "Original Items|Completion") |
|
| 998 | +687 |
) |
||
| 999 | -3x | +|||
| 688 | +
- dataset$CHGCAT1 <- ifelse(+ |
|||
| 1000 | +689 | 3x |
- dataset$PARAMCD %in% c("QS02829", "QS02830") & dataset$CHG == -3,
+ ghs_scales <- left_join( |
|
| 1001 | +690 | 3x |
- "Worsened by three levels", dataset$CHGCAT1- |
- |
| 1002 | -- |
- )+ eortc_qlq_c30_sub, |
||
| 1003 | +691 | 3x |
- dataset$CHGCAT1 <- ifelse(+ gdsr_param_adqlqc, |
|
| 1004 | +692 | 3x |
- dataset$PARAMCD %in% c("QS02829", "QS02830") & dataset$CHG == -4,
+ by = "PARAMCD" |
|
| 1005 | -3x | +|||
| 693 | +
- "Worsened by four levels", dataset$CHGCAT1+ ) |
|||
| 1006 | +694 |
- )+ # scale data |
||
| 1007 | +695 | 3x |
- dataset$CHGCAT1 <- ifelse(+ df <- data.frame(index = seq_len(nrow(ghs_scales))) |
|
| 1008 | +696 | 3x |
- dataset$PARAMCD %in% c("QS02829", "QS02830") & dataset$CHG == -5,
+ df$previous <- list( |
|
| 1009 | +697 | 3x |
- "Worsened by five levels", dataset$CHGCAT1+ c("QS02826", "QS02827"),
|
|
| 1010 | -+ | |||
| 698 | +3x |
- )+ c("QS02811"),
|
||
| 1011 | +699 | 3x |
- dataset$CHGCAT1 <- ifelse(+ c("QS02810", "QS02812", "QS02818"),
|
|
| 1012 | +700 | 3x |
- dataset$PARAMCD %in% c("QS02829", "QS02830") & dataset$CHG == -6,
+ c("QS02806", "QS02807"),
|
|
| 1013 | +701 | 3x |
- "Worsened by six levels", dataset$CHGCAT1+ c("QS02814", "QS02815"),
|
|
| 1014 | -+ | |||
| 702 | +3x |
- )+ c("QS02808"),
|
||
| 1015 | -+ | |||
| 703 | +3x |
-
+ c("QS02817"),
|
||
| 1016 | +704 | 3x |
- dataset$CHGCAT1 <- ifelse(+ c("QS02816"),
|
|
| 1017 | +705 | 3x |
- dataset$PARAMCD %in% c("QS02802", "QS02806") & dataset$CHG == -3,
+ c("QS02821", "QS02822", "QS02823", "QS02824"),
|
|
| 1018 | +706 | 3x |
- "Improved by three levels", dataset$CHGCAT1+ c("QS02829", "QS02830"),
|
|
| 1019 | -+ | |||
| 707 | +3x |
- )+ c("QS02813"),
|
||
| 1020 | +708 | 3x |
- dataset$CHGCAT1 <- ifelse(+ c("QS02801", "QS02802", "QS02803", "QS02804", "QS02805"),
|
|
| 1021 | +709 | 3x |
- dataset$PARAMCD %in% c("QS02802", "QS02806") & dataset$CHG == -2,
+ c("QS02809", "QS02819"),
|
|
| 1022 | +710 | 3x |
- "Improved by two levels", dataset$CHGCAT1+ c("QS02820", "QS02825"),
+ |
+ |
| 711 | +3x | +
+ c("QS02828")
|
||
| 1023 | +712 |
- )+ ) |
||
| 1024 | +713 | 3x |
- dataset$CHGCAT1 <- ifelse(+ df$newName <- list( |
|
| 1025 | +714 | 3x |
- dataset$PARAMCD %in% c("QS02802", "QS02806") & dataset$CHG == -1,
+ "QS028SF", |
|
| 1026 | +715 | 3x |
- "Improved by one level", dataset$CHGCAT1+ "QS028SL", |
|
| 1027 | -+ | |||
| 716 | +3x |
- )+ "QS028FA", |
||
| 1028 | +717 | 3x |
- dataset$CHGCAT1 <- ifelse(+ "QS028RF2", |
|
| 1029 | +718 | 3x |
- dataset$PARAMCD %in% c("QS02802", "QS02806") & dataset$CHG == 0,
+ "QS028NV", |
|
| 1030 | +719 | 3x |
- "No change", dataset$CHGCAT1+ "QS028DY", |
|
| 1031 | -+ | |||
| 720 | +3x |
- )+ "QS028DI", |
||
| 1032 | +721 | 3x |
- dataset$CHGCAT1 <- ifelse(+ "QS028CO", |
|
| 1033 | +722 | 3x |
- dataset$PARAMCD %in% c("QS02802", "QS02806") & dataset$CHG == 1,
+ "QS028EF", |
|
| 1034 | +723 | 3x |
- "Worsened by one level", dataset$CHGCAT1+ "QS028QL2", |
|
| 1035 | -+ | |||
| 724 | +3x |
- )+ "QS028AP", |
||
| 1036 | +725 | 3x |
- dataset$CHGCAT1 <- ifelse(+ "QS028PF2", |
|
| 1037 | +726 | 3x |
- dataset$PARAMCD %in% c("QS02802", "QS02806") & dataset$CHG == 2,
+ "QS028PA", |
|
| 1038 | +727 | 3x |
- "Worsened by two levels", dataset$CHGCAT1+ "QS028CF",+ |
+ |
| 728 | +3x | +
+ "QS028FI" |
||
| 1039 | +729 |
- )+ ) |
||
| 1040 | +730 | 3x |
- dataset$CHGCAT1 <- ifelse(+ df$newNamelabel <- list( |
|
| 1041 | +731 | 3x |
- dataset$PARAMCD %in% c("QS02802", "QS02806") & dataset$CHG == 3,
+ "EORTC QLQ-C30: Social functioning", |
|
| 1042 | +732 | 3x |
- "Worsened by three levels", dataset$CHGCAT1+ "EORTC QLQ-C30: Insomnia", |
|
| 1043 | -+ | |||
| 733 | +3x |
- )+ "EORTC QLQ-C30: Fatigue", |
||
| 1044 | -+ | |||
| 734 | +3x |
-
+ "EORTC QLQ-C30: Role functioning (revised)", |
||
| 1045 | +735 | 3x |
- dataset$CHGCAT1 <- ifelse(+ "EORTC QLQ-C30: Nausea and vomiting", |
|
| 1046 | +736 | 3x |
- dataset$PARAMCD == "QS02801" & dataset$CHG == -3,+ "EORTC QLQ-C30: Dyspnoea", |
|
| 1047 | +737 | 3x |
- "Improved by three levels", dataset$CHGCAT1+ "EORTC QLQ-C30: Diarrhoea", |
|
| 1048 | -+ | |||
| 738 | +3x |
- )+ "EORTC QLQ-C30: Constipation", |
||
| 1049 | +739 | 3x |
- dataset$CHGCAT1 <- ifelse(+ "EORTC QLQ-C30: Emotional functioning", |
|
| 1050 | +740 | 3x |
- dataset$PARAMCD == "QS02801" & dataset$CHG == -2,+ "EORTC QLQ-C30: Global health status/QoL (revised)", |
|
| 1051 | +741 | 3x |
- "Improved by two levels", dataset$CHGCAT1+ "EORTC QLQ-C30: Appetite loss", |
|
| 1052 | -+ | |||
| 742 | +3x |
- )+ "EORTC QLQ-C30: Physical functioning (revised)", |
||
| 1053 | +743 | 3x |
- dataset$CHGCAT1 <- ifelse(+ "EORTC QLQ-C30: Pain", |
|
| 1054 | +744 | 3x |
- dataset$PARAMCD == "QS02801" & dataset$CHG == -1,+ "EORTC QLQ-C30: Cognitive functioning", |
|
| 1055 | +745 | 3x |
- "Improved by one level", dataset$CHGCAT1+ "EORTC QLQ-C30: Financial difficulties" |
|
| 1056 | +746 |
- )+ ) |
||
| 1057 | +747 | 3x |
- dataset$CHGCAT1 <- ifelse(+ df$newNameCategory <- list( |
|
| 1058 | +748 | 3x |
- dataset$PARAMCD == "QS02801" & dataset$CHG == 0,+ "Functional Scales", |
|
| 1059 | +749 | 3x |
- "No changed", dataset$CHGCAT1+ "Symptom Scales", |
|
| 1060 | -+ | |||
| 750 | +3x |
- )+ "Symptom Scales", |
||
| 1061 | +751 | 3x |
- dataset$CHGCAT1 <- ifelse(+ "Functional Scales", |
|
| 1062 | +752 | 3x |
- dataset$PARAMCD == "QS02801" & dataset$CHG == 1,+ "Symptom Scales", |
|
| 1063 | +753 | 3x |
- "Worsened by one level", dataset$CHGCAT1+ "Symptom Scales", |
|
| 1064 | -+ | |||
| 754 | +3x |
- )+ "Symptom Scales", |
||
| 1065 | +755 | 3x |
- dataset$CHGCAT1 <- ifelse(+ "Symptom Scales", |
|
| 1066 | +756 | 3x |
- dataset$PARAMCD == "QS02801" & dataset$CHG == 2,+ "Functional Scales", |
|
| 1067 | +757 | 3x |
- "Worsened by two levels", dataset$CHGCAT1+ "Global Health Status", |
|
| 1068 | -+ | |||
| 758 | +3x |
- )+ "Symptom Scales", |
||
| 1069 | +759 | 3x |
- dataset$CHGCAT1 <- ifelse(+ "Functional Scales", |
|
| 1070 | +760 | 3x |
- dataset$PARAMCD == "QS02801" & dataset$CHG == 3,+ "Symptom Scales", |
|
| 1071 | +761 | 3x |
- "Worsened by three levels", dataset$CHGCAT1+ "Functional Scales", |
|
| 1072 | -+ | |||
| 762 | +3x |
- )+ "Symptom Scales" |
||
| 1073 | +763 |
-
+ ) |
||
| 1074 | +764 | 3x |
- paramcd_vec <- c(+ df$num_param <- list( |
|
| 1075 | +765 | 3x |
- "QS02803", "QS02804", "QS02805", "QS02807", "QS02808", "QS02809", "QS02810",+ "1", |
|
| 1076 | +766 | 3x |
- "QS02811", "QS02812", "QS02813", "QS02814", "QS02815", "QS02816", "QS02817",+ "1", |
|
| 1077 | +767 | 3x |
- "QS02818", "QS02819", "QS02820", "QS02821", "QS02822", "QS02823", "QS02824",+ "2", |
|
| 1078 | +768 | 3x |
- "QS02825", "QS02826", "QS02827", "QS02828"- |
- |
| 1079 | -- |
- )- |
- ||
| 1080 | -- |
-
+ "1", |
||
| 1081 | +769 | 3x |
- dataset$CHGCAT1 <- ifelse(+ "1", |
|
| 1082 | +770 | 3x |
- dataset$PARAMCD %in% paramcd_vec & dataset$CHG == -3,+ "1", |
|
| 1083 | +771 | 3x |
- "Improved by three levels", dataset$CHGCAT1+ "1", |
|
| 1084 | -+ | |||
| 772 | +3x |
- )+ "1", |
||
| 1085 | +773 | 3x |
- dataset$CHGCAT1 <- ifelse(+ "2", |
|
| 1086 | +774 | 3x |
- dataset$PARAMCD %in% paramcd_vec & dataset$CHG == -2,+ "1", |
|
| 1087 | +775 | 3x |
- "Improved by two levels", dataset$CHGCAT1+ "1", |
|
| 1088 | -+ | |||
| 776 | +3x |
- )+ "3", |
||
| 1089 | +777 | 3x |
- dataset$CHGCAT1 <- ifelse(+ "1", |
|
| 1090 | +778 | 3x |
- dataset$PARAMCD %in% paramcd_vec & dataset$CHG == -1,+ "1", |
|
| 1091 | +779 | 3x |
- "Improved by one level", dataset$CHGCAT1+ "1" |
|
| 1092 | +780 |
- )+ ) |
||
| 1093 | +781 | 3x |
- dataset$CHGCAT1 <- ifelse(+ df$equation <- list( |
|
| 1094 | +782 | 3x |
- dataset$PARAMCD %in% paramcd_vec & dataset$CHG == 0,+ "new_value = (1 - ((temp_val/var_length)-1)/3)*100.0", |
|
| 1095 | +783 | 3x |
- "No change", dataset$CHGCAT1+ "new_value = ((temp_val/var_length-1)/3)*100.0", |
|
| 1096 | -+ | |||
| 784 | +3x |
- )+ "new_value = ((temp_val/var_length-1)/3)*100.0", |
||
| 1097 | +785 | 3x |
- dataset$CHGCAT1 <- ifelse(+ "new_value = (1 - ((temp_val/var_length)-1)/3)*100.0", |
|
| 1098 | +786 | 3x |
- dataset$PARAMCD %in% paramcd_vec & dataset$CHG == 1,+ "new_value = ((temp_val/var_length-1)/3)*100.0", |
|
| 1099 | +787 | 3x |
- "Worsened by one level", dataset$CHGCAT1+ "new_value = ((temp_val/var_length-1)/3)*100.0", |
|
| 1100 | -+ | |||
| 788 | +3x |
- )+ "new_value = ((temp_val/var_length-1)/3)*100.0", |
||
| 1101 | +789 | 3x |
- dataset$CHGCAT1 <- ifelse(+ "new_value = ((temp_val/var_length-1)/3)*100.0", |
|
| 1102 | +790 | 3x |
- dataset$PARAMCD %in% paramcd_vec & dataset$CHG == 2,+ "new_value = (1 - ((temp_val/var_length)-1)/3)*100.0", |
|
| 1103 | +791 | 3x |
- "Worsened by two levels", dataset$CHGCAT1+ "new_value = ((temp_val/var_length-1)/6)*100.0", |
|
| 1104 | -+ | |||
| 792 | +3x |
- )+ "new_value = ((temp_val/var_length-1)/3)*100.0", |
||
| 1105 | +793 | 3x |
- dataset$CHGCAT1 <- ifelse(+ "new_value = (1 - ((temp_val/var_length)-1)/3)*100.0", |
|
| 1106 | +794 | 3x |
- dataset$PARAMCD %in% paramcd_vec & dataset$CHG == 3,+ "new_value = ((temp_val/var_length-1)/3)*100.0", |
|
| 1107 | +795 | 3x |
- "Worsened by three levels", dataset$CHGCAT1+ "new_value = (1 - ((temp_val/var_length)-1)/3)*100.0",+ |
+ |
| 796 | +3x | +
+ "new_value = ((temp_val/var_length-1)/3)*100.0" |
||
| 1108 | +797 |
- )+ ) |
||
| 1109 | +798 | |||
| 1110 | +799 | 3x |
- return(dataset)+ expect_data <- data.frame( |
|
| 1111 | -+ | |||
| 800 | +3x |
- } else {
+ PARAM = expect$PARAM, |
||
| 1112 | -! | +|||
| 801 | +3x |
- collapse_vars <- paste(check_vars, collapse = ", ")+ PARAMCD = expect$PARAMCD, |
||
| 1113 | -! | +|||
| 802 | +3x |
- stop(sprintf(+ PARCAT2 = expect$PARCAT2, |
||
| 1114 | -! | +|||
| 803 | +3x |
- "%s: one or both variables is/are missing, needed for derivation",+ PARCAT1N = expect$PARCAT1N, |
||
| 1115 | -! | +|||
| 804 | +3x |
- collapse_vars+ AVAL = c(0, 1), |
||
| 1116 | -+ | |||
| 805 | +3x |
- ))+ AVALC = c( |
||
| 1117 | -+ | |||
| 806 | +3x |
- }+ "Not expected to complete questionnaire", |
||
| 1118 | -+ | |||
| 807 | +3x |
- }+ "Expected to complete questionnaire" |
||
| 1119 | +808 |
-
+ ) |
||
| 1120 | +809 |
- #' @describeIn h_adqlqc Completion/Compliance Data Calculation+ ) |
||
| 1121 | +810 |
- #'+ |
||
| 1122 | -+ | |||
| 811 | +3x |
- #' @param dataset (`data.frame`)\cr Dataset.+ df_saved <- data.frame() |
||
| 1123 | +812 |
- #'+ |
||
| 1124 | -+ | |||
| 813 | +3x |
- #' @return `data.frame`+ unique_id <- unique(adqlqc1$USUBJID) |
||
| 1125 | +814 |
- #' @keywords internal+ |
||
| 1126 | -+ | |||
| 815 | +3x |
- comp_derv <- function(dataset, percent, number) {
+ for (id in unique_id) {
|
||
| 1127 | -+ | |||
| 816 | +30x |
- # original items data+ id_data <- adqlqc1[adqlqc1$USUBJID == id, ] |
||
| 1128 | -3x | +817 | +30x |
- orig_data <- filter(+ unique_avisit <- unique(id_data$AVISIT) |
| 1129 | -3x | +818 | +30x |
- dataset,+ for (visit in unique_avisit) {
|
| 1130 | -3x | +819 | +180x |
- PARCAT2 == "Original Items"+ if (is.na(visit)) {
|
| 1131 | -+ | |||
| 820 | +! |
- )+ next |
||
| 1132 | +821 |
- # total number of questionnaires+ } |
||
| 1133 | -3x | +822 | +180x |
- comp_count_all <- select(+ id_data_at_visit <- id_data[id_data$AVISIT == visit, ] |
| 1134 | -3x | +|||
| 823 | +
- orig_data,+ |
|||
| 1135 | -3x | +824 | +180x |
- PARAMCD+ if (any(id_data_at_visit$PARAMCD != "QSALL")) {
|
| 1136 | -+ | |||
| 825 | +177x |
- ) %>%+ for (idx in seq_along(df$index)) {
|
||
| 1137 | -3x | +826 | +2655x |
- distinct() %>%+ previous_names <- df$previous[idx] |
| 1138 | -3x | +827 | +2655x |
- count()+ current_name <- df$newName[idx] |
| 1139 | -3x | +828 | +2655x |
- comp_count_all <- comp_count_all$n+ current_name_label <- df$newNamelabel[idx] |
| 1140 | -+ | |||
| 829 | +2655x |
- # original items data count of questions answered+ current_name_category <- df$newNameCategory[idx] |
||
| 1141 | -3x | +830 | +2655x |
- orig_data_summ <- group_by(+ eqn <- df$equation[idx] |
| 1142 | -3x | +831 | +2655x |
- orig_data,+ temp_val <- 0 |
| 1143 | -3x | +832 | +2655x |
- STUDYID,+ var_length <- 0 |
| 1144 | -3x | +833 | +2655x |
- USUBJID,+ for (param_name in previous_names[[1]]) {
|
| 1145 | -3x | +834 | +5310x |
- PARCAT1,+ if (param_name %in% id_data_at_visit$PARAMCD) { ####
|
| 1146 | -3x | +835 | +5310x |
- AVISIT,+ current_val <- as.numeric(as.character(id_data_at_visit$AVAL[id_data_at_visit$PARAMCD == param_name])) |
| 1147 | -3x | +836 | +5310x |
- AVISITN,+ if (!is.na(current_val)) {
|
| 1148 | -3x | +837 | +5094x |
- ADTM,+ temp_val <- temp_val + current_val ### |
| 1149 | -3x | +838 | +5094x |
- ADY+ var_length <- var_length + 1 |
| 1150 | +839 |
- ) %>%+ } |
||
| 1151 | -3x | +|||
| 840 | +
- summarise(+ } # if |
|||
| 1152 | -3x | +|||
| 841 | +
- comp_count = sum(!is.na(AVAL)),+ } # param_name+ |
+ |||
| 842 | ++ |
+ # eval |
||
| 1153 | -3x | +843 | +2655x |
- comp_count_all = comp_count_all,+ if (var_length >= as.numeric(df$num_param[idx])) {
|
| 1154 | -3x | +844 | +2604x |
- .groups = "drop"+ eval(parse(text = eqn)) ##### |
| 1155 | +845 |
- ) %>%+ } else {
|
||
| 1156 | -3x | +846 | +51x |
- mutate(+ new_value <- NA |
| 1157 | -3x | +|||
| 847 | +
- per_comp = trunc((comp_count / comp_count_all) * 100)+ } |
|||
| 1158 | +848 |
- )+ |
||
| 1159 | -+ | |||
| 849 | +2655x |
- # expected data+ new_data_row <- data.frame( |
||
| 1160 | -3x | +850 | +2655x |
- ex028_data <- filter(+ study = str_extract(id, "[A-Z]+[0-9]+"), |
| 1161 | -3x | +851 | +2655x |
- dataset,+ id, |
| 1162 | -3x | +852 | +2655x |
- PARAMCD == "EX028",+ visit, |
| 1163 | -3x | +853 | +2655x |
- AVAL == 1+ id_data_at_visit$AVISITN[1], |
| 1164 | -+ | |||
| 854 | +2655x |
- ) %>%+ id_data_at_visit$QSDTC[1], |
||
| 1165 | -3x | +855 | +2655x |
- select(+ current_name_category, |
| 1166 | -3x | +856 | +2655x |
- STUDYID,+ current_name_label, |
| 1167 | -3x | +857 | +2655x |
- USUBJID,+ current_name, |
| 1168 | -3x | +858 | +2655x |
- PARCAT1,+ new_value, |
| 1169 | -3x | +859 | +2655x |
- AVISIT,+ NA, |
| 1170 | -3x | +860 | +2655x |
- AVISITN,+ stringsAsFactors = FALSE+ |
+
| 861 | ++ |
+ ) |
||
| 1171 | -3x | +862 | +2655x |
- ADTM,+ colnames(new_data_row) <- c( |
| 1172 | -3x | +863 | +2655x |
- ADY,+ "STUDYID", "USUBJID", "AVISIT", "AVISITN", |
| 1173 | -3x | +864 | +2655x |
- AVAL_ex028 = AVAL+ "ADTM", "PARCAT2", "PARAM", "PARAMCD",+ |
+
| 865 | +2655x | +
+ "AVAL", "AVALC" |
||
| 1174 | +866 |
- ) %>%+ ) ### |
||
| 1175 | -3x | +867 | +2655x |
- mutate(+ df_saved <- rbind(df_saved, new_data_row) ##### |
| 1176 | -3x | +|||
| 868 | +
- comp_count_all = comp_count_all+ } # idx |
|||
| 1177 | +869 |
- )+ } |
||
| 1178 | +870 |
-
+ # add expect data |
||
| 1179 | -3x | +871 | +180x |
- joined <- left_join(+ expect_value <- sample(expect_data$AVAL, 1, prob = c(0.10, 0.90)) |
| 1180 | -3x | +872 | +180x |
- ex028_data,+ expect_valuec <- expect_data$AVALC[expect_data$AVAL == expect_value]+ |
+
| 873 | ++ | + | ||
| 1181 | -3x | +874 | +180x |
- orig_data_summ,+ new_data_row <- data.frame( |
| 1182 | -3x | +875 | +180x |
- by = c(+ study = str_extract(id, "[A-Z]+[0-9]+"), |
| 1183 | -3x | +876 | +180x |
- "STUDYID",+ id, |
| 1184 | -3x | +877 | +180x |
- "USUBJID",+ visit, |
| 1185 | -3x | +878 | +180x |
- "PARCAT1",+ id_data_at_visit$AVISITN[1], |
| 1186 | -3x | +879 | +180x |
- "AVISIT",+ datetime = NA, |
| 1187 | -3x | +880 | +180x |
- "AVISITN",+ expect_data$PARCAT2[1], |
| 1188 | -3x | +881 | +180x |
- "comp_count_all"+ expect_data$PARAM[1], |
| 1189 | -+ | |||
| 882 | +180x |
- )+ expect_data$PARAMCD[1], |
||
| 1190 | -+ | |||
| 883 | +180x |
- ) %>%+ expect_value, |
||
| 1191 | -3x | +884 | +180x |
- select(-c("ADTM.x", "ADY.x"))
+ expect_valuec,+ |
+
| 885 | +180x | +
+ stringsAsFactors = FALSE |
||
| 1192 | +886 |
-
+ ) |
||
| 1193 | -3x | +887 | +180x |
- joined <- rename(+ colnames(new_data_row) <- c( |
| 1194 | -3x | +888 | +180x |
- joined,+ "STUDYID", "USUBJID", "AVISIT", "AVISITN", |
| 1195 | -3x | +889 | +180x |
- ADTM = ADTM.y,+ "ADTM", "PARCAT2", "PARAM", "PARAMCD", "AVAL", |
| 1196 | -3x | +890 | +180x |
- ADY = ADY.y+ "AVALC" |
| 1197 | +891 |
- )+ ) ###+ |
+ ||
| 892 | +180x | +
+ df_saved <- rbind(df_saved, new_data_row) |
||
| 1198 | +893 |
- # CO028ALL+ } # visit |
||
| 1199 | -3x | +|||
| 894 | +
- co028all <- mutate(+ } # id+ |
+ |||
| 895 | ++ | + | ||
| 1200 | +896 | 3x |
- joined,+ df_saved1 <- left_join( |
|
| 1201 | +897 | 3x |
- PARAMCD = "CO028ALL",+ df_saved, |
|
| 1202 | +898 | 3x |
- PARAM = "EORTC QLQ-C30: Completion - Completed all questions",+ ghs_scales, |
|
| 1203 | +899 | 3x |
- PARCAT2 = "Completion",+ by = c( |
|
| 1204 | +900 | 3x |
- AVAL = case_when(+ "PARAM", |
|
| 1205 | +901 | 3x |
- AVAL_ex028 == 1 & comp_count == comp_count_all ~ 1,+ "PARAMCD", |
|
| 1206 | +902 | 3x |
- AVAL_ex028 == 1 & (is.na(comp_count) | comp_count < comp_count_all) ~ 0+ "PARCAT2" |
|
| 1207 | +903 |
- ),+ )+ |
+ ||
| 904 | ++ |
+ ) %>% |
||
| 1208 | +905 | 3x |
- AVALC = case_when(+ mutate( |
|
| 1209 | +906 | 3x |
- AVAL == 1 ~ "Completed all questions",+ AVALC = ifelse(is.na(AVALC), as.character(AVAL), AVALC), |
|
| 1210 | +907 | 3x |
- AVAL == 0 ~ "Did not complete all questions"+ PARCAT1 = ifelse(PARAMCD == "EX028", expect$PARCAT1, PARCAT1), |
|
| 1211 | -+ | |||
| 908 | +3x |
- )+ PARCAT1N = ifelse(PARAMCD == "EX028", expect$PARCAT1N, PARCAT1N) |
||
| 1212 | +909 |
- )+ ) |
||
| 1213 | +910 |
- # CO028<y>P+ |
||
| 1214 | +911 | 3x |
- co028p <- mutate(+ adqlqc_tmp <- bind_rows(adqlqc1, df_saved1) %>% |
|
| 1215 | +912 | 3x |
- joined,+ arrange( |
|
| 1216 | +913 | 3x |
- PARAMCD = paste0("CO028", as.character(percent), "P"),
+ USUBJID, |
|
| 1217 | +914 | 3x |
- PARAM = sprintf(+ AVISITN, |
|
| 1218 | +915 | 3x |
- "EORTC QLQ-C30: Completion - Completed at least %s%% of questions",+ QSTESTCD+ |
+ |
| 916 | ++ |
+ ) |
||
| 1219 | +917 | 3x |
- as.character(percent)+ return(adqlqc_tmp) |
|
| 1220 | +918 |
- ),+ } |
||
| 1221 | -3x | +|||
| 919 | +
- PARCAT2 = "Completion",+ |
|||
| 1222 | -3x | +|||
| 920 | +
- AVAL = case_when(+ #' @describeIn h_adqlqc Calculate Change from Baseline Category 1 |
|||
| 1223 | -3x | +|||
| 921 | +
- AVAL_ex028 == 1 & per_comp >= percent ~ 1,+ #' |
|||
| 1224 | -3x | +|||
| 922 | +
- AVAL_ex028 == 1 & (is.na(per_comp) | per_comp < percent) ~ 0+ #' @param dataset (`data.frame`)\cr ADaM dataset. |
|||
| 1225 | +923 |
- ),+ #' |
||
| 1226 | -3x | +|||
| 924 | +
- AVALC = case_when(+ #' @return `data.frame` |
|||
| 1227 | -3x | +|||
| 925 | +
- AVAL == 1 ~ sprintf(+ #' @keywords internal |
|||
| 1228 | -3x | +|||
| 926 | +
- "Completed at least %s%% of questions",+ derv_chgcat1 <- function(dataset) {
+ |
+ |||
| 927 | ++ |
+ # derivation of CHGCAT1 |
||
| 1229 | +928 | 3x |
- as.character(percent)+ check_vars <- c("PARCAT2", "CHG")
|
|
| 1230 | +929 |
- ),+ |
||
| 1231 | +930 | 3x |
- AVAL == 0 ~ sprintf(+ if (all(check_vars %in% names(dataset))) {
|
|
| 1232 | +931 | 3x |
- "Did not complete at least %s%% of questions",+ dataset$CHGCAT1 <- ifelse( |
|
| 1233 | +932 | 3x |
- as.character(percent)+ dataset$PARCAT2 == "Symptom Scales" & !is.na(dataset$CHG) & dataset$CHG <= -10, |
|
| 1234 | -+ | |||
| 933 | +3x |
- )+ "Improved", "" |
||
| 1235 | +934 |
) |
||
| 1236 | -+ | |||
| 935 | +3x |
- )+ dataset$CHGCAT1 <- ifelse( |
||
| 1237 | -+ | |||
| 936 | +3x |
- # CO028<x>Q+ dataset$PARCAT2 == "Symptom Scales" & !is.na(dataset$CHG) & dataset$CHG >= 10, |
||
| 1238 | +937 | 3x |
- co028q <- mutate(+ "Worsened", dataset$CHGCAT1+ |
+ |
| 938 | ++ |
+ ) |
||
| 1239 | +939 | 3x |
- joined,+ dataset$CHGCAT1 <- ifelse( |
|
| 1240 | +940 | 3x |
- PARAMCD = paste0("CO028", as.character(number), "Q"),
+ dataset$PARCAT2 == "Symptom Scales" & |
|
| 1241 | +941 | 3x |
- PARAM = sprintf(+ !is.na(dataset$CHG) & dataset$CHG > -10 & |
|
| 1242 | +942 | 3x |
- "EORTC QLQ-C30: Completion - Completed at least %s question(s)",+ dataset$CHG < 10, |
|
| 1243 | +943 | 3x |
- as.character(number)+ "No change", dataset$CHGCAT1 |
|
| 1244 | +944 |
- ),+ )+ |
+ ||
| 945 | ++ | + | ||
| 1245 | +946 | 3x |
- PARCAT2 = "Completion",+ dataset$CHGCAT1 <- ifelse( |
|
| 1246 | +947 | 3x |
- AVAL = case_when(+ dataset$PARCAT2 %in% c("Functional Scales", "Global Health Status") &
|
|
| 1247 | +948 | 3x |
- AVAL_ex028 == 1 & comp_count >= number ~ 1,+ !is.na(dataset$CHG) & dataset$CHG >= 10, |
|
| 1248 | +949 | 3x |
- AVAL_ex028 == 1 & (comp_count < number | is.na(comp_count)) ~ 0+ "Improved", dataset$CHGCAT1 |
|
| 1249 | +950 |
- ),+ ) |
||
| 1250 | +951 | 3x |
- AVALC = case_when(+ dataset$CHGCAT1 <- ifelse( |
|
| 1251 | +952 | 3x |
- AVAL == 1 ~ sprintf(+ dataset$PARCAT2 %in% c("Functional Scales", "Global Health Status") &
|
|
| 1252 | +953 | 3x |
- "Completed at least %s questions",+ !is.na(dataset$CHG) & dataset$CHG <= -10, |
|
| 1253 | +954 | 3x |
- as.character(number)+ "Worsened", dataset$CHGCAT1 |
|
| 1254 | +955 |
- ),+ ) |
||
| 1255 | +956 | 3x |
- AVAL == 0 ~ sprintf(+ dataset$CHGCAT1 <- ifelse( |
|
| 1256 | +957 | 3x |
- "Did not complete at least %s question(s)",+ dataset$PARCAT2 %in% c("Functional Scales", "Global Health Status") &
|
|
| 1257 | +958 | 3x |
- as.character(number)+ !is.na(dataset$CHG) & |
|
| 1258 | -+ | |||
| 959 | +3x |
- )+ dataset$CHG > -10 & dataset$CHG < 10, |
||
| 1259 | -+ | |||
| 960 | +3x |
- )+ "No change", dataset$CHGCAT1 |
||
| 1260 | +961 |
- )+ ) |
||
| 1261 | +962 | |||
| 1262 | +963 | 3x |
- co028_bind <- rbind(+ dataset$CHGCAT1 <- ifelse( |
|
| 1263 | +964 | 3x |
- co028all,+ dataset$PARAMCD %in% c("QS02829", "QS02830") & dataset$CHG == 6,
|
|
| 1264 | +965 | 3x |
- co028p,+ "Improved by six levels", dataset$CHGCAT1 |
|
| 1265 | -3x | +|||
| 966 | +
- co028q+ ) |
|||
| 1266 | -+ | |||
| 967 | +3x |
- ) %>%+ dataset$CHGCAT1 <- ifelse( |
||
| 1267 | +968 | 3x |
- select(+ dataset$PARAMCD %in% c("QS02829", "QS02830") & dataset$CHG == 5,
|
|
| 1268 | +969 | 3x |
- -c("AVAL_ex028", "comp_count", "comp_count_all", "per_comp")
+ "Improved by five levels", dataset$CHGCAT1 |
|
| 1269 | +970 |
) |
||
| 1270 | +971 | 3x |
- return(co028_bind)+ dataset$CHGCAT1 <- ifelse( |
|
| 1271 | -+ | |||
| 972 | +3x |
- }+ dataset$PARAMCD %in% c("QS02829", "QS02830") & dataset$CHG == 4,
|
| 1 | -+ | |||
| 973 | +3x |
- #' Exposure Analysis Dataset (ADEX)+ "Improved by four levels", dataset$CHGCAT1 |
||
| 2 | +974 |
- #'+ ) |
||
| 3 | -+ | |||
| 975 | +3x |
- #' @description `r lifecycle::badge("stable")`
+ dataset$CHGCAT1 <- ifelse( |
||
| 4 | -+ | |||
| 976 | +3x |
- #'+ dataset$PARAMCD %in% c("QS02829", "QS02830") & dataset$CHG == 3,
|
||
| 5 | -+ | |||
| 977 | +3x |
- #' Function for generating random Exposure Analysis Dataset for a given+ "Improved by three levels", dataset$CHGCAT1 |
||
| 6 | +978 |
- #' Subject-Level Analysis Dataset.+ ) |
||
| 7 | -+ | |||
| 979 | +3x |
- #'+ dataset$CHGCAT1 <- ifelse( |
||
| 8 | -+ | |||
| 980 | +3x |
- #' @details One record per each record in the corresponding SDTM domain.+ dataset$PARAMCD %in% c("QS02829", "QS02830") & dataset$CHG == 2,
|
||
| 9 | -+ | |||
| 981 | +3x |
- #'+ "Improved by two levels", dataset$CHGCAT1 |
||
| 10 | +982 |
- #' Keys: `STUDYID`, `USUBJID`, `EXSEQ`, `PARAMCD`, `PARCAT1`, `ASTDTM`, `AENDTM`, `ASTDY`, `AENDY`,+ ) |
||
| 11 | -+ | |||
| 983 | +3x |
- #' `AVISITN`, `EXDOSFRQ`, `EXROUTE`, `VISIT`, `VISITDY`, `EXSTDTC`, `EXENDTC`, `EXSTDY`, `EXENDY`+ dataset$CHGCAT1 <- ifelse( |
||
| 12 | -+ | |||
| 984 | +3x |
- #'+ dataset$PARAMCD %in% c("QS02829", "QS02830") & dataset$CHG == 1,
|
||
| 13 | -+ | |||
| 985 | +3x |
- #' @inheritParams argument_convention+ "Improved by one level", dataset$CHGCAT1 |
||
| 14 | +986 |
- #' @param parcat1 (`character vector`)\cr Dose amount categories. Defaults to "Individual" and "Overall".+ ) |
||
| 15 | -+ | |||
| 987 | +3x |
- #' @param parcat2 (`character vector`)\cr Types of drug received. Defaults to "Drug A" and "Drug B".+ dataset$CHGCAT1 <- ifelse( |
||
| 16 | -+ | |||
| 988 | +3x |
- #' @param max_n_exs (`integer`)\cr Maximum number of exposures per patient. Defaults to 6.+ dataset$PARAMCD %in% c("QS02829", "QS02830") & dataset$CHG == 0,
|
||
| 17 | -+ | |||
| 989 | +3x |
- #' @template param_cached+ "No change", dataset$CHGCAT1 |
||
| 18 | +990 |
- #' @templateVar data adex+ ) |
||
| 19 | -+ | |||
| 991 | +3x |
- #'+ dataset$CHGCAT1 <- ifelse( |
||
| 20 | -+ | |||
| 992 | +3x |
- #' @return `data.frame`+ dataset$PARAMCD %in% c("QS02829", "QS02830") & dataset$CHG == -1,
|
||
| 21 | -+ | |||
| 993 | +3x |
- #' @export+ "Worsened by one level", dataset$CHGCAT1 |
||
| 22 | +994 |
- #'+ ) |
||
| 23 | -+ | |||
| 995 | +3x |
- #' @examples+ dataset$CHGCAT1 <- ifelse( |
||
| 24 | -+ | |||
| 996 | +3x |
- #' adsl <- radsl(N = 10, study_duration = 2, seed = 1)+ dataset$PARAMCD %in% c("QS02829", "QS02830") & dataset$CHG == -2,
|
||
| 25 | -+ | |||
| 997 | +3x |
- #'+ "Worsened by two levels", dataset$CHGCAT1 |
||
| 26 | +998 |
- #' adex <- radex(adsl, seed = 2)+ ) |
||
| 27 | -+ | |||
| 999 | +3x |
- #' adex+ dataset$CHGCAT1 <- ifelse( |
||
| 28 | -+ | |||
| 1000 | +3x |
- radex <- function(adsl,+ dataset$PARAMCD %in% c("QS02829", "QS02830") & dataset$CHG == -3,
|
||
| 29 | -+ | |||
| 1001 | +3x |
- param = c(+ "Worsened by three levels", dataset$CHGCAT1 |
||
| 30 | +1002 |
- "Dose administered during constant dosing interval",+ ) |
||
| 31 | -+ | |||
| 1003 | +3x |
- "Number of doses administered during constant dosing interval",+ dataset$CHGCAT1 <- ifelse( |
||
| 32 | -+ | |||
| 1004 | +3x |
- "Total dose administered",+ dataset$PARAMCD %in% c("QS02829", "QS02830") & dataset$CHG == -4,
|
||
| 33 | -+ | |||
| 1005 | +3x |
- "Total number of doses administered"+ "Worsened by four levels", dataset$CHGCAT1 |
||
| 34 | +1006 |
- ),+ ) |
||
| 35 | -+ | |||
| 1007 | +3x |
- paramcd = c("DOSE", "NDOSE", "TDOSE", "TNDOSE"),
+ dataset$CHGCAT1 <- ifelse( |
||
| 36 | -+ | |||
| 1008 | +3x |
- paramu = c("mg", " ", "mg", " "),
+ dataset$PARAMCD %in% c("QS02829", "QS02830") & dataset$CHG == -5,
|
||
| 37 | -+ | |||
| 1009 | +3x |
- parcat1 = c("INDIVIDUAL", "OVERALL"),
+ "Worsened by five levels", dataset$CHGCAT1 |
||
| 38 | +1010 |
- parcat2 = c("Drug A", "Drug B"),
+ ) |
||
| 39 | -+ | |||
| 1011 | +3x |
- visit_format = "WEEK",+ dataset$CHGCAT1 <- ifelse( |
||
| 40 | -+ | |||
| 1012 | +3x |
- n_assessments = 5L,+ dataset$PARAMCD %in% c("QS02829", "QS02830") & dataset$CHG == -6,
|
||
| 41 | -+ | |||
| 1013 | +3x |
- n_days = 5L,+ "Worsened by six levels", dataset$CHGCAT1 |
||
| 42 | +1014 |
- max_n_exs = 6L,+ ) |
||
| 43 | +1015 |
- lookup = NULL,+ |
||
| 44 | -+ | |||
| 1016 | +3x |
- seed = NULL,+ dataset$CHGCAT1 <- ifelse( |
||
| 45 | -+ | |||
| 1017 | +3x |
- na_percentage = 0,+ dataset$PARAMCD %in% c("QS02802", "QS02806") & dataset$CHG == -3,
|
||
| 46 | -+ | |||
| 1018 | +3x |
- na_vars = list(AVAL = c(NA, 0.1), AVALU = c(NA), 0.1),+ "Improved by three levels", dataset$CHGCAT1 |
||
| 47 | +1019 |
- cached = FALSE) {
+ ) |
||
| 48 | -4x | +1020 | +3x |
- checkmate::assert_flag(cached)+ dataset$CHGCAT1 <- ifelse( |
| 49 | -4x | +1021 | +3x |
- if (cached) {
+ dataset$PARAMCD %in% c("QS02802", "QS02806") & dataset$CHG == -2,
|
| 50 | -1x | +1022 | +3x |
- return(get_cached_data("cadex"))
+ "Improved by two levels", dataset$CHGCAT1 |
| 51 | +1023 |
- }+ ) |
||
| 52 | -+ | |||
| 1024 | +3x |
-
+ dataset$CHGCAT1 <- ifelse( |
||
| 53 | +1025 | 3x |
- checkmate::assert_data_frame(adsl)+ dataset$PARAMCD %in% c("QS02802", "QS02806") & dataset$CHG == -1,
|
|
| 54 | +1026 | 3x |
- checkmate::assert_character(param, min.len = 1, any.missing = FALSE)+ "Improved by one level", dataset$CHGCAT1 |
|
| 55 | -3x | +|||
| 1027 | +
- checkmate::assert_character(paramcd, min.len = 1, any.missing = FALSE)+ ) |
|||
| 56 | +1028 | 3x |
- checkmate::assert_character(parcat1, min.len = 1, any.missing = FALSE)+ dataset$CHGCAT1 <- ifelse( |
|
| 57 | +1029 | 3x |
- checkmate::assert_character(parcat2, min.len = 1, any.missing = FALSE)+ dataset$PARAMCD %in% c("QS02802", "QS02806") & dataset$CHG == 0,
|
|
| 58 | +1030 | 3x |
- checkmate::assert_string(visit_format)+ "No change", dataset$CHGCAT1 |
|
| 59 | -3x | +|||
| 1031 | +
- checkmate::assert_integer(n_assessments, len = 1, any.missing = FALSE)+ ) |
|||
| 60 | +1032 | 3x |
- checkmate::assert_integer(n_days, len = 1, any.missing = FALSE)+ dataset$CHGCAT1 <- ifelse( |
|
| 61 | +1033 | 3x |
- checkmate::assert_integer(max_n_exs, len = 1, any.missing = FALSE)+ dataset$PARAMCD %in% c("QS02802", "QS02806") & dataset$CHG == 1,
|
|
| 62 | +1034 | 3x |
- checkmate::assert_data_frame(lookup, null.ok = TRUE)+ "Worsened by one level", dataset$CHGCAT1+ |
+ |
| 1035 | ++ |
+ ) |
||
| 63 | +1036 | 3x |
- checkmate::assert_number(seed, null.ok = TRUE)+ dataset$CHGCAT1 <- ifelse( |
|
| 64 | +1037 | 3x |
- checkmate::assert_number(na_percentage, lower = 0, upper = 1)+ dataset$PARAMCD %in% c("QS02802", "QS02806") & dataset$CHG == 2,
|
|
| 65 | +1038 | 3x |
- checkmate::assert_true(na_percentage < 1)+ "Worsened by two levels", dataset$CHGCAT1 |
|
| 66 | +1039 |
-
+ ) |
||
| 67 | -+ | |||
| 1040 | +3x |
- # validate and initialize related variables+ dataset$CHGCAT1 <- ifelse( |
||
| 68 | +1041 | 3x |
- param_init_list <- relvar_init(param, paramcd)+ dataset$PARAMCD %in% c("QS02802", "QS02806") & dataset$CHG == 3,
|
|
| 69 | +1042 | 3x |
- unit_init_list <- relvar_init(param, paramu)+ "Worsened by three levels", dataset$CHGCAT1 |
|
| 70 | +1043 |
-
+ ) |
||
| 71 | -3x | +|||
| 1044 | +
- if (!is.null(seed)) {
+
|
|||
| 72 | +1045 | 3x |
- set.seed(seed)+ dataset$CHGCAT1 <- ifelse( |
|
| 73 | -+ | |||
| 1046 | +3x |
- }+ dataset$PARAMCD == "QS02801" & dataset$CHG == -3, |
||
| 74 | +1047 | 3x |
- study_duration_secs <- lubridate::seconds(attr(adsl, "study_duration_secs"))+ "Improved by three levels", dataset$CHGCAT1 |
|
| 75 | +1048 |
-
+ ) |
||
| 76 | +1049 | 3x |
- adex <- expand.grid(+ dataset$CHGCAT1 <- ifelse( |
|
| 77 | +1050 | 3x |
- STUDYID = unique(adsl$STUDYID),+ dataset$PARAMCD == "QS02801" & dataset$CHG == -2, |
|
| 78 | +1051 | 3x |
- USUBJID = adsl$USUBJID,+ "Improved by two levels", dataset$CHGCAT1 |
|
| 79 | -3x | +|||
| 1052 | +
- PARAM = c(+ ) |
|||
| 80 | +1053 | 3x |
- rep(+ dataset$CHGCAT1 <- ifelse( |
|
| 81 | +1054 | 3x |
- param_init_list$relvar1[1],+ dataset$PARAMCD == "QS02801" & dataset$CHG == -1, |
|
| 82 | +1055 | 3x |
- length(levels(visit_schedule(visit_format = visit_format, n_assessments = n_assessments, n_days = n_days)))+ "Improved by one level", dataset$CHGCAT1 |
|
| 83 | +1056 |
- ),+ ) |
||
| 84 | +1057 | 3x |
- rep(+ dataset$CHGCAT1 <- ifelse( |
|
| 85 | +1058 | 3x |
- param_init_list$relvar1[2],+ dataset$PARAMCD == "QS02801" & dataset$CHG == 0, |
|
| 86 | +1059 | 3x |
- length(levels(visit_schedule(visit_format = visit_format, n_assessments = n_assessments, n_days = n_days)))+ "No changed", dataset$CHGCAT1 |
|
| 87 | +1060 |
- ),+ ) |
||
| 88 | +1061 | 3x |
- param_init_list$relvar1[3:4]+ dataset$CHGCAT1 <- ifelse( |
|
| 89 | -+ | |||
| 1062 | +3x |
- ),+ dataset$PARAMCD == "QS02801" & dataset$CHG == 1, |
||
| 90 | +1063 | 3x |
- stringsAsFactors = FALSE+ "Worsened by one level", dataset$CHGCAT1 |
|
| 91 | +1064 |
- )+ ) |
||
| 92 | -+ | |||
| 1065 | +3x |
-
+ dataset$CHGCAT1 <- ifelse( |
||
| 93 | -+ | |||
| 1066 | +3x |
- # assign related variable values: PARAMxPARAMCD are related+ dataset$PARAMCD == "QS02801" & dataset$CHG == 2, |
||
| 94 | +1067 | 3x |
- adex <- adex %>% rel_var(+ "Worsened by two levels", dataset$CHGCAT1+ |
+ |
| 1068 | ++ |
+ ) |
||
| 95 | +1069 | 3x |
- var_name = "PARAMCD",+ dataset$CHGCAT1 <- ifelse( |
|
| 96 | +1070 | 3x |
- related_var = "PARAM",+ dataset$PARAMCD == "QS02801" & dataset$CHG == 3, |
|
| 97 | +1071 | 3x |
- var_values = param_init_list$relvar2+ "Worsened by three levels", dataset$CHGCAT1 |
|
| 98 | +1072 |
- )+ ) |
||
| 99 | +1073 | |||
| 100 | -+ | |||
| 1074 | +3x |
- # assign related variable values: AVALUxPARAM are related+ paramcd_vec <- c( |
||
| 101 | +1075 | 3x |
- adex <- adex %>% rel_var(+ "QS02803", "QS02804", "QS02805", "QS02807", "QS02808", "QS02809", "QS02810", |
|
| 102 | +1076 | 3x |
- var_name = "AVALU",+ "QS02811", "QS02812", "QS02813", "QS02814", "QS02815", "QS02816", "QS02817", |
|
| 103 | +1077 | 3x |
- related_var = "PARAM",+ "QS02818", "QS02819", "QS02820", "QS02821", "QS02822", "QS02823", "QS02824", |
|
| 104 | +1078 | 3x |
- var_values = unit_init_list$relvar2+ "QS02825", "QS02826", "QS02827", "QS02828" |
|
| 105 | +1079 |
- )+ ) |
||
| 106 | +1080 | |||
| 107 | +1081 | 3x |
- adex <- adex %>%+ dataset$CHGCAT1 <- ifelse( |
|
| 108 | +1082 | 3x |
- dplyr::group_by(USUBJID) %>%+ dataset$PARAMCD %in% paramcd_vec & dataset$CHG == -3, |
|
| 109 | +1083 | 3x |
- dplyr::mutate(PARCAT_ind = sample(c(1, 2), size = 1)) %>%+ "Improved by three levels", dataset$CHGCAT1+ |
+ |
| 1084 | ++ |
+ ) |
||
| 110 | +1085 | 3x |
- dplyr::mutate(PARCAT2 = ifelse(PARCAT_ind == 1, parcat2[1], parcat2[2])) %>%+ dataset$CHGCAT1 <- ifelse( |
|
| 111 | +1086 | 3x |
- dplyr::select(-"PARCAT_ind")+ dataset$PARAMCD %in% paramcd_vec & dataset$CHG == -2, |
|
| 112 | -+ | |||
| 1087 | +3x |
-
+ "Improved by two levels", dataset$CHGCAT1 |
||
| 113 | +1088 |
- # Add in PARCAT1+ ) |
||
| 114 | +1089 | 3x |
- adex <- adex %>% dplyr::mutate(PARCAT1 = dplyr::case_when(+ dataset$CHGCAT1 <- ifelse( |
|
| 115 | +1090 | 3x |
- (PARAMCD == "TNDOSE" | PARAMCD == "TDOSE") ~ "OVERALL",+ dataset$PARAMCD %in% paramcd_vec & dataset$CHG == -1, |
|
| 116 | +1091 | 3x |
- PARAMCD == "DOSE" | PARAMCD == "NDOSE" ~ "INDIVIDUAL"- |
- |
| 117 | -- |
- ))+ "Improved by one level", dataset$CHGCAT1 |
||
| 118 | +1092 | - - | -||
| 119 | -3x | -
- adex_visit <- adex %>%+ ) |
||
| 120 | +1093 | 3x |
- dplyr::filter(PARAMCD == "DOSE" | PARAMCD == "NDOSE") %>%+ dataset$CHGCAT1 <- ifelse( |
|
| 121 | +1094 | 3x |
- dplyr::mutate(+ dataset$PARAMCD %in% paramcd_vec & dataset$CHG == 0, |
|
| 122 | +1095 | 3x |
- AVISIT = rep(visit_schedule(visit_format = visit_format, n_assessments = n_assessments, n_days = n_days), 2)+ "No change", dataset$CHGCAT1 |
|
| 123 | +1096 |
) |
||
| 124 | -- | - - | -||
| 125 | +1097 | 3x |
- adex <- dplyr::left_join(+ dataset$CHGCAT1 <- ifelse( |
|
| 126 | +1098 | 3x |
- adex %>%+ dataset$PARAMCD %in% paramcd_vec & dataset$CHG == 1, |
|
| 127 | +1099 | 3x |
- dplyr::group_by(+ "Worsened by one level", dataset$CHGCAT1 |
|
| 128 | -3x | +|||
| 1100 | +
- USUBJID,+ ) |
|||
| 129 | +1101 | 3x |
- STUDYID,+ dataset$CHGCAT1 <- ifelse( |
|
| 130 | +1102 | 3x |
- PARAM,+ dataset$PARAMCD %in% paramcd_vec & dataset$CHG == 2, |
|
| 131 | +1103 | 3x |
- PARAMCD,+ "Worsened by two levels", dataset$CHGCAT1+ |
+ |
| 1104 | ++ |
+ ) |
||
| 132 | +1105 | 3x |
- AVALU,+ dataset$CHGCAT1 <- ifelse( |
|
| 133 | +1106 | 3x |
- PARCAT1,+ dataset$PARAMCD %in% paramcd_vec & dataset$CHG == 3, |
|
| 134 | +1107 | 3x |
- PARCAT2+ "Worsened by three levels", dataset$CHGCAT1 |
|
| 135 | +1108 |
- ) %>%+ ) |
||
| 136 | -3x | +|||
| 1109 | +
- dplyr::mutate(id = dplyr::row_number()),+ |
|||
| 137 | +1110 | 3x |
- adex_visit %>%+ return(dataset) |
|
| 138 | -3x | +|||
| 1111 | +
- dplyr::group_by(+ } else {
|
|||
| 139 | -3x | +|||
| 1112 | +! |
- USUBJID,+ collapse_vars <- paste(check_vars, collapse = ", ") |
||
| 140 | -3x | +|||
| 1113 | +! |
- STUDYID,+ stop(sprintf( |
||
| 141 | -3x | +|||
| 1114 | +! |
- PARAM,+ "%s: one or both variables is/are missing, needed for derivation", |
||
| 142 | -3x | +|||
| 1115 | +! |
- PARAMCD,+ collapse_vars |
||
| 143 | -3x | +|||
| 1116 | +
- AVALU,+ )) |
|||
| 144 | -3x | +|||
| 1117 | +
- PARCAT1,+ } |
|||
| 145 | -3x | +|||
| 1118 | +
- PARCAT2+ } |
|||
| 146 | +1119 |
- ) %>%+ |
||
| 147 | -3x | +|||
| 1120 | +
- dplyr::mutate(id = dplyr::row_number()),+ #' @describeIn h_adqlqc Completion/Compliance Data Calculation |
|||
| 148 | -3x | +|||
| 1121 | +
- by = c("USUBJID", "STUDYID", "PARCAT1", "PARCAT2", "id", "PARAMCD", "PARAM", "AVALU")
+ #' |
|||
| 149 | +1122 |
- ) %>%+ #' @param dataset (`data.frame`)\cr Dataset. |
||
| 150 | -3x | +|||
| 1123 | +
- dplyr::select(-"id")+ #' |
|||
| 151 | +1124 |
-
+ #' @return `data.frame` |
||
| 152 | +1125 |
- # Visit numbers+ #' @keywords internal |
||
| 153 | -3x | +|||
| 1126 | +
- adex <- adex %>% dplyr::mutate(AVISITN = dplyr::case_when(+ comp_derv <- function(dataset, percent, number) {
|
|||
| 154 | -3x | +|||
| 1127 | +
- AVISIT == "SCREENING" ~ -1,+ # original items data |
|||
| 155 | +1128 | 3x |
- AVISIT == "BASELINE" ~ 0,+ orig_data <- filter( |
|
| 156 | +1129 | 3x |
- (grepl("^WEEK", AVISIT) | grepl("^CYCLE", AVISIT)) ~ as.numeric(AVISIT) - 2,
+ dataset, |
|
| 157 | +1130 | 3x |
- TRUE ~ 999000- |
- |
| 158 | -- |
- ))+ PARCAT2 == "Original Items" |
||
| 159 | +1131 |
-
+ ) |
||
| 160 | +1132 |
-
+ # total number of questionnaires |
||
| 161 | +1133 | 3x |
- adex2 <- split(adex, adex$USUBJID) %>%+ comp_count_all <- select( |
|
| 162 | +1134 | 3x |
- lapply(function(pinfo) {
+ orig_data, |
|
| 163 | -30x | +1135 | +3x |
- pinfo %>%+ PARAMCD |
| 164 | -30x | +|||
| 1136 | +
- dplyr::filter(PARAMCD == "DOSE") %>%+ ) %>% |
|||
| 165 | -30x | +1137 | +3x |
- dplyr::group_by(USUBJID, PARCAT2, AVISIT) %>%+ distinct() %>% |
| 166 | -30x | +1138 | +3x |
- dplyr::mutate(changeind = dplyr::case_when(+ count() |
| 167 | -30x | +1139 | +3x |
- AVISIT == "SCREENING" ~ 0,+ comp_count_all <- comp_count_all$n |
| 168 | -30x | +|||
| 1140 | +
- AVISIT != "SCREENING" ~ sample(c(-1, 0, 1),+ # original items data count of questions answered |
|||
| 169 | -30x | +1141 | +3x |
- size = 1,+ orig_data_summ <- group_by( |
| 170 | -30x | +1142 | +3x |
- prob = c(0.25, 0.5, 0.25),+ orig_data, |
| 171 | -30x | +1143 | +3x |
- replace = TRUE+ STUDYID, |
| 172 | -+ | |||
| 1144 | +3x |
- )+ USUBJID, |
||
| 173 | -+ | |||
| 1145 | +3x |
- )) %>%+ PARCAT1, |
||
| 174 | -30x | +1146 | +3x |
- dplyr::ungroup() %>%+ AVISIT, |
| 175 | -30x | +1147 | +3x |
- dplyr::group_by(USUBJID, PARCAT2) %>%+ AVISITN, |
| 176 | -30x | +1148 | +3x |
- dplyr::mutate(+ ADTM, |
| 177 | -30x | +1149 | +3x |
- csum = cumsum(changeind),+ ADY |
| 178 | -30x | +|||
| 1150 | +
- changeind = dplyr::case_when(+ ) %>% |
|||
| 179 | -30x | +1151 | +3x |
- csum <= -3 ~ sample(c(0, 1), size = 1, prob = c(0.5, 0.5)),+ summarise( |
| 180 | -30x | +1152 | +3x |
- csum >= 3 ~ sample(c(0, -1), size = 1, prob = c(0.5, 0.5)),+ comp_count = sum(!is.na(AVAL)), |
| 181 | -30x | +1153 | +3x |
- TRUE ~ changeind+ comp_count_all = comp_count_all, |
| 182 | -+ | |||
| 1154 | +3x |
- )+ .groups = "drop" |
||
| 183 | +1155 |
- ) %>%- |
- ||
| 184 | -30x | -
- dplyr::mutate(csum = cumsum(changeind)) %>%+ ) %>% |
||
| 185 | -30x | +1156 | +3x |
- dplyr::ungroup() %>%+ mutate( |
| 186 | -30x | +1157 | +3x |
- dplyr::group_by(USUBJID, PARCAT2, AVISIT) %>%+ per_comp = trunc((comp_count / comp_count_all) * 100) |
| 187 | -30x | +|||
| 1158 | +
- dplyr::mutate(AVAL = dplyr::case_when(+ ) |
|||
| 188 | -30x | +|||
| 1159 | +
- csum == -2 ~ 480,+ # expected data |
|||
| 189 | -30x | +1160 | +3x |
- csum == -1 ~ 720,+ ex028_data <- filter( |
| 190 | -30x | +1161 | +3x |
- csum == 0 ~ 960,+ dataset, |
| 191 | -30x | +1162 | +3x |
- csum == 1 ~ 1200,+ PARAMCD == "EX028", |
| 192 | -30x | +1163 | +3x |
- csum == 2 ~ 1440+ AVAL == 1 |
| 193 | +1164 |
- )) %>%+ ) %>% |
||
| 194 | -30x | +1165 | +3x |
- dplyr::select(-c("csum", "changeind")) %>%
+ select( |
| 195 | -30x | +1166 | +3x |
- dplyr::ungroup()+ STUDYID, |
| 196 | -+ | |||
| 1167 | +3x |
- }) %>%+ USUBJID, |
||
| 197 | +1168 | 3x |
- Reduce(rbind, .)+ PARCAT1, |
|
| 198 | -+ | |||
| 1169 | +3x |
-
+ AVISIT, |
||
| 199 | +1170 | 3x |
- adex_tmp <- dplyr::full_join(adex2, adex, by = names(adex))+ AVISITN, |
|
| 200 | +1171 | 3x |
- adex <- adex_tmp %>%+ ADTM, |
|
| 201 | +1172 | 3x |
- dplyr::group_by(USUBJID) %>%+ ADY, |
|
| 202 | +1173 | 3x |
- dplyr::mutate(AVAL = ifelse(PARAMCD == "NDOSE", 1, AVAL)) %>%+ AVAL_ex028 = AVAL |
|
| 203 | -3x | +|||
| 1174 | +
- dplyr::mutate(AVAL = ifelse(+ ) %>% |
|||
| 204 | +1175 | 3x |
- PARAMCD == "TNDOSE",+ mutate( |
|
| 205 | +1176 | 3x |
- sum(AVAL[PARAMCD == "NDOSE"]),+ comp_count_all = comp_count_all |
|
| 206 | -3x | +|||
| 1177 | +
- AVAL+ ) |
|||
| 207 | +1178 |
- )) %>%+ |
||
| 208 | +1179 | 3x |
- dplyr::ungroup() %>%+ joined <- left_join( |
|
| 209 | +1180 | 3x |
- dplyr::group_by(USUBJID, STUDYID, PARCAT2) %>%+ ex028_data, |
|
| 210 | +1181 | 3x |
- dplyr::mutate(AVAL = ifelse(+ orig_data_summ, |
|
| 211 | +1182 | 3x |
- PARAMCD == "TDOSE",+ by = c( |
|
| 212 | +1183 | 3x |
- sum(AVAL[PARAMCD == "DOSE"]),+ "STUDYID", |
|
| 213 | +1184 | 3x |
- AVAL- |
- |
| 214 | -- |
- ))- |
- ||
| 215 | -- |
-
+ "USUBJID", |
||
| 216 | +1185 | 3x |
- adex <- var_relabel(+ "PARCAT1", |
|
| 217 | +1186 | 3x |
- adex,+ "AVISIT", |
|
| 218 | +1187 | 3x |
- STUDYID = "Study Identifier",+ "AVISITN", |
|
| 219 | +1188 | 3x |
- USUBJID = "Unique Subject Identifier"+ "comp_count_all" |
|
| 220 | +1189 |
- )+ ) |
||
| 221 | +1190 |
-
+ ) %>%+ |
+ ||
| 1191 | +3x | +
+ select(-c("ADTM.x", "ADY.x"))
|
||
| 222 | +1192 |
- # merge ADSL to be able to add ADEX date and study day variables+ |
||
| 223 | +1193 | 3x |
- adex <- dplyr::inner_join(adex, adsl, by = c("STUDYID", "USUBJID")) %>%
+ joined <- rename( |
|
| 224 | +1194 | 3x |
- dplyr::rowwise() %>%+ joined, |
|
| 225 | +1195 | 3x |
- dplyr::mutate(TRTENDT = lubridate::date(dplyr::case_when(+ ADTM = ADTM.y, |
|
| 226 | +1196 | 3x |
- is.na(TRTEDTM) ~ lubridate::floor_date(lubridate::date(TRTSDTM) + study_duration_secs, unit = "day"),+ ADY = ADY.y |
|
| 227 | -3x | +|||
| 1197 | +
- TRUE ~ TRTEDTM+ ) |
|||
| 228 | +1198 |
- ))) %>%+ # CO028ALL |
||
| 229 | +1199 | 3x |
- dplyr::mutate(ASTDTM = sample(+ co028all <- mutate( |
|
| 230 | +1200 | 3x |
- seq(lubridate::as_datetime(TRTSDTM), lubridate::as_datetime(TRTENDT), by = "day"),+ joined, |
|
| 231 | +1201 | 3x |
- size = 1+ PARAMCD = "CO028ALL", |
|
| 232 | -+ | |||
| 1202 | +3x |
- )) %>%+ PARAM = "EORTC QLQ-C30: Completion - Completed all questions", |
||
| 233 | -+ | |||
| 1203 | +3x |
- # add 1 to end of range incase both values passed to sample() are the same+ PARCAT2 = "Completion", |
||
| 234 | +1204 | 3x |
- dplyr::mutate(AENDTM = sample(+ AVAL = case_when( |
|
| 235 | +1205 | 3x |
- seq(lubridate::as_datetime(ASTDTM), lubridate::as_datetime(TRTENDT + 1), by = "day"),+ AVAL_ex028 == 1 & comp_count == comp_count_all ~ 1, |
|
| 236 | +1206 | 3x |
- size = 1+ AVAL_ex028 == 1 & (is.na(comp_count) | comp_count < comp_count_all) ~ 0 |
|
| 237 | +1207 |
- )) %>%+ ), |
||
| 238 | +1208 | 3x |
- dplyr::select(-TRTENDT) %>%+ AVALC = case_when( |
|
| 239 | +1209 | 3x |
- dplyr::ungroup() %>%+ AVAL == 1 ~ "Completed all questions", |
|
| 240 | +1210 | 3x |
- dplyr::arrange(STUDYID, USUBJID, ASTDTM)+ AVAL == 0 ~ "Did not complete all questions" |
|
| 241 | +1211 |
-
+ ) |
||
| 242 | +1212 |
-
+ )+ |
+ ||
| 1213 | ++ |
+ # CO028<y>P |
||
| 243 | +1214 | 3x |
- adex <- adex %>%+ co028p <- mutate( |
|
| 244 | +1215 | 3x |
- dplyr::group_by(USUBJID) %>%+ joined, |
|
| 245 | +1216 | 3x |
- dplyr::mutate(EXSEQ = seq_len(dplyr::n())) %>%+ PARAMCD = paste0("CO028", as.character(percent), "P"),
|
|
| 246 | +1217 | 3x |
- dplyr::mutate(ASEQ = EXSEQ) %>%+ PARAM = sprintf( |
|
| 247 | +1218 | 3x |
- dplyr::ungroup() %>%+ "EORTC QLQ-C30: Completion - Completed at least %s%% of questions", |
|
| 248 | +1219 | 3x |
- dplyr::arrange(+ as.character(percent)+ |
+ |
| 1220 | ++ |
+ ), |
||
| 249 | +1221 | 3x |
- STUDYID,+ PARCAT2 = "Completion", |
|
| 250 | +1222 | 3x |
- USUBJID,+ AVAL = case_when( |
|
| 251 | +1223 | 3x |
- PARAMCD,+ AVAL_ex028 == 1 & per_comp >= percent ~ 1, |
|
| 252 | +1224 | 3x |
- ASTDTM,+ AVAL_ex028 == 1 & (is.na(per_comp) | per_comp < percent) ~ 0+ |
+ |
| 1225 | ++ |
+ ), |
||
| 253 | +1226 | 3x |
- AVISITN,+ AVALC = case_when( |
|
| 254 | +1227 | 3x |
- EXSEQ+ AVAL == 1 ~ sprintf( |
|
| 255 | -+ | |||
| 1228 | +3x |
- )+ "Completed at least %s%% of questions", |
||
| 256 | -+ | |||
| 1229 | +3x |
-
+ as.character(percent) |
||
| 257 | +1230 |
- # Adding EXDOSFRQ+ ), |
||
| 258 | +1231 | 3x |
- adex <- adex %>%+ AVAL == 0 ~ sprintf( |
|
| 259 | +1232 | 3x |
- dplyr::mutate(EXDOSFRQ = dplyr::case_when(+ "Did not complete at least %s%% of questions", |
|
| 260 | +1233 | 3x |
- PARCAT1 == "INDIVIDUAL" ~ "ONCE",+ as.character(percent) |
|
| 261 | -3x | +|||
| 1234 | +
- TRUE ~ ""+ ) |
|||
| 262 | +1235 |
- ))+ ) |
||
| 263 | +1236 |
-
+ ) |
||
| 264 | +1237 |
- # Adding EXROUTE+ # CO028<x>Q |
||
| 265 | +1238 | 3x |
- adex <- adex %>%+ co028q <- mutate( |
|
| 266 | +1239 | 3x |
- dplyr::mutate(EXROUTE = dplyr::case_when(+ joined, |
|
| 267 | +1240 | 3x |
- PARCAT1 == "INDIVIDUAL" ~ sample(c("INTRAVENOUS", "SUBCUTANEOUS"),
+ PARAMCD = paste0("CO028", as.character(number), "Q"),
|
|
| 268 | +1241 | 3x |
- nrow(adex),+ PARAM = sprintf( |
|
| 269 | +1242 | 3x |
- replace = TRUE,+ "EORTC QLQ-C30: Completion - Completed at least %s question(s)", |
|
| 270 | +1243 | 3x |
- prob = c(0.9, 0.1)+ as.character(number) |
|
| 271 | +1244 |
- ),+ ), |
||
| 272 | +1245 | 3x |
- TRUE ~ ""- |
- |
| 273 | -- |
- ))- |
- ||
| 274 | -- |
-
+ PARCAT2 = "Completion", |
||
| 275 | -+ | |||
| 1246 | +3x |
- # Fix VISIT according to AVISIT+ AVAL = case_when( |
||
| 276 | +1247 | 3x |
- adex <- adex %>%+ AVAL_ex028 == 1 & comp_count >= number ~ 1, |
|
| 277 | +1248 | 3x |
- dplyr::mutate(VISIT = AVISIT)+ AVAL_ex028 == 1 & (comp_count < number | is.na(comp_count)) ~ 0 |
|
| 278 | +1249 |
-
+ ), |
||
| 279 | -+ | |||
| 1250 | +3x |
- # Hack for VISITDY - to fix in ADSL+ AVALC = case_when( |
||
| 280 | +1251 | 3x |
- visit_levels <- str_extract(levels(adex$VISIT), pattern = "[0-9]+")+ AVAL == 1 ~ sprintf( |
|
| 281 | +1252 | 3x |
- vl_extracted <- vapply(visit_levels, function(x) as.numeric(x[2]), numeric(1))+ "Completed at least %s questions", |
|
| 282 | +1253 | 3x |
- vl_extracted <- c(-1, 1, vl_extracted[!is.na(vl_extracted)])+ as.character(number) |
|
| 283 | +1254 |
-
+ ), |
||
| 284 | -+ | |||
| 1255 | +3x |
- # Adding VISITDY+ AVAL == 0 ~ sprintf( |
||
| 285 | +1256 | 3x |
- adex <- adex %>%+ "Did not complete at least %s question(s)", |
|
| 286 | +1257 | 3x |
- dplyr::mutate(VISITDY = as.numeric(as.character(factor(VISIT, labels = vl_extracted))))+ as.character(number) |
|
| 287 | +1258 |
-
+ ) |
||
| 288 | +1259 |
- # Exposure time stamps+ ) |
||
| 289 | -3x | +|||
| 1260 | +
- adex <- adex %>%+ ) |
|||
| 290 | -3x | +|||
| 1261 | +
- dplyr::mutate(+ |
|||
| 291 | +1262 | 3x |
- EXSTDTC = TRTSDTM + lubridate::days(VISITDY),+ co028_bind <- rbind( |
|
| 292 | +1263 | 3x |
- EXENDTC = EXSTDTC + lubridate::hours(1),+ co028all, |
|
| 293 | +1264 | 3x |
- EXSTDY = VISITDY,+ co028p, |
|
| 294 | +1265 | 3x |
- EXENDY = VISITDY- |
- |
| 295 | -- |
- )- |
- ||
| 296 | -- |
-
+ co028q |
||
| 297 | +1266 |
- # Correcting last exposure to treatment+ ) %>% |
||
| 298 | +1267 | 3x |
- adex <- adex %>%+ select( |
|
| 299 | +1268 | 3x |
- dplyr::group_by(SUBJID) %>%+ -c("AVAL_ex028", "comp_count", "comp_count_all", "per_comp")
|
|
| 300 | -3x | +|||
| 1269 | +
- dplyr::mutate(TRTEDTM = lubridate::as_datetime(max(EXENDTC, na.rm = TRUE))) %>%+ ) |
|||
| 301 | +1270 | 3x |
- dplyr::ungroup()+ return(co028_bind) |
|
| 302 | +1271 |
-
+ } |
| 303 | +1 |
- # Fixing Date - to add into ADSL+ #' Exposure Analysis Dataset (ADEX) |
|
| 304 | -3x | +||
| 2 | +
- adex <- adex %>%+ #' |
||
| 305 | -3x | +||
| 3 | +
- dplyr::mutate(+ #' @description `r lifecycle::badge("stable")`
|
||
| 306 | -3x | +||
| 4 | +
- TRTSDT = lubridate::date(TRTSDTM),+ #' |
||
| 307 | -3x | +||
| 5 | +
- TRTEDT = lubridate::date(TRTEDTM)+ #' Function for generating random Exposure Analysis Dataset for a given |
||
| 308 | +6 |
- )+ #' Subject-Level Analysis Dataset. |
|
| 309 | +7 |
-
+ #' |
|
| 310 | +8 |
- # Fixing analysis time stamps+ #' @details One record per each record in the corresponding SDTM domain. |
|
| 311 | -3x | +||
| 9 | +
- adex <- adex %>%- |
- ||
| 312 | -3x | -
- dplyr::mutate(- |
- |
| 313 | -3x | -
- ASTDY = EXSTDY,- |
- |
| 314 | -3x | -
- AENDY = EXENDY,- |
- |
| 315 | -3x | -
- ASTDTM = EXSTDTC,- |
- |
| 316 | -3x | -
- AENDTM = EXENDTC- |
- |
| 317 | -- |
- )- |
- |
| 318 | -- | - - | -|
| 319 | -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- |
- |
| 324 | -3x | -
- adex <- apply_metadata(adex, "metadata/ADEX.yml")- |
- |
| 325 | -- |
- }- |
- |
| 326 | -- | - - | -|
| 327 | -- |
- # Equivalent of stringr::str_extract_all()- |
- |
| 328 | -- |
- str_extract <- function(string, pattern) {
- |
- |
| 329 | -2850x | -
- regmatches(string, gregexpr(pattern, string))- |
- |
| 330 | -- |
- }- |
-
| 1 | -- |
- #' Medical History Analysis Dataset (ADMH)- |
- |
| 2 | -- |
- #'- |
- |
| 3 | -- |
- #' @description `r lifecycle::badge("stable")`
- |
- |
| 4 | -- |
- #'- |
- |
| 5 | -- |
- #' Function for generating a random Medical History Analysis Dataset for a given- |
- |
| 6 | -- |
- #' Subject-Level Analysis Dataset.- |
- |
| 7 | -- |
- #'- |
- |
| 8 | -- |
- #' @details One record per each record in the corresponding SDTM domain.- |
- |
| 9 | -- |
- #'+ #' |
|
| 10 |
- #' Keys: `STUDYID`, `USUBJID`, `ASTDTM`, `MHSEQ`+ #' Keys: `STUDYID`, `USUBJID`, `EXSEQ`, `PARAMCD`, `PARCAT1`, `ASTDTM`, `AENDTM`, `ASTDY`, `AENDY`, |
||
| 11 |
- #'+ #' `AVISITN`, `EXDOSFRQ`, `EXROUTE`, `VISIT`, `VISITDY`, `EXSTDTC`, `EXENDTC`, `EXSTDY`, `EXENDY` |
||
| 12 |
- #' @inheritParams argument_convention+ #' |
||
| 13 |
- #' @param max_n_mhs (`integer`)\cr Maximum number of MHs per patient. Defaults to 10.+ #' @inheritParams argument_convention |
||
| 14 |
- #' @template param_cached+ #' @param parcat1 (`character vector`)\cr Dose amount categories. Defaults to "Individual" and "Overall". |
||
| 15 |
- #' @templateVar data admh+ #' @param parcat2 (`character vector`)\cr Types of drug received. Defaults to "Drug A" and "Drug B". |
||
| 16 |
- #'+ #' @param max_n_exs (`integer`)\cr Maximum number of exposures per patient. Defaults to 6. |
||
| 17 |
- #' @return `data.frame`+ #' @template param_cached |
||
| 18 |
- #' @export+ #' @templateVar data adex |
||
| 20 |
- #' @examples+ #' @return `data.frame` |
||
| 21 |
- #' adsl <- radsl(N = 10, study_duration = 2, seed = 1)+ #' @export |
||
| 23 |
- #' admh <- radmh(adsl, seed = 2)+ #' @examples |
||
| 24 |
- #' admh+ #' adsl <- radsl(N = 10, study_duration = 2, seed = 1) |
||
| 25 |
- radmh <- function(adsl,+ #' |
||
| 26 |
- max_n_mhs = 10L,+ #' adex <- radex(adsl, seed = 2) |
||
| 27 |
- lookup = NULL,+ #' adex |
||
| 28 |
- seed = NULL,+ radex <- function(adsl, |
||
| 29 |
- na_percentage = 0,+ param = c( |
||
| 30 |
- na_vars = list(MHBODSYS = c(NA, 0.1), MHDECOD = c(1234, 0.1)),+ "Dose administered during constant dosing interval", |
||
| 31 |
- cached = FALSE) {
+ "Number of doses administered during constant dosing interval", |
||
| 32 | -4x | +
- checkmate::assert_flag(cached)+ "Total dose administered", |
|
| 33 | -4x | +
- if (cached) {
+ "Total number of doses administered" |
|
| 34 | -1x | +
- return(get_cached_data("cadmh"))
+ ), |
|
| 35 |
- }+ paramcd = c("DOSE", "NDOSE", "TDOSE", "TNDOSE"),
|
||
| 36 |
-
+ paramu = c("mg", " ", "mg", " "),
|
||
| 37 | -3x | +
- checkmate::assert_data_frame(adsl)+ parcat1 = c("INDIVIDUAL", "OVERALL"),
|
|
| 38 | -3x | +
- checkmate::assert_integer(max_n_mhs, len = 1, any.missing = FALSE)+ parcat2 = c("Drug A", "Drug B"),
|
|
| 39 | -3x | +
- checkmate::assert_number(seed, null.ok = TRUE)+ visit_format = "WEEK", |
|
| 40 | -3x | +
- checkmate::assert_number(na_percentage, lower = 0, upper = 1)+ n_assessments = 5L, |
|
| 41 | -3x | +
- checkmate::assert_true(na_percentage < 1)+ n_days = 5L, |
|
| 42 |
-
+ max_n_exs = 6L, |
||
| 43 | -3x | +
- checkmate::assert_data_frame(lookup, null.ok = TRUE)+ lookup = NULL, |
|
| 44 | -3x | +
- lookup_mh <- if (!is.null(lookup)) {
+ seed = NULL, |
|
| 45 | -! | +
- lookup+ na_percentage = 0, |
|
| 46 |
- } else {
+ na_vars = list(AVAL = c(NA, 0.1), AVALU = c(NA), 0.1), |
||
| 47 | -3x | +
- tibble::tribble(+ cached = FALSE) {
|
|
| 48 | -3x | +4x |
- ~MHBODSYS, ~MHDECOD, ~MHSOC,+ checkmate::assert_flag(cached) |
| 49 | -3x | +4x |
- "cl A", "trm A_1/2", "cl A",+ if (cached) {
|
| 50 | -3x | +1x |
- "cl A", "trm A_2/2", "cl A",+ return(get_cached_data("cadex"))
|
| 51 | -3x | +
- "cl B", "trm B_1/3", "cl B",+ } |
|
| 52 | -3x | +
- "cl B", "trm B_2/3", "cl B",+ |
|
| 53 | 3x |
- "cl B", "trm B_3/3", "cl B",+ checkmate::assert_data_frame(adsl) |
|
| 54 | 3x |
- "cl C", "trm C_1/2", "cl C",+ checkmate::assert_character(param, min.len = 1, any.missing = FALSE) |
|
| 55 | 3x |
- "cl C", "trm C_2/2", "cl C",+ checkmate::assert_character(paramcd, min.len = 1, any.missing = FALSE) |
|
| 56 | 3x |
- "cl D", "trm D_1/3", "cl D",+ checkmate::assert_character(parcat1, min.len = 1, any.missing = FALSE) |
|
| 57 | 3x |
- "cl D", "trm D_2/3", "cl D",+ checkmate::assert_character(parcat2, min.len = 1, any.missing = FALSE) |
|
| 58 | 3x |
- "cl D", "trm D_3/3", "cl D"+ checkmate::assert_string(visit_format) |
|
| 59 | -+ | 3x |
- )+ checkmate::assert_integer(n_assessments, len = 1, any.missing = FALSE) |
| 60 | -+ | 3x |
- }+ checkmate::assert_integer(n_days, len = 1, any.missing = FALSE) |
| 61 | -+ | 3x |
-
+ checkmate::assert_integer(max_n_exs, len = 1, any.missing = FALSE) |
| 62 | 3x |
- if (!is.null(seed)) {
+ checkmate::assert_data_frame(lookup, null.ok = TRUE) |
|
| 63 | 3x |
- set.seed(seed)+ checkmate::assert_number(seed, null.ok = TRUE) |
|
| 64 | -+ | 3x |
- }+ checkmate::assert_number(na_percentage, lower = 0, upper = 1) |
| 65 | 3x |
- study_duration_secs <- lubridate::seconds(attr(adsl, "study_duration_secs"))+ checkmate::assert_true(na_percentage < 1) |
|
| 67 | -3x | +
- admh <- Map(+ # validate and initialize related variables |
|
| 68 | 3x |
- function(id, sid) {
+ param_init_list <- relvar_init(param, paramcd) |
|
| 69 | -30x | +3x |
- n_mhs <- sample(0:max_n_mhs, 1)+ unit_init_list <- relvar_init(param, paramu) |
| 70 | -30x | +
- i <- sample(seq_len(nrow(lookup_mh)), n_mhs, TRUE)+ |
|
| 71 | -30x | +3x |
- dplyr::mutate(+ if (!is.null(seed)) {
|
| 72 | -30x | +3x |
- lookup_mh[i, ],+ set.seed(seed) |
| 73 | -30x | +
- USUBJID = id,+ } |
|
| 74 | -30x | +3x |
- STUDYID = sid+ study_duration_secs <- lubridate::seconds(attr(adsl, "study_duration_secs")) |
| 75 |
- )+ |
||
| 76 | -+ | 3x |
- },+ adex <- expand.grid( |
| 77 | 3x |
- adsl$USUBJID,+ STUDYID = unique(adsl$STUDYID), |
|
| 78 | 3x |
- adsl$STUDYID+ USUBJID = adsl$USUBJID, |
|
| 79 | -+ | 3x |
- ) %>%+ PARAM = c( |
| 80 | 3x |
- Reduce(rbind, .) %>%+ rep( |
|
| 81 | 3x |
- `[`(c(4, 5, 1, 2, 3)) %>%+ param_init_list$relvar1[1], |
|
| 82 | 3x |
- dplyr::mutate(MHTERM = MHDECOD)+ length(levels(visit_schedule(visit_format = visit_format, n_assessments = n_assessments, n_days = n_days))) |
|
| 83 |
-
+ ), |
||
| 84 | 3x |
- admh <- var_relabel(+ rep( |
|
| 85 | 3x |
- admh,+ param_init_list$relvar1[2], |
|
| 86 | 3x |
- STUDYID = "Study Identifier",+ length(levels(visit_schedule(visit_format = visit_format, n_assessments = n_assessments, n_days = n_days))) |
|
| 87 | -3x | +
- USUBJID = "Unique Subject Identifier"+ ), |
|
| 88 | -+ | 3x |
- )+ param_init_list$relvar1[3:4] |
| 89 |
-
+ ), |
||
| 90 | -+ | 3x |
- # merge ADSL to be able to add MH date and study day variables+ stringsAsFactors = FALSE |
| 91 | -3x | +
- admh <- dplyr::inner_join(+ ) |
|
| 92 | -3x | +
- admh,+ |
|
| 93 | -3x | +
- adsl,+ # assign related variable values: PARAMxPARAMCD are related |
|
| 94 | 3x |
- by = c("STUDYID", "USUBJID")
+ adex <- adex %>% rel_var( |
|
| 95 | -+ | 3x |
- ) %>%+ var_name = "PARAMCD", |
| 96 | 3x |
- dplyr::rowwise() %>%+ related_var = "PARAM", |
|
| 97 | 3x |
- dplyr::mutate(TRTENDT = lubridate::date(dplyr::case_when(+ var_values = param_init_list$relvar2 |
|
| 98 | -3x | +
- is.na(TRTEDTM) ~ lubridate::floor_date(lubridate::date(TRTSDTM) + study_duration_secs, unit = "day"),+ ) |
|
| 99 | -3x | +
- TRUE ~ TRTEDTM+ |
|
| 100 |
- ))) %>%+ # assign related variable values: AVALUxPARAM are related |
||
| 101 | 3x |
- dplyr::mutate(ASTDTM = sample(+ adex <- adex %>% rel_var( |
|
| 102 | 3x |
- seq(lubridate::as_datetime(TRTSDTM), lubridate::as_datetime(TRTENDT), by = "day"),+ var_name = "AVALU", |
|
| 103 | 3x |
- size = 1+ related_var = "PARAM", |
|
| 104 | -+ | 3x |
- )) %>%+ var_values = unit_init_list$relvar2 |
| 105 | -3x | +
- dplyr::mutate(ASTDY = ceiling(difftime(ASTDTM, TRTSDTM, units = "days"))) %>%+ ) |
|
| 106 |
- # add 1 to end of range incase both values passed to sample() are the same+ |
||
| 107 | 3x |
- dplyr::mutate(AENDTM = sample(+ adex <- adex %>% |
|
| 108 | 3x |
- seq(lubridate::as_datetime(ASTDTM), lubridate::as_datetime(TRTENDT + 1), by = "day"),+ dplyr::group_by(USUBJID) %>% |
|
| 109 | 3x |
- size = 1+ dplyr::mutate(PARCAT_ind = sample(c(1, 2), size = 1)) %>% |
|
| 110 | -+ | 3x |
- )) %>%+ dplyr::mutate(PARCAT2 = ifelse(PARCAT_ind == 1, parcat2[1], parcat2[2])) %>% |
| 111 | 3x |
- dplyr::mutate(AENDY = ceiling(difftime(AENDTM, TRTSDTM, units = "days"))) %>%+ dplyr::select(-"PARCAT_ind") |
|
| 112 | -3x | +
- select(-TRTENDT) %>%+ |
|
| 113 | -3x | +
- dplyr::ungroup() %>%+ # Add in PARCAT1 |
|
| 114 | 3x |
- dplyr::arrange(STUDYID, USUBJID, ASTDTM, MHTERM) %>%+ adex <- adex %>% dplyr::mutate(PARCAT1 = dplyr::case_when( |
|
| 115 | 3x |
- dplyr::mutate(MHDISTAT = sample(+ (PARAMCD == "TNDOSE" | PARAMCD == "TDOSE") ~ "OVERALL", |
|
| 116 | 3x |
- x = c("Resolved", "Ongoing with treatment", "Ongoing without treatment"),
+ PARAMCD == "DOSE" | PARAMCD == "NDOSE" ~ "INDIVIDUAL" |
|
| 117 | -3x | +
- prob = c(0.6, 0.2, 0.2),+ )) |
|
| 118 | -3x | +
- size = dplyr::n(),+ |
|
| 119 | 3x |
- replace = TRUE+ adex_visit <- adex %>% |
|
| 120 | -+ | 3x |
- )) %>%+ dplyr::filter(PARAMCD == "DOSE" | PARAMCD == "NDOSE") %>% |
| 121 | 3x |
- dplyr::mutate(ATIREL = dplyr::case_when(+ dplyr::mutate( |
|
| 122 | 3x |
- (AENDTM < TRTSDTM | (is.na(AENDTM) & MHDISTAT == "Resolved")) ~ "PRIOR",+ AVISIT = rep(visit_schedule(visit_format = visit_format, n_assessments = n_assessments, n_days = n_days), 2) |
|
| 123 | -3x | +
- (AENDTM >= TRTSDTM | (is.na(AENDTM) & grepl("Ongoing", MHDISTAT))) ~ "PRIOR_CONCOMITANT"
+ ) |
|
| 124 |
- ))+ |
||
| 125 | -+ | 3x |
-
+ adex <- dplyr::left_join( |
| 126 | 3x |
- admh <- admh %>%+ adex %>% |
|
| 127 | 3x |
- dplyr::group_by(USUBJID) %>%+ dplyr::group_by( |
|
| 128 | 3x |
- dplyr::mutate(MHSEQ = seq_len(dplyr::n())) %>%+ USUBJID, |
|
| 129 | 3x |
- dplyr::mutate(ASEQ = MHSEQ) %>%+ STUDYID, |
|
| 130 | 3x |
- dplyr::ungroup() %>%+ PARAM, |
|
| 131 | 3x |
- dplyr::arrange(STUDYID, USUBJID, ASTDTM, MHSEQ)+ PARAMCD, |
|
| 132 | -+ | 3x |
-
+ AVALU, |
| 133 | 3x |
- if (length(na_vars) > 0 && na_percentage > 0 && na_percentage <= 1) {
+ PARCAT1, |
|
| 134 | -! | +3x |
- admh <- mutate_na(ds = admh, na_vars = na_vars, na_percentage = na_percentage)+ PARCAT2 |
| 135 |
- }+ ) %>% |
||
| 136 | -+ | 3x |
-
+ dplyr::mutate(id = dplyr::row_number()), |
| 137 | -+ | 3x |
- # apply metadata+ adex_visit %>% |
| 138 | 3x |
- admh <- apply_metadata(admh, "metadata/ADMH.yml")+ dplyr::group_by( |
|
| 139 | -+ | 3x |
-
+ USUBJID, |
| 140 | 3x |
- return(admh)+ STUDYID, |
|
| 141 | -+ | 3x |
- }+ PARAM, |
| 1 | -+ | |||
| 142 | +3x |
- #' Adverse Event Analysis Dataset (ADAE)+ PARAMCD, |
||
| 2 | -+ | |||
| 143 | +3x |
- #'+ AVALU, |
||
| 3 | -+ | |||
| 144 | +3x |
- #' @description `r lifecycle::badge("stable")`
+ PARCAT1, |
||
| 4 | -+ | |||
| 145 | +3x |
- #'+ PARCAT2 |
||
| 5 | +146 |
- #' Function for generating random Adverse Event Analysis Dataset for a given+ ) %>% |
||
| 6 | -+ | |||
| 147 | +3x |
- #' Subject-Level Analysis Dataset.+ dplyr::mutate(id = dplyr::row_number()), |
||
| 7 | -+ | |||
| 148 | +3x |
- #'+ by = c("USUBJID", "STUDYID", "PARCAT1", "PARCAT2", "id", "PARAMCD", "PARAM", "AVALU")
|
||
| 8 | +149 |
- #' @details One record per each record in the corresponding SDTM domain.+ ) %>% |
||
| 9 | -+ | |||
| 150 | +3x |
- #'+ dplyr::select(-"id") |
||
| 10 | +151 |
- #' Keys: `STUDYID`, `USUBJID`, `ASTDTM`, `AETERM`, `AESEQ`+ |
||
| 11 | +152 |
- #'+ # Visit numbers |
||
| 12 | -+ | |||
| 153 | +3x |
- #' @inheritParams argument_convention+ adex <- adex %>% dplyr::mutate(AVISITN = dplyr::case_when( |
||
| 13 | -+ | |||
| 154 | +3x |
- #' @param max_n_aes (`integer`)\cr Maximum number of AEs per patient. Defaults to 10.+ AVISIT == "SCREENING" ~ -1, |
||
| 14 | -+ | |||
| 155 | +3x |
- #' @template param_cached+ AVISIT == "BASELINE" ~ 0, |
||
| 15 | -+ | |||
| 156 | +3x |
- #' @templateVar data adae+ (grepl("^WEEK", AVISIT) | grepl("^CYCLE", AVISIT)) ~ as.numeric(AVISIT) - 2,
|
||
| 16 | -+ | |||
| 157 | +3x |
- #'+ TRUE ~ 999000 |
||
| 17 | +158 |
- #' @return `data.frame`+ )) |
||
| 18 | +159 |
- #' @export+ |
||
| 19 | +160 |
- #'+ |
||
| 20 | -+ | |||
| 161 | +3x |
- #' @examples+ adex2 <- split(adex, adex$USUBJID) %>% |
||
| 21 | -+ | |||
| 162 | +3x |
- #' adsl <- radsl(N = 10, study_duration = 2, seed = 1)+ lapply(function(pinfo) {
|
||
| 22 | -+ | |||
| 163 | +30x |
- #'+ pinfo %>% |
||
| 23 | -+ | |||
| 164 | +30x |
- #' adae <- radae(adsl, seed = 2)+ dplyr::filter(PARAMCD == "DOSE") %>% |
||
| 24 | -+ | |||
| 165 | +30x |
- #' adae+ dplyr::group_by(USUBJID, PARCAT2, AVISIT) %>% |
||
| 25 | -+ | |||
| 166 | +30x |
- #'+ dplyr::mutate(changeind = dplyr::case_when( |
||
| 26 | -+ | |||
| 167 | +30x |
- #' # Add metadata.+ AVISIT == "SCREENING" ~ 0, |
||
| 27 | -+ | |||
| 168 | +30x |
- #' aag <- utils::read.table(+ AVISIT != "SCREENING" ~ sample(c(-1, 0, 1), |
||
| 28 | -+ | |||
| 169 | +30x |
- #' sep = ",", header = TRUE,+ size = 1, |
||
| 29 | -+ | |||
| 170 | +30x |
- #' text = paste(+ prob = c(0.25, 0.5, 0.25), |
||
| 30 | -+ | |||
| 171 | +30x |
- #' "NAMVAR,SRCVAR,GRPTYPE,REFNAME,REFTERM,SCOPE",+ replace = TRUE |
||
| 31 | +172 |
- #' "CQ01NAM,AEDECOD,CUSTOM,D.2.1.5.3/A.1.1.1.1 AESI,dcd D.2.1.5.3,",+ ) |
||
| 32 | +173 |
- #' "CQ01NAM,AEDECOD,CUSTOM,D.2.1.5.3/A.1.1.1.1 AESI,dcd A.1.1.1.1,",+ )) %>% |
||
| 33 | -+ | |||
| 174 | +30x |
- #' "SMQ01NAM,AEDECOD,SMQ,C.1.1.1.3/B.2.2.3.1 AESI,dcd C.1.1.1.3,BROAD",+ dplyr::ungroup() %>% |
||
| 34 | -+ | |||
| 175 | +30x |
- #' "SMQ01NAM,AEDECOD,SMQ,C.1.1.1.3/B.2.2.3.1 AESI,dcd B.2.2.3.1,BROAD",+ dplyr::group_by(USUBJID, PARCAT2) %>% |
||
| 35 | -+ | |||
| 176 | +30x |
- #' "SMQ02NAM,AEDECOD,SMQ,Y.9.9.9.9/Z.9.9.9.9 AESI,dcd Y.9.9.9.9,NARROW",+ dplyr::mutate( |
||
| 36 | -+ | |||
| 177 | +30x |
- #' "SMQ02NAM,AEDECOD,SMQ,Y.9.9.9.9/Z.9.9.9.9 AESI,dcd Z.9.9.9.9,NARROW",+ csum = cumsum(changeind), |
||
| 37 | -+ | |||
| 178 | +30x |
- #' sep = "\n"+ changeind = dplyr::case_when( |
||
| 38 | -+ | |||
| 179 | +30x |
- #' ), stringsAsFactors = FALSE+ csum <= -3 ~ sample(c(0, 1), size = 1, prob = c(0.5, 0.5)), |
||
| 39 | -+ | |||
| 180 | +30x |
- #' )+ csum >= 3 ~ sample(c(0, -1), size = 1, prob = c(0.5, 0.5)), |
||
| 40 | -+ | |||
| 181 | +30x |
- #'+ TRUE ~ changeind |
||
| 41 | +182 |
- #' adae <- radae(adsl, lookup_aag = aag)+ ) |
||
| 42 | +183 |
- #'+ ) %>% |
||
| 43 | -+ | |||
| 184 | +30x |
- #' with(+ dplyr::mutate(csum = cumsum(changeind)) %>% |
||
| 44 | -+ | |||
| 185 | +30x |
- #' adae,+ dplyr::ungroup() %>% |
||
| 45 | -+ | |||
| 186 | +30x |
- #' cbind(+ dplyr::group_by(USUBJID, PARCAT2, AVISIT) %>% |
||
| 46 | -+ | |||
| 187 | +30x |
- #' table(AEDECOD, SMQ01NAM),+ dplyr::mutate(AVAL = dplyr::case_when( |
||
| 47 | -+ | |||
| 188 | +30x |
- #' table(AEDECOD, CQ01NAM)+ csum == -2 ~ 480, |
||
| 48 | -+ | |||
| 189 | +30x |
- #' )+ csum == -1 ~ 720, |
||
| 49 | -+ | |||
| 190 | +30x |
- #' )+ csum == 0 ~ 960, |
||
| 50 | -+ | |||
| 191 | +30x |
- radae <- function(adsl,+ csum == 1 ~ 1200, |
||
| 51 | -+ | |||
| 192 | +30x |
- max_n_aes = 10L,+ csum == 2 ~ 1440 |
||
| 52 | +193 |
- lookup = NULL,+ )) %>% |
||
| 53 | -+ | |||
| 194 | +30x |
- lookup_aag = NULL,+ dplyr::select(-c("csum", "changeind")) %>%
|
||
| 54 | -+ | |||
| 195 | +30x |
- seed = NULL,+ dplyr::ungroup() |
||
| 55 | +196 |
- na_percentage = 0,+ }) %>% |
||
| 56 | -+ | |||
| 197 | +3x |
- na_vars = list(+ Reduce(rbind, .) |
||
| 57 | +198 |
- AEBODSYS = c(NA, 0.1),+ |
||
| 58 | -+ | |||
| 199 | +3x |
- AEDECOD = c(1234, 0.1),+ adex_tmp <- dplyr::full_join(adex2, adex, by = names(adex)) |
||
| 59 | -+ | |||
| 200 | +3x |
- AETOXGR = c(1234, 0.1)+ adex <- adex_tmp %>% |
||
| 60 | -+ | |||
| 201 | +3x |
- ),+ dplyr::group_by(USUBJID) %>% |
||
| 61 | -+ | |||
| 202 | +3x |
- cached = FALSE) {
+ dplyr::mutate(AVAL = ifelse(PARAMCD == "NDOSE", 1, AVAL)) %>% |
||
| 62 | -4x | +203 | +3x |
- checkmate::assert_flag(cached)+ dplyr::mutate(AVAL = ifelse( |
| 63 | -4x | +204 | +3x |
- if (cached) {
+ PARAMCD == "TNDOSE", |
| 64 | -1x | +205 | +3x |
- return(get_cached_data("cadae"))
+ sum(AVAL[PARAMCD == "NDOSE"]), |
| 65 | -+ | |||
| 206 | +3x |
- }+ AVAL |
||
| 66 | +207 |
-
+ )) %>% |
||
| 67 | +208 | 3x |
- checkmate::assert_data_frame(adsl)+ dplyr::ungroup() %>% |
|
| 68 | +209 | 3x |
- checkmate::assert_integer(max_n_aes, len = 1, any.missing = FALSE)+ dplyr::group_by(USUBJID, STUDYID, PARCAT2) %>% |
|
| 69 | +210 | 3x |
- checkmate::assert_number(seed, null.ok = TRUE)+ dplyr::mutate(AVAL = ifelse( |
|
| 70 | +211 | 3x |
- checkmate::assert_number(na_percentage, lower = 0, upper = 1)+ PARAMCD == "TDOSE", |
|
| 71 | +212 | 3x |
- checkmate::assert_true(na_percentage < 1)+ sum(AVAL[PARAMCD == "DOSE"]),+ |
+ |
| 213 | +3x | +
+ AVAL |
||
| 72 | +214 |
-
+ )) |
||
| 73 | +215 |
- # check lookup parameters+ |
||
| 74 | +216 | 3x |
- checkmate::assert_data_frame(lookup, null.ok = TRUE)+ adex <- rcd_var_relabel( |
|
| 75 | +217 | 3x |
- lookup_ae <- if (!is.null(lookup)) {
+ adex, |
|
| 76 | -! | +|||
| 218 | +3x |
- lookup+ STUDYID = "Study Identifier",+ |
+ ||
| 219 | +3x | +
+ USUBJID = "Unique Subject Identifier" |
||
| 77 | +220 |
- } else {
+ ) |
||
| 78 | -3x | +|||
| 221 | +
- tibble::tribble(+ |
|||
| 79 | -3x | +|||
| 222 | +
- ~AEBODSYS, ~AELLT, ~AEDECOD, ~AEHLT, ~AEHLGT, ~AETOXGR, ~AESOC, ~AESER, ~AEREL,+ # merge ADSL to be able to add ADEX date and study day variables |
|||
| 80 | +223 | 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",+ adex <- dplyr::inner_join(adex, adsl, by = c("STUDYID", "USUBJID")) %>%
|
|
| 81 | +224 | 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",+ dplyr::rowwise() %>% |
|
| 82 | +225 | 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",+ dplyr::mutate(TRTENDT = lubridate::date(dplyr::case_when( |
|
| 83 | +226 | 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",+ is.na(TRTEDTM) ~ lubridate::floor_date(lubridate::date(TRTSDTM) + study_duration_secs, unit = "day"), |
|
| 84 | +227 | 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",+ TRUE ~ TRTEDTM+ |
+ |
| 228 | ++ |
+ ))) %>% |
||
| 85 | +229 | 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",+ dplyr::mutate(ASTDTM = sample( |
|
| 86 | +230 | 3x |
- "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",+ seq(lubridate::as_datetime(TRTSDTM), lubridate::as_datetime(TRTENDT), by = "day"), |
|
| 87 | +231 | 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",+ size = 1+ |
+ |
| 232 | ++ |
+ )) %>%+ |
+ ||
| 233 | ++ |
+ # add 1 to end of range incase both values passed to sample() are the same |
||
| 88 | +234 | 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",+ dplyr::mutate(AENDTM = sample( |
|
| 89 | +235 | 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"+ seq(lubridate::as_datetime(ASTDTM), lubridate::as_datetime(TRTENDT + 1), by = "day"), |
|
| 90 | -+ | |||
| 236 | +3x |
- )+ size = 1 |
||
| 91 | +237 |
- }+ )) %>% |
||
| 92 | -+ | |||
| 238 | +3x |
-
+ dplyr::select(-TRTENDT) %>% |
||
| 93 | +239 | 3x |
- checkmate::assert_data_frame(lookup_aag, null.ok = TRUE)+ dplyr::ungroup() %>% |
|
| 94 | +240 | 3x |
- aag <- if (!is.null(lookup_aag)) {
+ dplyr::arrange(STUDYID, USUBJID, ASTDTM) |
|
| 95 | -! | +|||
| 241 | +
- lookup_aag+ |
|||
| 96 | +242 |
- } else {
+
|
||
| 97 | +243 | 3x |
- aag <- utils::read.table(+ adex <- adex %>% |
|
| 98 | +244 | 3x |
- sep = ",", header = TRUE,+ dplyr::group_by(USUBJID) %>% |
|
| 99 | +245 | 3x |
- text = paste(+ dplyr::mutate(EXSEQ = seq_len(dplyr::n())) %>% |
|
| 100 | +246 | 3x |
- "NAMVAR,SRCVAR,GRPTYPE,REFNAME,REFTERM,SCOPE",+ dplyr::mutate(ASEQ = EXSEQ) %>% |
|
| 101 | +247 | 3x |
- "CQ01NAM,AEDECOD,CUSTOM,D.2.1.5.3/A.1.1.1.1 AESI,dcd D.2.1.5.3,",+ dplyr::ungroup() %>% |
|
| 102 | +248 | 3x |
- "CQ01NAM,AEDECOD,CUSTOM,D.2.1.5.3/A.1.1.1.1 AESI,dcd A.1.1.1.1,",+ dplyr::arrange( |
|
| 103 | +249 | 3x |
- "SMQ01NAM,AEDECOD,SMQ,C.1.1.1.3/B.2.2.3.1 AESI,dcd C.1.1.1.3,BROAD",+ STUDYID, |
|
| 104 | +250 | 3x |
- "SMQ01NAM,AEDECOD,SMQ,C.1.1.1.3/B.2.2.3.1 AESI,dcd B.2.2.3.1,BROAD",+ USUBJID, |
|
| 105 | +251 | 3x |
- "SMQ02NAM,AEDECOD,SMQ,Y.9.9.9.9/Z.9.9.9.9 AESI,dcd Y.9.9.9.9,NARROW",+ PARAMCD, |
|
| 106 | +252 | 3x |
- "SMQ02NAM,AEDECOD,SMQ,Y.9.9.9.9/Z.9.9.9.9 AESI,dcd Z.9.9.9.9,NARROW",+ ASTDTM, |
|
| 107 | +253 | 3x |
- sep = "\n"+ AVISITN, |
|
| 108 | +254 | 3x |
- ), stringsAsFactors = FALSE+ EXSEQ |
|
| 109 | +255 |
) |
||
| 110 | +256 |
- }+ |
||
| 111 | +257 |
-
+ # Adding EXDOSFRQ |
||
| 112 | +258 | 3x |
- if (!is.null(seed)) set.seed(seed)+ adex <- adex %>% |
|
| 113 | +259 | 3x |
- study_duration_secs <- lubridate::seconds(attr(adsl, "study_duration_secs"))+ dplyr::mutate(EXDOSFRQ = dplyr::case_when(+ |
+ |
| 260 | +3x | +
+ PARCAT1 == "INDIVIDUAL" ~ "ONCE",+ |
+ ||
| 261 | +3x | +
+ TRUE ~ "" |
||
| 114 | +262 | ++ |
+ ))+ |
+ |
| 263 | ||||
| 264 | ++ |
+ # Adding EXROUTE+ |
+ ||
| 115 | +265 | 3x |
- adae <- Map(+ adex <- adex %>% |
|
| 116 | +266 | 3x |
- function(id, sid) {
+ dplyr::mutate(EXROUTE = dplyr::case_when( |
|
| 117 | -30x | +267 | +3x |
- n_aes <- sample(c(0, seq_len(max_n_aes)), 1)+ PARCAT1 == "INDIVIDUAL" ~ sample(c("INTRAVENOUS", "SUBCUTANEOUS"),
|
| 118 | -30x | +268 | +3x |
- i <- sample(seq_len(nrow(lookup_ae)), n_aes, TRUE)+ nrow(adex), |
| 119 | -30x | +269 | +3x |
- dplyr::mutate(+ replace = TRUE, |
| 120 | -30x | +270 | +3x |
- lookup_ae[i, ],+ prob = c(0.9, 0.1) |
| 121 | -30x | +|||
| 271 | +
- USUBJID = id,+ ), |
|||
| 122 | -30x | +272 | +3x |
- STUDYID = sid+ TRUE ~ "" |
| 123 | +273 |
- )+ )) |
||
| 124 | +274 |
- },+ + |
+ ||
| 275 | ++ |
+ # Fix VISIT according to AVISIT |
||
| 125 | +276 | 3x |
- adsl$USUBJID,+ adex <- adex %>% |
|
| 126 | +277 | 3x |
- adsl$STUDYID+ dplyr::mutate(VISIT = AVISIT) |
|
| 127 | +278 |
- ) %>%+ |
||
| 128 | -3x | +|||
| 279 | +
- Reduce(rbind, .) %>%+ # Hack for VISITDY - to fix in ADSL |
|||
| 129 | +280 | 3x |
- `[`(c(10, 11, 1, 2, 3, 4, 5, 6, 7, 8, 9)) %>%+ visit_levels <- str_extract(levels(adex$VISIT), pattern = "[0-9]+") |
|
| 130 | +281 | 3x |
- dplyr::mutate(AETERM = gsub("dcd", "trm", AEDECOD)) %>%
+ vl_extracted <- vapply(visit_levels, function(x) as.numeric(x[2]), numeric(1)) |
|
| 131 | +282 | 3x |
- dplyr::mutate(AESEV = dplyr::case_when(+ vl_extracted <- c(-1, 1, vl_extracted[!is.na(vl_extracted)]) |
|
| 132 | -3x | +|||
| 283 | +
- AETOXGR == 1 ~ "MILD",+ + |
+ |||
| 284 | ++ |
+ # Adding VISITDY |
||
| 133 | +285 | 3x |
- AETOXGR %in% c(2, 3) ~ "MODERATE",+ adex <- adex %>% |
|
| 134 | +286 | 3x |
- AETOXGR %in% c(4, 5) ~ "SEVERE"+ dplyr::mutate(VISITDY = as.numeric(as.character(factor(VISIT, labels = vl_extracted)))) |
|
| 135 | +287 |
- ))+ |
||
| 136 | +288 |
-
+ # Exposure time stamps |
||
| 137 | +289 | 3x |
- adae <- var_relabel(+ adex <- adex %>% |
|
| 138 | +290 | 3x |
- adae,+ dplyr::mutate( |
|
| 139 | +291 | 3x |
- STUDYID = "Study Identifier",+ EXSTDTC = TRTSDTM + lubridate::days(VISITDY), |
|
| 140 | +292 | 3x |
- USUBJID = "Unique Subject Identifier"+ EXENDTC = EXSTDTC + lubridate::hours(1),+ |
+ |
| 293 | +3x | +
+ EXSTDY = VISITDY,+ |
+ ||
| 294 | +3x | +
+ EXENDY = VISITDY |
||
| 141 | +295 |
- )+ ) |
||
| 142 | +296 | |||
| 143 | +297 |
- # merge adsl to be able to add AE date and study day variables+ # Correcting last exposure to treatment |
||
| 144 | +298 | 3x |
- adae <- dplyr::inner_join(adae, adsl, by = c("STUDYID", "USUBJID")) %>%
+ adex <- adex %>% |
|
| 145 | +299 | 3x |
- dplyr::rowwise() %>%+ dplyr::group_by(SUBJID) %>% |
|
| 146 | +300 | 3x |
- dplyr::mutate(TRTENDT = lubridate::date(dplyr::case_when(+ dplyr::mutate(TRTEDTM = lubridate::as_datetime(max(EXENDTC, na.rm = TRUE))) %>% |
|
| 147 | +301 | 3x |
- is.na(TRTEDTM) ~ lubridate::floor_date(lubridate::date(TRTSDTM) + study_duration_secs, unit = "day"),+ dplyr::ungroup() |
|
| 148 | -3x | +|||
| 302 | +
- TRUE ~ TRTEDTM+ |
|||
| 149 | +303 |
- ))) %>%+ # Fixing Date - to add into ADSL |
||
| 150 | +304 | 3x |
- dplyr::mutate(ASTDTM = sample(+ adex <- adex %>% |
|
| 151 | +305 | 3x |
- seq(lubridate::as_datetime(TRTSDTM), lubridate::as_datetime(TRTENDT), by = "day"),+ dplyr::mutate( |
|
| 152 | +306 | 3x |
- size = 1- |
- |
| 153 | -- |
- )) %>%+ TRTSDT = lubridate::date(TRTSDTM), |
||
| 154 | +307 | 3x |
- dplyr::mutate(ASTDY = ceiling(difftime(ASTDTM, TRTSDTM, units = "days"))) %>%+ TRTEDT = lubridate::date(TRTEDTM) |
|
| 155 | +308 |
- # add 1 to end of range incase both values passed to sample() are the same+ ) |
||
| 156 | -3x | +|||
| 309 | +
- dplyr::mutate(AENDTM = sample(+ |
|||
| 157 | -3x | +|||
| 310 | +
- seq(lubridate::as_datetime(ASTDTM), lubridate::as_datetime(TRTENDT + 1), by = "day"),+ # Fixing analysis time stamps |
|||
| 158 | +311 | 3x |
- size = 1+ adex <- adex %>% |
|
| 159 | -+ | |||
| 312 | +3x |
- )) %>%+ dplyr::mutate( |
||
| 160 | +313 | 3x |
- dplyr::mutate(AENDY = ceiling(difftime(AENDTM, TRTSDTM, units = "days"))) %>%+ ASTDY = EXSTDY, |
|
| 161 | +314 | 3x |
- dplyr::mutate(LDOSEDTM = dplyr::case_when(+ AENDY = EXENDY, |
|
| 162 | +315 | 3x |
- TRTSDTM < ASTDTM ~ lubridate::as_datetime(stats::runif(1, TRTSDTM, ASTDTM)),+ ASTDTM = EXSTDTC, |
|
| 163 | +316 | 3x |
- TRUE ~ ASTDTM+ AENDTM = EXENDTC |
|
| 164 | +317 |
- )) %>%+ ) |
||
| 165 | -3x | +|||
| 318 | +
- dplyr::mutate(LDRELTM = as.numeric(difftime(ASTDTM, LDOSEDTM, units = "mins"))) %>%+ |
|||
| 166 | +319 | 3x |
- dplyr::select(-TRTENDT) %>%+ if (length(na_vars) > 0 && na_percentage > 0) {
|
|
| 167 | -3x | +|||
| 320 | +! |
- dplyr::ungroup() %>%+ adex <- mutate_na(ds = adex, na_vars = na_vars, na_percentage = na_percentage) |
||
| 168 | -3x | +|||
| 321 | +
- dplyr::arrange(STUDYID, USUBJID, ASTDTM, AETERM)+ } |
|||
| 169 | +322 | |||
| 170 | -3x | +|||
| 323 | +
- adae <- adae %>%+ # apply metadata |
|||
| 171 | +324 | 3x |
- dplyr::group_by(USUBJID) %>%+ adex <- apply_metadata(adex, "metadata/ADEX.yml") |
|
| 172 | -3x | +|||
| 325 | +
- dplyr::mutate(AESEQ = seq_len(dplyr::n())) %>%+ } |
|||
| 173 | -3x | +|||
| 326 | +
- dplyr::mutate(ASEQ = AESEQ) %>%+ |
|||
| 174 | -3x | +|||
| 327 | +
- dplyr::ungroup() %>%+ # Equivalent of stringr::str_extract_all() |
|||
| 175 | -3x | +|||
| 328 | +
- dplyr::arrange(+ str_extract <- function(string, pattern) {
|
|||
| 176 | -3x | +329 | +2850x |
- STUDYID,+ regmatches(string, gregexpr(pattern, string)) |
| 177 | -3x | +|||
| 330 | +
- USUBJID,+ } |
|||
| 178 | -3x | +
| 1 | +
- ASTDTM,+ #' Adverse Event Analysis Dataset (ADAE) |
|||
| 179 | -3x | +|||
| 2 | +
- AETERM,+ #' |
|||
| 180 | -3x | +|||
| 3 | +
- AESEQ+ #' @description `r lifecycle::badge("stable")`
|
|||
| 181 | +4 |
- )+ #' |
||
| 182 | +5 |
-
+ #' Function for generating random Adverse Event Analysis Dataset for a given |
||
| 183 | -3x | +|||
| 6 | +
- outcomes <- c(+ #' Subject-Level Analysis Dataset. |
|||
| 184 | -3x | +|||
| 7 | +
- "UNKNOWN",+ #' |
|||
| 185 | -3x | +|||
| 8 | +
- "NOT RECOVERED/NOT RESOLVED",+ #' @details One record per each record in the corresponding SDTM domain. |
|||
| 186 | -3x | +|||
| 9 | +
- "RECOVERED/RESOLVED WITH SEQUELAE",+ #' |
|||
| 187 | -3x | +|||
| 10 | +
- "RECOVERING/RESOLVING",+ #' Keys: `STUDYID`, `USUBJID`, `ASTDTM`, `AETERM`, `AESEQ` |
|||
| 188 | -3x | +|||
| 11 | +
- "RECOVERED/RESOLVED"+ #' |
|||
| 189 | +12 |
- )+ #' @inheritParams argument_convention |
||
| 190 | +13 |
-
+ #' @param max_n_aes (`integer`)\cr Maximum number of AEs per patient. Defaults to 10. |
||
| 191 | -3x | +|||
| 14 | +
- actions <- c(+ #' @template param_cached |
|||
| 192 | -3x | +|||
| 15 | +
- "DOSE RATE REDUCED",+ #' @templateVar data adae |
|||
| 193 | -3x | +|||
| 16 | +
- "UNKNOWN",+ #' |
|||
| 194 | -3x | +|||
| 17 | +
- "NOT APPLICABLE",+ #' @return `data.frame` |
|||
| 195 | -3x | +|||
| 18 | +
- "DRUG INTERRUPTED",+ #' @export |
|||
| 196 | -3x | +|||
| 19 | +
- "DRUG WITHDRAWN",+ #' |
|||
| 197 | -3x | +|||
| 20 | +
- "DOSE INCREASED",+ #' @examples |
|||
| 198 | -3x | +|||
| 21 | +
- "DOSE NOT CHANGED",+ #' adsl <- radsl(N = 10, study_duration = 2, seed = 1) |
|||
| 199 | -3x | +|||
| 22 | +
- "DOSE REDUCED",+ #' |
|||
| 200 | -3x | +|||
| 23 | +
- "NOT EVALUABLE"+ #' adae <- radae(adsl, seed = 2) |
|||
| 201 | +24 |
- )+ #' adae |
||
| 202 | +25 |
-
+ #' |
||
| 203 | -3x | +|||
| 26 | +
- adae <- adae %>%+ #' # Add metadata. |
|||
| 204 | -3x | +|||
| 27 | +
- dplyr::mutate(AEOUT = factor(ifelse(+ #' aag <- utils::read.table( |
|||
| 205 | -3x | +|||
| 28 | +
- AETOXGR == "5",+ #' sep = ",", header = TRUE, |
|||
| 206 | -3x | +|||
| 29 | +
- "FATAL",+ #' text = paste( |
|||
| 207 | -3x | +|||
| 30 | +
- as.character(sample_fct(outcomes, nrow(adae), prob = c(0.1, 0.2, 0.1, 0.3, 0.3)))+ #' "NAMVAR,SRCVAR,GRPTYPE,REFNAME,REFTERM,SCOPE", |
|||
| 208 | +31 |
- ))) %>%+ #' "CQ01NAM,AEDECOD,CUSTOM,D.2.1.5.3/A.1.1.1.1 AESI,dcd D.2.1.5.3,", |
||
| 209 | -3x | +|||
| 32 | +
- dplyr::mutate(AEACN = factor(ifelse(+ #' "CQ01NAM,AEDECOD,CUSTOM,D.2.1.5.3/A.1.1.1.1 AESI,dcd A.1.1.1.1,", |
|||
| 210 | -3x | +|||
| 33 | +
- AETOXGR == "5",+ #' "SMQ01NAM,AEDECOD,SMQ,C.1.1.1.3/B.2.2.3.1 AESI,dcd C.1.1.1.3,BROAD", |
|||
| 211 | -3x | +|||
| 34 | +
- "NOT EVALUABLE",+ #' "SMQ01NAM,AEDECOD,SMQ,C.1.1.1.3/B.2.2.3.1 AESI,dcd B.2.2.3.1,BROAD", |
|||
| 212 | -3x | +|||
| 35 | +
- 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)))+ #' "SMQ02NAM,AEDECOD,SMQ,Y.9.9.9.9/Z.9.9.9.9 AESI,dcd Y.9.9.9.9,NARROW", |
|||
| 213 | +36 |
- ))) %>%+ #' "SMQ02NAM,AEDECOD,SMQ,Y.9.9.9.9/Z.9.9.9.9 AESI,dcd Z.9.9.9.9,NARROW", |
||
| 214 | -3x | +|||
| 37 | +
- dplyr::mutate(AESDTH = dplyr::case_when(+ #' sep = "\n" |
|||
| 215 | -3x | +|||
| 38 | +
- AEOUT == "FATAL" ~ "Y",+ #' ), stringsAsFactors = FALSE |
|||
| 216 | -3x | +|||
| 39 | +
- TRUE ~ "N"+ #' ) |
|||
| 217 | +40 |
- )) %>%+ #' |
||
| 218 | -3x | +|||
| 41 | +
- dplyr::mutate(TRTEMFL = ifelse(ASTDTM >= TRTSDTM, "Y", "")) %>%+ #' adae <- radae(adsl, lookup_aag = aag) |
|||
| 219 | -3x | +|||
| 42 | +
- dplyr::mutate(AECONTRT = sample(c("Y", "N"), prob = c(0.4, 0.6), size = dplyr::n(), replace = TRUE)) %>%
+ #' |
|||
| 220 | -3x | +|||
| 43 | +
- dplyr::mutate(+ #' with( |
|||
| 221 | -3x | +|||
| 44 | +
- ANL01FL = ifelse(TRTEMFL == "Y" & ASTDTM <= TRTEDTM + lubridate::month(1), "Y", "")+ #' adae, |
|||
| 222 | +45 |
- ) %>%+ #' cbind( |
||
| 223 | -3x | +|||
| 46 | +
- dplyr::mutate(ANL01FL = ifelse(is.na(ANL01FL), "", ANL01FL))+ #' table(AEDECOD, SMQ01NAM), |
|||
| 224 | +47 |
-
+ #' table(AEDECOD, CQ01NAM) |
||
| 225 | -3x | +|||
| 48 | +
- adae <- adae %>%+ #' ) |
|||
| 226 | -3x | +|||
| 49 | +
- dplyr::mutate(AERELNST = sample(c("Y", "N"), prob = c(0.4, 0.6), size = dplyr::n(), replace = TRUE)) %>%
+ #' ) |
|||
| 227 | -3x | +|||
| 50 | +
- dplyr::mutate(AEACNOTH = sample(+ radae <- function(adsl, |
|||
| 228 | -3x | +|||
| 51 | +
- x = c("MEDICATION", "PROCEDURE/SURGERY", "SUBJECT DISCONTINUED FROM STUDY", "NONE"),
+ max_n_aes = 10L, |
|||
| 229 | -3x | +|||
| 52 | +
- prob = c(0.2, 0.4, 0.2, 0.2),+ lookup = NULL, |
|||
| 230 | -3x | +|||
| 53 | +
- size = dplyr::n(),+ lookup_aag = NULL, |
|||
| 231 | -3x | +|||
| 54 | +
- replace = TRUE+ seed = NULL, |
|||
| 232 | +55 |
- ))+ na_percentage = 0, |
||
| 233 | +56 |
-
+ na_vars = list( |
||
| 234 | +57 |
- # Split metadata for AEs of special interest (AESI).+ AEBODSYS = c(NA, 0.1), |
||
| 235 | -3x | +|||
| 58 | +
- l_aag <- split(aag, interaction(aag$NAMVAR, aag$SRCVAR, aag$GRPTYPE, drop = TRUE))+ AEDECOD = c(1234, 0.1), |
|||
| 236 | +59 |
-
+ AETOXGR = c(1234, 0.1) |
||
| 237 | +60 |
- # Create AESI flags+ ),+ |
+ ||
| 61 | ++ |
+ cached = FALSE) {
|
||
| 238 | -3x | +62 | +4x |
- l_aesi <- lapply(l_aag, function(d_adag, d_adae) {
+ checkmate::assert_flag(cached) |
| 239 | -9x | +63 | +4x |
- names(d_adag)[names(d_adag) == "REFTERM"] <- d_adag$SRCVAR[1]+ if (cached) {
|
| 240 | -9x | +64 | +1x |
- names(d_adag)[names(d_adag) == "REFNAME"] <- d_adag$NAMVAR[1]+ return(get_cached_data("cadae"))
|
| 241 | +65 | ++ |
+ }+ |
+ |
| 66 | ||||
| 242 | -9x | +67 | +3x |
- if (d_adag$GRPTYPE[1] == "CUSTOM") {
+ checkmate::assert_data_frame(adsl) |
| 243 | +68 | 3x |
- d_adag <- d_adag[-which(names(d_adag) == "SCOPE")]+ checkmate::assert_integer(max_n_aes, len = 1, any.missing = FALSE) |
|
| 244 | -6x | +69 | +3x |
- } else if (d_adag$GRPTYPE[1] == "SMQ") {
+ checkmate::assert_number(seed, null.ok = TRUE) |
| 245 | -6x | +70 | +3x |
- names(d_adag)[names(d_adag) == "SCOPE"] <- paste0(substr(d_adag$NAMVAR[1], 1, 5), "SC")+ checkmate::assert_number(na_percentage, lower = 0, upper = 1) |
| 246 | -+ | |||
| 71 | +3x |
- }+ checkmate::assert_true(na_percentage < 1) |
||
| 247 | +72 | |||
| 248 | -9x | +|||
| 73 | +
- d_adag <- d_adag[-which(names(d_adag) %in% c("NAMVAR", "SRCVAR", "GRPTYPE"))]
+ # check lookup parameters |
|||
| 249 | -9x | +74 | +3x |
- d_new <- dplyr::left_join(x = d_adae, y = d_adag, by = intersect(names(d_adae), names(d_adag)))+ checkmate::assert_data_frame(lookup, null.ok = TRUE) |
| 250 | -9x | +75 | +3x |
- d_new[, dplyr::setdiff(names(d_new), names(d_adae)), drop = FALSE]+ lookup_ae <- if (!is.null(lookup)) {
|
| 251 | -3x | +|||
| 76 | +! |
- }, adae)+ lookup |
||
| 252 | +77 |
-
+ } else {
|
||
| 253 | +78 | 3x |
- adae <- dplyr::bind_cols(adae, l_aesi)- |
- |
| 254 | -- |
-
+ tibble::tribble( |
||
| 255 | +79 | 3x |
- adae <- dplyr::mutate(adae, AERELNST = sample(+ ~AEBODSYS, ~AELLT, ~AEDECOD, ~AEHLT, ~AEHLGT, ~AETOXGR, ~AESOC, ~AESER, ~AEREL, |
|
| 256 | +80 | 3x |
- x = c("CONCURRENT ILLNESS", "OTHER", "DISEASE UNDER STUDY", "NONE"),
+ "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", |
|
| 257 | +81 | 3x |
- prob = c(0.3, 0.3, 0.3, 0.1),+ "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", |
|
| 258 | +82 | 3x |
- size = dplyr::n(),+ "cl B.1", "llt B.1.1.1.1", "dcd B.1.1.1.1", "hlt B.1.1.1", "hlgt B.1.1", "5", "cl B", "Y", "Y", |
|
| 259 | +83 | 3x |
- replace = TRUE- |
- |
| 260 | -- |
- ))+ "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", |
||
| 261 | -+ | |||
| 84 | +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", |
||
| 262 | -+ | |||
| 85 | +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", |
||
| 263 | +86 | 3x |
- adae <- adae %>%+ "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", |
|
| 264 | +87 | 3x |
- dplyr::mutate(AES_FLAG = sample(+ "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", |
|
| 265 | +88 | 3x |
- x = c("AESLIFE", "AESHOSP", "AESDISAB", "AESCONG", "AESMIE"),
+ "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", |
|
| 266 | +89 | 3x |
- prob = c(0.1, 0.2, 0.2, 0.2, 0.3),+ "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" |
|
| 267 | -3x | +|||
| 90 | +
- size = dplyr::n(),+ ) |
|||
| 268 | -3x | +|||
| 91 | +
- replace = TRUE+ } |
|||
| 269 | +92 |
- )) %>%+ |
||
| 270 | +93 | 3x |
- dplyr::mutate(AES_FLAG = dplyr::case_when(+ checkmate::assert_data_frame(lookup_aag, null.ok = TRUE) |
|
| 271 | +94 | 3x |
- AESDTH == "Y" ~ "AESDTH",+ aag <- if (!is.null(lookup_aag)) {
|
|
| 272 | -3x | +|||
| 95 | +! |
- TRUE ~ AES_FLAG+ lookup_aag |
||
| 273 | +96 |
- )) %>%+ } else {
|
||
| 274 | +97 | 3x |
- dplyr::mutate(+ aag <- utils::read.table( |
|
| 275 | +98 | 3x |
- AESCONG = ifelse(AES_FLAG == "AESCONG", "Y", "N"),+ sep = ",", header = TRUE, |
|
| 276 | +99 | 3x |
- AESDISAB = ifelse(AES_FLAG == "AESDISAB", "Y", "N"),+ text = paste( |
|
| 277 | +100 | 3x |
- AESHOSP = ifelse(AES_FLAG == "AESHOSP", "Y", "N"),+ "NAMVAR,SRCVAR,GRPTYPE,REFNAME,REFTERM,SCOPE", |
|
| 278 | +101 | 3x |
- AESLIFE = ifelse(AES_FLAG == "AESLIFE", "Y", "N"),+ "CQ01NAM,AEDECOD,CUSTOM,D.2.1.5.3/A.1.1.1.1 AESI,dcd D.2.1.5.3,", |
|
| 279 | +102 | 3x |
- AESMIE = ifelse(AES_FLAG == "AESMIE", "Y", "N")+ "CQ01NAM,AEDECOD,CUSTOM,D.2.1.5.3/A.1.1.1.1 AESI,dcd A.1.1.1.1,", |
|
| 280 | -+ | |||
| 103 | +3x |
- ) %>%+ "SMQ01NAM,AEDECOD,SMQ,C.1.1.1.3/B.2.2.3.1 AESI,dcd C.1.1.1.3,BROAD", |
||
| 281 | +104 | 3x |
- dplyr::select(-"AES_FLAG")+ "SMQ01NAM,AEDECOD,SMQ,C.1.1.1.3/B.2.2.3.1 AESI,dcd B.2.2.3.1,BROAD", |
|
| 282 | -+ | |||
| 105 | +3x |
-
+ "SMQ02NAM,AEDECOD,SMQ,Y.9.9.9.9/Z.9.9.9.9 AESI,dcd Y.9.9.9.9,NARROW", |
||
| 283 | +106 | 3x |
- if (length(na_vars) > 0 && na_percentage > 0) {
+ "SMQ02NAM,AEDECOD,SMQ,Y.9.9.9.9/Z.9.9.9.9 AESI,dcd Z.9.9.9.9,NARROW", |
|
| 284 | -! | +|||
| 107 | +3x |
- adae <- mutate_na(ds = adae, na_vars = na_vars, na_percentage = na_percentage)+ sep = "\n"+ |
+ ||
| 108 | +3x | +
+ ), stringsAsFactors = FALSE |
||
| 285 | +109 |
- }+ ) |
||
| 286 | +110 |
-
+ } |
||
| 287 | +111 |
- # apply metadata+ |
||
| 288 | +112 | 3x |
- adae <- apply_metadata(adae, "metadata/ADAE.yml")+ if (!is.null(seed)) set.seed(seed)+ |
+ |
| 113 | +3x | +
+ study_duration_secs <- lubridate::seconds(attr(adsl, "study_duration_secs")) |
||
| 289 | +114 | |||
| 290 | +115 | 3x |
- return(adae)+ adae <- Map( |
|
| 291 | -+ | |||
| 116 | +3x |
- }+ function(id, sid) {
|
| 1 | -+ | |||
| 117 | +30x |
- #' ECG Analysis Dataset (ADEG)+ n_aes <- sample(c(0, seq_len(max_n_aes)), 1) |
||
| 2 | -+ | |||
| 118 | +30x |
- #'+ i <- sample(seq_len(nrow(lookup_ae)), n_aes, TRUE) |
||
| 3 | -+ | |||
| 119 | +30x |
- #' @description `r lifecycle::badge("stable")`
+ dplyr::mutate( |
||
| 4 | -+ | |||
| 120 | +30x |
- #'+ lookup_ae[i, ], |
||
| 5 | -+ | |||
| 121 | +30x |
- #' Function for generating random dataset from ECG Analysis Dataset for a given+ USUBJID = id, |
||
| 6 | -+ | |||
| 122 | +30x |
- #' Subject-Level Analysis Dataset.+ STUDYID = sid |
||
| 7 | +123 |
- #'+ ) |
||
| 8 | +124 |
- #' @details One record per subject per parameter per analysis visit per analysis date.+ }, |
||
| 9 | -+ | |||
| 125 | +3x |
- #'+ adsl$USUBJID, |
||
| 10 | -- |
- #' Keys: `STUDYID`, `USUBJID`, `PARAMCD`, `BASETYPE`, `AVISITN`, `ATPTN`, `DTYPE`, `ADTM`, `EGSEQ`, `ASPID`- |
- ||
| 11 | -- |
- #'- |
- ||
| 12 | -- |
- #' @inheritParams argument_convention- |
- ||
| 13 | -- |
- #' @param egcat (`character vector`)\cr EG category values.- |
- ||
| 14 | -+ | |||
| 126 | +3x |
- #' @param max_n_eg (`integer`)\cr Maximum number of EG results per patient. Defaults to 10.+ adsl$STUDYID |
||
| 15 | +127 |
- #' @template param_cached+ ) %>% |
||
| 16 | -+ | |||
| 128 | +3x |
- #' @templateVar data adeg+ Reduce(rbind, .) %>% |
||
| 17 | -+ | |||
| 129 | +3x |
- #'+ `[`(c(10, 11, 1, 2, 3, 4, 5, 6, 7, 8, 9)) %>% |
||
| 18 | -+ | |||
| 130 | +3x |
- #' @return `data.frame`+ dplyr::mutate(AETERM = gsub("dcd", "trm", AEDECOD)) %>%
|
||
| 19 | -+ | |||
| 131 | +3x |
- #' @export+ dplyr::mutate(AESEV = dplyr::case_when( |
||
| 20 | -+ | |||
| 132 | +3x |
- #'+ AETOXGR == 1 ~ "MILD", |
||
| 21 | -+ | |||
| 133 | +3x |
- #' @author tomlinsj, npaszty, Xuefeng Hou, dipietrc+ AETOXGR %in% c(2, 3) ~ "MODERATE", |
||
| 22 | -+ | |||
| 134 | +3x |
- #'+ AETOXGR %in% c(4, 5) ~ "SEVERE" |
||
| 23 | +135 |
- #' @examples+ )) |
||
| 24 | +136 |
- #' adsl <- radsl(N = 10, seed = 1, study_duration = 2)+ |
||
| 25 | -+ | |||
| 137 | +3x |
- #'+ adae <- rcd_var_relabel( |
||
| 26 | -+ | |||
| 138 | +3x |
- #' adeg <- radeg(adsl, visit_format = "WEEK", n_assessments = 7L, seed = 2)+ adae, |
||
| 27 | -+ | |||
| 139 | +3x |
- #' adeg+ STUDYID = "Study Identifier", |
||
| 28 | -+ | |||
| 140 | +3x |
- #'+ USUBJID = "Unique Subject Identifier" |
||
| 29 | +141 |
- #' adeg <- radeg(adsl, visit_format = "CYCLE", n_assessments = 2L, seed = 2)+ ) |
||
| 30 | +142 |
- #' adeg+ |
||
| 31 | +143 |
- radeg <- function(adsl,+ # merge adsl to be able to add AE date and study day variables |
||
| 32 | -+ | |||
| 144 | +3x |
- egcat = c("INTERVAL", "INTERVAL", "MEASUREMENT", "FINDING"),
+ adae <- dplyr::inner_join(adae, adsl, by = c("STUDYID", "USUBJID")) %>%
|
||
| 33 | -+ | |||
| 145 | +3x |
- param = c(+ dplyr::rowwise() %>% |
||
| 34 | -+ | |||
| 146 | +3x |
- "QT Duration",+ dplyr::mutate(TRTENDT = lubridate::date(dplyr::case_when( |
||
| 35 | -+ | |||
| 147 | +3x |
- "RR Duration",+ is.na(TRTEDTM) ~ lubridate::floor_date(lubridate::date(TRTSDTM) + study_duration_secs, unit = "day"), |
||
| 36 | -+ | |||
| 148 | +3x |
- "Heart Rate",+ TRUE ~ TRTEDTM |
||
| 37 | +149 |
- "ECG Interpretation"+ ))) %>% |
||
| 38 | -+ | |||
| 150 | +3x |
- ),+ dplyr::mutate(ASTDTM = sample( |
||
| 39 | -+ | |||
| 151 | +3x |
- paramcd = c("QT", "RR", "HR", "ECGINTP"),
+ seq(lubridate::as_datetime(TRTSDTM), lubridate::as_datetime(TRTENDT), by = "day"), |
||
| 40 | -+ | |||
| 152 | +3x |
- paramu = c("msec", "msec", "beats/min", ""),
+ size = 1 |
||
| 41 | +153 |
- visit_format = "WEEK",+ )) %>% |
||
| 42 | -+ | |||
| 154 | +3x |
- n_assessments = 5L,+ dplyr::mutate(ASTDY = ceiling(difftime(ASTDTM, TRTSDTM, units = "days"))) %>% |
||
| 43 | +155 |
- n_days = 5L,+ # add 1 to end of range incase both values passed to sample() are the same |
||
| 44 | -+ | |||
| 156 | +3x |
- max_n_eg = 10L,+ dplyr::mutate(AENDTM = sample( |
||
| 45 | -+ | |||
| 157 | +3x |
- lookup = NULL,+ seq(lubridate::as_datetime(ASTDTM), lubridate::as_datetime(TRTENDT + 1), by = "day"), |
||
| 46 | -+ | |||
| 158 | +3x |
- seed = NULL,+ size = 1 |
||
| 47 | +159 |
- na_percentage = 0,+ )) %>% |
||
| 48 | -+ | |||
| 160 | +3x |
- na_vars = list(+ dplyr::mutate(AENDY = ceiling(difftime(AENDTM, TRTSDTM, units = "days"))) %>% |
||
| 49 | -+ | |||
| 161 | +3x |
- ABLFL = c(1235, 0.1), BASE = c(NA, 0.1), BASEC = c(NA, 0.1),+ dplyr::mutate(LDOSEDTM = dplyr::case_when( |
||
| 50 | -+ | |||
| 162 | +3x |
- CHG = c(1234, 0.1), PCHG = c(1234, 0.1)+ TRTSDTM < ASTDTM ~ lubridate::as_datetime(stats::runif(1, TRTSDTM, ASTDTM)), |
||
| 51 | -+ | |||
| 163 | +3x |
- ),+ TRUE ~ ASTDTM |
||
| 52 | +164 |
- cached = FALSE) {
+ )) %>% |
||
| 53 | -4x | +165 | +3x |
- checkmate::assert_flag(cached)+ dplyr::mutate(LDRELTM = as.numeric(difftime(ASTDTM, LDOSEDTM, units = "mins"))) %>% |
| 54 | -4x | +166 | +3x |
- if (cached) {
+ dplyr::select(-TRTENDT) %>% |
| 55 | -1x | +167 | +3x |
- return(get_cached_data("cadeg"))
+ dplyr::ungroup() %>% |
| 56 | -+ | |||
| 168 | +3x |
- }+ dplyr::arrange(STUDYID, USUBJID, ASTDTM, AETERM) |
||
| 57 | +169 | |||
| 58 | -3x | -
- checkmate::assert_data_frame(adsl)- |
- ||
| 59 | -3x | -
- checkmate::assert_character(egcat, min.len = 1, any.missing = FALSE)- |
- ||
| 60 | +170 | 3x |
- checkmate::assert_character(param, min.len = 1, any.missing = FALSE)+ adae <- adae %>% |
|
| 61 | +171 | 3x |
- checkmate::assert_character(paramcd, min.len = 1, any.missing = FALSE)+ dplyr::group_by(USUBJID) %>% |
|
| 62 | +172 | 3x |
- checkmate::assert_character(paramu, min.len = 1, any.missing = FALSE)+ dplyr::mutate(AESEQ = seq_len(dplyr::n())) %>% |
|
| 63 | +173 | 3x |
- checkmate::assert_string(visit_format)+ dplyr::mutate(ASEQ = AESEQ) %>% |
|
| 64 | +174 | 3x |
- checkmate::assert_integer(n_assessments, len = 1, any.missing = FALSE)+ dplyr::ungroup() %>% |
|
| 65 | +175 | 3x |
- checkmate::assert_integer(n_days, len = 1, any.missing = FALSE)+ dplyr::arrange( |
|
| 66 | +176 | 3x |
- checkmate::assert_integer(max_n_eg, len = 1, any.missing = FALSE)+ STUDYID, |
|
| 67 | +177 | 3x |
- checkmate::assert_data_frame(lookup, null.ok = TRUE)+ USUBJID, |
|
| 68 | +178 | 3x |
- checkmate::assert_number(seed, null.ok = TRUE)+ ASTDTM, |
|
| 69 | +179 | 3x |
- checkmate::assert_number(na_percentage, lower = 0, upper = 1)+ AETERM, |
|
| 70 | +180 | 3x |
- checkmate::assert_true(na_percentage < 1)+ AESEQ |
|
| 71 | +181 |
-
+ ) |
||
| 72 | +182 |
- # validate and initialize related variables+ |
||
| 73 | +183 | 3x |
- egcat_init_list <- relvar_init(param, egcat)+ outcomes <- c( |
|
| 74 | +184 | 3x |
- param_init_list <- relvar_init(param, paramcd)+ "UNKNOWN", |
|
| 75 | +185 | 3x |
- unit_init_list <- relvar_init(param, paramu)+ "NOT RECOVERED/NOT RESOLVED", |
|
| 76 | -+ | |||
| 186 | +3x |
-
+ "RECOVERED/RESOLVED WITH SEQUELAE", |
||
| 77 | +187 | 3x |
- if (!is.null(seed)) {
+ "RECOVERING/RESOLVING", |
|
| 78 | +188 | 3x |
- set.seed(seed)+ "RECOVERED/RESOLVED" |
|
| 79 | +189 |
- }- |
- ||
| 80 | -3x | -
- study_duration_secs <- lubridate::seconds(attr(adsl, "study_duration_secs"))+ ) |
||
| 81 | +190 | |||
| 82 | +191 | 3x |
- adeg <- expand.grid(+ actions <- c( |
|
| 83 | +192 | 3x |
- STUDYID = unique(adsl$STUDYID),+ "DOSE RATE REDUCED", |
|
| 84 | +193 | 3x |
- USUBJID = adsl$USUBJID,+ "UNKNOWN", |
|
| 85 | +194 | 3x |
- PARAM = as.factor(param_init_list$relvar1),+ "NOT APPLICABLE", |
|
| 86 | +195 | 3x |
- AVISIT = visit_schedule(visit_format = visit_format, n_assessments = n_assessments, n_days = n_days),+ "DRUG INTERRUPTED", |
|
| 87 | +196 | 3x |
- stringsAsFactors = FALSE- |
- |
| 88 | -- |
- )- |
- ||
| 89 | -- | - - | -||
| 90 | -- |
- # assign related variable values: PARAMxEGCAT are related+ "DRUG WITHDRAWN", |
||
| 91 | +197 | 3x |
- adeg <- adeg %>% rel_var(+ "DOSE INCREASED", |
|
| 92 | +198 | 3x |
- var_name = "EGCAT",+ "DOSE NOT CHANGED", |
|
| 93 | +199 | 3x |
- related_var = "PARAM",+ "DOSE REDUCED", |
|
| 94 | +200 | 3x |
- var_values = egcat_init_list$relvar2+ "NOT EVALUABLE" |
|
| 95 | +201 |
) |
||
| 96 | +202 | |||
| 97 | -- |
- # assign related variable values: PARAMxPARAMCD are related- |
- ||
| 98 | +203 | 3x |
- adeg <- adeg %>% rel_var(+ adae <- adae %>% |
|
| 99 | +204 | 3x |
- var_name = "PARAMCD",+ dplyr::mutate(AEOUT = factor(ifelse( |
|
| 100 | +205 | 3x |
- related_var = "PARAM",+ AETOXGR == "5", |
|
| 101 | +206 | 3x |
- var_values = param_init_list$relvar2+ "FATAL", |
|
| 102 | -+ | |||
| 207 | +3x |
- )+ as.character(sample_fct(outcomes, nrow(adae), prob = c(0.1, 0.2, 0.1, 0.3, 0.3))) |
||
| 103 | +208 | - - | -||
| 104 | -3x | -
- adeg <- adeg %>% dplyr::mutate(AVAL = dplyr::case_when(+ ))) %>% |
||
| 105 | +209 | 3x |
- PARAMCD == "QT" ~ stats::rnorm(nrow(adeg), mean = 350, sd = 100),+ dplyr::mutate(AEACN = factor(ifelse( |
|
| 106 | +210 | 3x |
- PARAMCD == "RR" ~ stats::rnorm(nrow(adeg), mean = 1050, sd = 300),+ AETOXGR == "5", |
|
| 107 | +211 | 3x |
- PARAMCD == "HR" ~ stats::rnorm(nrow(adeg), mean = 70, sd = 20),+ "NOT EVALUABLE", |
|
| 108 | +212 | 3x |
- PARAMCD == "ECGINTP" ~ NA_real_- |
- |
| 109 | -- |
- ))+ 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))) |
||
| 110 | +213 |
-
+ ))) %>% |
||
| 111 | +214 | 3x |
- adeg <- adeg %>%+ dplyr::mutate(AESDTH = dplyr::case_when( |
|
| 112 | +215 | 3x |
- dplyr::mutate(EGTESTCD = PARAMCD) %>%+ AEOUT == "FATAL" ~ "Y", |
|
| 113 | +216 | 3x |
- dplyr::mutate(EGTEST = PARAM)+ TRUE ~ "N" |
|
| 114 | +217 |
-
+ )) %>% |
||
| 115 | +218 | 3x |
- adeg <- adeg %>% dplyr::mutate(AVISITN = dplyr::case_when(+ dplyr::mutate(TRTEMFL = ifelse(ASTDTM >= TRTSDTM, "Y", "")) %>% |
|
| 116 | +219 | 3x |
- AVISIT == "SCREENING" ~ -1,+ dplyr::mutate(AECONTRT = sample(c("Y", "N"), prob = c(0.4, 0.6), size = dplyr::n(), replace = TRUE)) %>%
|
|
| 117 | +220 | 3x |
- AVISIT == "BASELINE" ~ 0,+ dplyr::mutate( |
|
| 118 | +221 | 3x |
- (grepl("^WEEK", AVISIT) | grepl("^CYCLE", AVISIT)) ~ as.numeric(AVISIT) - 2,
+ ANL01FL = ifelse(TRTEMFL == "Y" & ASTDTM <= TRTEDTM + lubridate::month(1), "Y", "")+ |
+ |
| 222 | ++ |
+ ) %>% |
||
| 119 | +223 | 3x |
- TRUE ~ NA_real_+ dplyr::mutate(ANL01FL = ifelse(is.na(ANL01FL), "", ANL01FL)) |
|
| 120 | +224 |
- ))+ |
||
| 121 | -+ | |||
| 225 | +3x |
-
+ adae <- adae %>% |
||
| 122 | +226 | 3x |
- adeg <- adeg %>% rel_var(+ dplyr::mutate(AERELNST = sample(c("Y", "N"), prob = c(0.4, 0.6), size = dplyr::n(), replace = TRUE)) %>%
|
|
| 123 | +227 | 3x |
- var_name = "AVALU",+ dplyr::mutate(AEACNOTH = sample( |
|
| 124 | +228 | 3x |
- related_var = "PARAM",+ x = c("MEDICATION", "PROCEDURE/SURGERY", "SUBJECT DISCONTINUED FROM STUDY", "NONE"),
|
|
| 125 | +229 | 3x |
- var_values = unit_init_list$relvar2+ prob = c(0.2, 0.4, 0.2, 0.2),+ |
+ |
| 230 | +3x | +
+ size = dplyr::n(),+ |
+ ||
| 231 | +3x | +
+ replace = TRUE |
||
| 126 | +232 |
- )+ )) |
||
| 127 | +233 | |||
| 128 | +234 |
- # order to prepare for change from screening and baseline values+ # Split metadata for AEs of special interest (AESI). |
||
| 129 | +235 | 3x |
- adeg <- adeg[order(adeg$STUDYID, adeg$USUBJID, adeg$PARAMCD, adeg$AVISITN), ]+ l_aag <- split(aag, interaction(aag$NAMVAR, aag$SRCVAR, aag$GRPTYPE, drop = TRUE)) |
|
| 130 | +236 | |||
| 131 | -3x | -
- adeg <- Reduce(rbind, lapply(split(adeg, adeg$USUBJID), function(x) {
- |
- ||
| 132 | -30x | +|||
| 237 | +
- x$STUDYID <- adsl$STUDYID[which(adsl$USUBJID == x$USUBJID[1])]+ # Create AESI flags |
|||
| 133 | -30x | +238 | +3x |
- x$ABLFL <- ifelse(toupper(visit_format) == "WEEK" & x$AVISIT == "BASELINE",+ l_aesi <- lapply(l_aag, function(d_adag, d_adae) {
|
| 134 | -30x | +239 | +9x |
- "Y",+ names(d_adag)[names(d_adag) == "REFTERM"] <- d_adag$SRCVAR[1] |
| 135 | -30x | +240 | +9x |
- ifelse(toupper(visit_format) == "CYCLE" & x$AVISIT == "CYCLE 1 DAY 1", "Y", "")+ names(d_adag)[names(d_adag) == "REFNAME"] <- d_adag$NAMVAR[1] |
| 136 | +241 |
- )+ |
||
| 137 | -30x | +242 | +9x |
- x+ if (d_adag$GRPTYPE[1] == "CUSTOM") {
|
| 138 | -+ | |||
| 243 | +3x |
- }))+ d_adag <- d_adag[-which(names(d_adag) == "SCOPE")] |
||
| 139 | -+ | |||
| 244 | +6x |
-
+ } else if (d_adag$GRPTYPE[1] == "SMQ") {
|
||
| 140 | -3x | +245 | +6x |
- adeg$BASE <- ifelse(adeg$AVISITN >= 0, retain(adeg, adeg$AVAL, adeg$ABLFL == "Y"), adeg$AVAL)+ names(d_adag)[names(d_adag) == "SCOPE"] <- paste0(substr(d_adag$NAMVAR[1], 1, 5), "SC") |
| 141 | +246 |
-
+ } |
||
| 142 | -3x | +|||
| 247 | +
- adeg <- adeg %>% dplyr::mutate(ANRLO = dplyr::case_when(+ |
|||
| 143 | -3x | +248 | +9x |
- PARAMCD == "QT" ~ 200,+ d_adag <- d_adag[-which(names(d_adag) %in% c("NAMVAR", "SRCVAR", "GRPTYPE"))]
|
| 144 | -3x | +249 | +9x |
- PARAMCD == "RR" ~ 600,+ d_new <- dplyr::left_join(x = d_adae, y = d_adag, by = intersect(names(d_adae), names(d_adag))) |
| 145 | -3x | +250 | +9x |
- PARAMCD == "HR" ~ 40,+ d_new[, dplyr::setdiff(names(d_new), names(d_adae)), drop = FALSE] |
| 146 | +251 | 3x |
- PARAMCD == "ECGINTP" ~ NA_real_+ }, adae) |
|
| 147 | +252 |
- ))+ + |
+ ||
| 253 | +3x | +
+ adae <- dplyr::bind_cols(adae, l_aesi) |
||
| 148 | +254 | |||
| 149 | +255 | 3x |
- adeg <- adeg %>% dplyr::mutate(ANRHI = dplyr::case_when(+ adae <- dplyr::mutate(adae, AERELNST = sample( |
|
| 150 | +256 | 3x |
- PARAMCD == "QT" ~ 500,+ x = c("CONCURRENT ILLNESS", "OTHER", "DISEASE UNDER STUDY", "NONE"),
|
|
| 151 | +257 | 3x |
- PARAMCD == "RR" ~ 1500,+ prob = c(0.3, 0.3, 0.3, 0.1), |
|
| 152 | +258 | 3x |
- PARAMCD == "HR" ~ 100,+ size = dplyr::n(), |
|
| 153 | +259 | 3x |
- PARAMCD == "ECGINTP" ~ NA_real_+ replace = TRUE |
|
| 154 | +260 |
)) |
||
| 155 | +261 | |||
| 156 | -3x | +|||
| 262 | +
- adeg <- adeg %>% dplyr::mutate(ANRIND = factor(dplyr::case_when(+ |
|||
| 157 | +263 | 3x |
- AVAL < ANRLO ~ "LOW",+ adae <- adae %>% |
|
| 158 | +264 | 3x |
- AVAL >= ANRLO & AVAL <= ANRHI ~ "NORMAL",+ dplyr::mutate(AES_FLAG = sample( |
|
| 159 | +265 | 3x |
- AVAL > ANRHI ~ "HIGH"- |
- |
| 160 | -- |
- )))- |
- ||
| 161 | -- |
-
+ x = c("AESLIFE", "AESHOSP", "AESDISAB", "AESCONG", "AESMIE"),
|
||
| 162 | +266 | 3x |
- adeg <- adeg %>%+ prob = c(0.1, 0.2, 0.2, 0.2, 0.3), |
|
| 163 | +267 | 3x |
- dplyr::mutate(CHG = ifelse(AVISITN > 0, AVAL - BASE, NA)) %>%+ size = dplyr::n(), |
|
| 164 | +268 | 3x |
- dplyr::mutate(PCHG = ifelse(AVISITN > 0, 100 * (CHG / BASE), NA)) %>%+ replace = TRUE |
|
| 165 | -3x | +|||
| 269 | +
- dplyr::mutate(BASETYPE = "LAST") %>%+ )) %>% |
|||
| 166 | +270 | 3x |
- dplyr::group_by(USUBJID, PARAMCD, BASETYPE) %>%+ dplyr::mutate(AES_FLAG = dplyr::case_when( |
|
| 167 | +271 | 3x |
- dplyr::mutate(BNRIND = ANRIND[ABLFL == "Y"]) %>%+ AESDTH == "Y" ~ "AESDTH", |
|
| 168 | +272 | 3x |
- dplyr::ungroup() %>%+ TRUE ~ AES_FLAG |
|
| 169 | -3x | +|||
| 273 | +
- dplyr::mutate(ATPTN = 1) %>%+ )) %>% |
|||
| 170 | +274 | 3x |
- dplyr::mutate(DTYPE = NA) %>%+ dplyr::mutate( |
|
| 171 | +275 | 3x |
- var_relabel(+ AESCONG = ifelse(AES_FLAG == "AESCONG", "Y", "N"), |
|
| 172 | +276 | 3x |
- STUDYID = attr(adeg$STUDYID, "label"),+ AESDISAB = ifelse(AES_FLAG == "AESDISAB", "Y", "N"), |
|
| 173 | +277 | 3x |
- USUBJID = attr(adeg$USUBJID, "label")- |
- |
| 174 | -- |
- )- |
- ||
| 175 | -- |
-
+ AESHOSP = ifelse(AES_FLAG == "AESHOSP", "Y", "N"), |
||
| 176 | +278 | 3x |
- adeg$ANRIND <- factor(adeg$ANRIND, levels = c("LOW", "NORMAL", "HIGH"))
+ AESLIFE = ifelse(AES_FLAG == "AESLIFE", "Y", "N"), |
|
| 177 | +279 | 3x |
- adeg$BNRIND <- factor(adeg$BNRIND, levels = c("LOW", "NORMAL", "HIGH"))
+ AESMIE = ifelse(AES_FLAG == "AESMIE", "Y", "N") |
|
| 178 | +280 |
-
+ ) %>% |
||
| 179 | +281 | 3x |
- adeg <- var_relabel(+ dplyr::select(-"AES_FLAG") |
|
| 180 | -3x | +|||
| 282 | +
- adeg,+ |
|||
| 181 | +283 | 3x |
- STUDYID = "Study Identifier",+ if (length(na_vars) > 0 && na_percentage > 0) {
|
|
| 182 | -3x | +|||
| 284 | +! |
- USUBJID = "Unique Subject Identifier"+ adae <- mutate_na(ds = adae, na_vars = na_vars, na_percentage = na_percentage) |
||
| 183 | +285 |
- )+ } |
||
| 184 | +286 | |||
| 185 | +287 |
- # merge ADSL to be able to add EG date and study day variables+ # apply metadata |
||
| 186 | +288 | 3x |
- adeg <- dplyr::inner_join(+ adae <- apply_metadata(adae, "metadata/ADAE.yml") |
|
| 187 | -3x | +|||
| 289 | +
- adeg,+ |
|||
| 188 | +290 | 3x |
- adsl,+ return(adae) |
|
| 189 | -3x | +|||
| 291 | +
- by = c("STUDYID", "USUBJID")
+ } |
| 190 | +1 |
- ) %>%+ #' Time to Adverse Event Analysis Dataset (ADAETTE) |
||
| 191 | -3x | +|||
| 2 | +
- dplyr::rowwise() %>%+ #' |
|||
| 192 | -3x | +|||
| 3 | +
- dplyr::mutate(TRTENDT = lubridate::date(dplyr::case_when(+ #' @description `r lifecycle::badge("stable")`
|
|||
| 193 | -3x | +|||
| 4 | +
- is.na(TRTEDTM) ~ lubridate::floor_date(lubridate::date(TRTSDTM) + study_duration_secs, unit = "day"),+ #' |
|||
| 194 | -3x | +|||
| 5 | +
- TRUE ~ TRTEDTM+ #' Function to generate random Time-to-AE Dataset for a |
|||
| 195 | +6 |
- ))) %>%+ #' given Subject-Level Analysis Dataset. |
||
| 196 | -3x | +|||
| 7 | +
- dplyr::ungroup()+ #' |
|||
| 197 | +8 | - - | -||
| 198 | -3x | -
- adeg <- adeg %>%- |
- ||
| 199 | -3x | -
- dplyr::group_by(USUBJID) %>%- |
- ||
| 200 | -3x | -
- dplyr::arrange(USUBJID, AVISITN) %>%- |
- ||
| 201 | -3x | -
- dplyr::mutate(ADTM = rep(- |
- ||
| 202 | -3x | -
- sort(sample(- |
- ||
| 203 | -3x | -
- seq(lubridate::as_datetime(TRTSDTM[1]), lubridate::as_datetime(TRTENDT[1]), by = "day"),- |
- ||
| 204 | -3x | -
- size = nlevels(AVISIT)+ #' @details |
||
| 205 | +9 |
- )),+ #' |
||
| 206 | -3x | +|||
| 10 | +
- each = n() / nlevels(AVISIT)+ #' Keys: `STUDYID`, `USUBJID`, `PARAMCD` |
|||
| 207 | +11 |
- )) %>%+ #' |
||
| 208 | -3x | +|||
| 12 | +
- dplyr::ungroup() %>%+ #' @inheritParams argument_convention |
|||
| 209 | -3x | +|||
| 13 | +
- dplyr::mutate(ADY = ceiling(difftime(ADTM, TRTSDTM, units = "days"))) %>%+ #' @param event_descr (`character vector`)\cr Descriptions of events. Defaults to `NULL`. |
|||
| 210 | -3x | +|||
| 14 | +
- dplyr::select(-TRTENDT) %>%+ #' @param censor_descr (`character vector`)\cr Descriptions of censors. Defaults to `NULL`. |
|||
| 211 | -3x | +|||
| 15 | +
- dplyr::arrange(STUDYID, USUBJID, ADTM)+ #' @template param_cached |
|||
| 212 | +16 |
-
+ #' @templateVar data adaette |
||
| 213 | -3x | +|||
| 17 | +
- adeg <- adeg %>%+ #' |
|||
| 214 | -3x | +|||
| 18 | +
- dplyr::mutate(ASPID = sample(seq_len(dplyr::n()))) %>%+ #' @return `data.frame` |
|||
| 215 | -3x | +|||
| 19 | +
- dplyr::group_by(USUBJID) %>%+ #' @export |
|||
| 216 | -3x | +|||
| 20 | +
- dplyr::mutate(EGSEQ = seq_len(dplyr::n())) %>%+ #' |
|||
| 217 | -3x | +|||
| 21 | +
- dplyr::mutate(ASEQ = EGSEQ) %>%+ #' @author Xiuting Mi |
|||
| 218 | -3x | +|||
| 22 | +
- dplyr::ungroup() %>%+ #' |
|||
| 219 | -3x | +|||
| 23 | +
- dplyr::arrange(+ #' @examples |
|||
| 220 | -3x | +|||
| 24 | +
- STUDYID,+ #' adsl <- radsl(N = 10, seed = 1, study_duration = 2) |
|||
| 221 | -3x | +|||
| 25 | +
- USUBJID,+ #' |
|||
| 222 | -3x | +|||
| 26 | +
- PARAMCD,+ #' adaette <- radaette(adsl, seed = 2) |
|||
| 223 | -3x | +|||
| 27 | +
- BASETYPE,+ #' adaette |
|||
| 224 | -3x | +|||
| 28 | +
- AVISITN,+ radaette <- function(adsl, |
|||
| 225 | -3x | +|||
| 29 | +
- ATPTN,+ event_descr = NULL, |
|||
| 226 | -3x | +|||
| 30 | +
- DTYPE,+ censor_descr = NULL, |
|||
| 227 | -3x | +|||
| 31 | +
- ADTM,+ lookup = NULL, |
|||
| 228 | -3x | +|||
| 32 | +
- EGSEQ,+ seed = NULL, |
|||
| 229 | -3x | +|||
| 33 | +
- ASPID+ na_percentage = 0, |
|||
| 230 | +34 |
- )+ na_vars = list(CNSR = c(NA, 0.1), AVAL = c(1234, 0.1)), |
||
| 231 | +35 |
-
+ cached = FALSE) {
|
||
| 232 | -3x | +36 | +6x |
- adeg <- adeg %>% dplyr::mutate(ONTRTFL = factor(dplyr::case_when(+ checkmate::assert_flag(cached) |
| 233 | -3x | +37 | +6x |
- !AVISIT %in% c("SCREENING", "BASELINE") ~ "Y",
+ if (cached) {
|
| 234 | -3x | +38 | +1x |
- TRUE ~ ""+ return(get_cached_data("cadaette"))
|
| 235 | +39 |
- )))+ } |
||
| 236 | +40 | |||
| 237 | -3x | +41 | +5x |
- adeg <- adeg %>% dplyr::mutate(AVALC = ifelse(+ checkmate::assert_data_frame(adsl) |
| 238 | -3x | +42 | +5x |
- PARAMCD == "ECGINTP",+ checkmate::assert_character(censor_descr, null.ok = TRUE, min.len = 1, any.missing = FALSE) |
| 239 | -3x | +43 | +5x |
- as.character(sample_fct(c("ABNORMAL", "NORMAL"), nrow(adeg), prob = c(0.25, 0.75))),
+ checkmate::assert_character(event_descr, null.ok = TRUE, min.len = 1, any.missing = FALSE) |
| 240 | -3x | -
- as.character(AVAL)- |
- ||
| 241 | -+ | 44 | +5x |
- ))+ checkmate::assert_number(seed, null.ok = TRUE) |
| 242 | -+ | |||
| 45 | +5x |
-
+ checkmate::assert_number(na_percentage, lower = 0, upper = 1) |
||
| 243 | -+ | |||
| 46 | +5x |
- # Temporarily creating a row_check column to easily match newly created+ checkmate::assert_true(na_percentage < 1) |
||
| 244 | +47 |
- # observations with their row correct arrangement.+ |
||
| 245 | -3x | +48 | +5x |
- adeg <- adeg %>%+ checkmate::assert_data_frame(lookup, null.ok = TRUE) |
| 246 | -3x | +49 | +5x |
- dplyr::mutate(row_check = seq_len(nrow(adeg)))+ lookup_adaette <- if (!is.null(lookup)) {
|
| 247 | -+ | |||
| 50 | +! |
-
+ lookup |
||
| 248 | +51 |
- # Created function to add in new observations for DTYPE, "MINIMUM" & "MAXIMUM" in this case.+ } else {
|
||
| 249 | -3x | +52 | +5x |
- get_groups <- function(data,+ tibble::tribble( |
| 250 | -3x | +53 | +5x |
- minimum) {
+ ~ARM, ~CATCD, ~CAT, ~LAMBDA, ~CNSR_P, |
| 251 | -6x | +54 | +5x |
- data <- data %>%+ "ARM A", "1", "any adverse event", 1 / 80, 0.4, |
| 252 | -6x | +55 | +5x |
- dplyr::group_by(USUBJID, PARAMCD, BASETYPE) %>%+ "ARM B", "1", "any adverse event", 1 / 100, 0.2, |
| 253 | -6x | +56 | +5x |
- dplyr::arrange(ADTM, ASPID, EGSEQ) %>%+ "ARM C", "1", "any adverse event", 1 / 60, 0.42, |
| 254 | -6x | +57 | +5x |
- dplyr::filter(+ "ARM A", "2", "any serious adverse event", 1 / 100, 0.3, |
| 255 | -6x | +58 | +5x |
- (AVISIT != "BASELINE" & AVISIT != "SCREENING") &+ "ARM B", "2", "any serious adverse event", 1 / 150, 0.1, |
| 256 | -6x | -
- (ONTRTFL == "Y" | ADTM <= TRTSDTM)- |
- ||
| 257 | -- |
- ) %>%- |
- ||
| 258 | -+ | 59 | +5x |
- {
+ "ARM C", "2", "any serious adverse event", 1 / 80, 0.32, |
| 259 | -6x | +60 | +5x |
- if (minimum == TRUE) {
+ "ARM A", "3", "a grade 3-5 adverse event", 1 / 80, 0.2, |
| 260 | -3x | +61 | +5x |
- dplyr::filter(., AVAL == min(AVAL)) %>%+ "ARM B", "3", "a grade 3-5 adverse event", 1 / 100, 0.08, |
| 261 | -3x | +62 | +5x |
- dplyr::mutate(., DTYPE = "MINIMUM", AVISIT = "POST-BASELINE MINIMUM")+ "ARM C", "3", "a grade 3-5 adverse event", 1 / 60, 0.23 |
| 262 | +63 |
- } else {
- |
- ||
| 263 | -3x | -
- dplyr::filter(., AVAL == max(AVAL)) %>%- |
- ||
| 264 | -3x | -
- dplyr::mutate(., DTYPE = "MAXIMUM", AVISIT = "POST-BASELINE MAXIMUM")+ ) |
||
| 265 | +64 |
- }+ } |
||
| 266 | +65 |
- } %>%+ |
||
| 267 | -6x | +66 | +5x |
- dplyr::slice(1) %>%+ if (!is.null(seed)) {
|
| 268 | -6x | +67 | +5x |
- dplyr::ungroup()+ set.seed(seed) |
| 269 | +68 |
-
+ } |
||
| 270 | -6x | -
- return(data)- |
- ||
| 271 | -+ | 69 | +5x |
- }+ study_duration_secs <- lubridate::seconds(attr(adsl, "study_duration_secs")) |
| 272 | +70 | |||
| 273 | -- |
- # Binding the new observations to the dataset from the function above and rearranging in the correct order.- |
- ||
| 274 | -3x | -
- adeg <- rbind(adeg, get_groups(adeg, TRUE), get_groups(adeg, FALSE)) %>%- |
- ||
| 275 | -3x | -
- dplyr::arrange(row_check) %>%- |
- ||
| 276 | -3x | -
- dplyr::group_by(USUBJID, PARAMCD, BASETYPE) %>%- |
- ||
| 277 | -3x | -
- dplyr::arrange(AVISIT, .by_group = TRUE) %>%- |
- ||
| 278 | -3x | +71 | +5x |
- dplyr::ungroup()+ evntdescr_sel <- if (!is.null(event_descr)) {
|
| 279 | -+ | |||
| 72 | +! |
-
+ event_descr |
||
| 280 | +73 |
- # Dropping the "row_check" column created above.+ } else {
|
||
| 281 | -3x | +74 | +5x |
- adeg <- adeg[, -which(names(adeg) %in% c("row_check"))]
+ "Preferred Term" |
| 282 | +75 |
-
+ } |
||
| 283 | +76 |
- # Created function to easily match rows which comply to ONTRTFL derivation- |
- ||
| 284 | -3x | -
- flag_variables <- function(data, worst_obs) {
+
|
||
| 285 | -6x | +77 | +5x |
- data_compare <- data %>%+ cnsdtdscr_sel <- if (!is.null(censor_descr)) {
|
| 286 | -6x | +|||
| 78 | +! |
- dplyr::mutate(row_check = seq_len(nrow(data)))+ censor_descr |
||
| 287 | +79 |
-
+ } else {
|
||
| 288 | -6x | -
- data <- data_compare %>%- |
- ||
| 289 | -+ | 80 | +5x |
- {
+ c( |
| 290 | -6x | +81 | +5x |
- if (worst_obs == FALSE) {
+ "Clinical Cut Off", |
| 291 | -3x | +82 | +5x |
- dplyr::group_by(., USUBJID, PARAMCD, BASETYPE, AVISIT) %>%+ "Completion or Discontinuation", |
| 292 | -3x | +83 | +5x |
- dplyr::arrange(., ADTM, ASPID, EGSEQ)+ "End of AE Reporting Period" |
| 293 | +84 |
- } else {
- |
- ||
| 294 | -3x | -
- dplyr::group_by(., USUBJID, PARAMCD, BASETYPE)+ ) |
||
| 295 | +85 |
- }+ } |
||
| 296 | +86 |
- } %>%+ |
||
| 297 | -6x | +87 | +5x |
- dplyr::filter(+ random_patient_data <- function(patient_info) {
|
| 298 | -6x | +88 | +50x |
- AVISITN > 0 & (ONTRTFL == "Y" | ADTM <= TRTSDTM) &+ startdt <- lubridate::date(patient_info$TRTSDTM) |
| 299 | -6x | -
- is.na(DTYPE)- |
- ||
| 300 | -- |
- ) %>%- |
- ||
| 301 | -+ | 89 | +50x |
- {
+ trtedtm <- lubridate::floor_date(dplyr::case_when( |
| 302 | -6x | +90 | +50x |
- if (worst_obs == TRUE) {
+ is.na(patient_info$TRTEDTM) ~ lubridate::date(patient_info$TRTSDTM) + study_duration_secs, |
| 303 | -3x | +91 | +50x |
- dplyr::arrange(., AVALC) %>% dplyr::filter(., ifelse(+ TRUE ~ lubridate::date(patient_info$TRTEDTM) |
| 304 | -3x | +92 | +50x |
- PARAMCD == "ECGINTP",+ ), unit = "day") |
| 305 | -3x | +93 | +50x |
- ifelse(AVALC == "ABNORMAL", AVALC == "ABNORMAL", AVALC == "NORMAL"),+ enddts <- c(patient_info$EOSDT, lubridate::date(trtedtm)) |
| 306 | -3x | -
- AVAL == min(AVAL)- |
- ||
| 307 | -- |
- ))- |
- ||
| 308 | -+ | 94 | +50x |
- } else {
+ enddts_min_index <- which.min(enddts) |
| 309 | -3x | +95 | +50x |
- dplyr::filter(., ifelse(+ adt <- enddts[enddts_min_index] |
| 310 | -3x | +96 | +50x |
- PARAMCD == "ECGINTP",+ adtm <- lubridate::as_datetime(adt) |
| 311 | -3x | +97 | +50x |
- AVALC == "ABNORMAL" | AVALC == "NORMAL",+ ady <- as.numeric(adt - startdt + 1) |
| 312 | -3x | -
- AVAL == min(AVAL)- |
- ||
| 313 | -- |
- ))- |
- ||
| 314 | -+ | 98 | +50x |
- }+ data.frame( |
| 315 | -+ | |||
| 99 | +50x |
- } %>%+ ARM = patient_info$ARM, |
||
| 316 | -6x | +100 | +50x |
- dplyr::slice(1) %>%+ STUDYID = patient_info$STUDYID, |
| 317 | -+ | |||
| 101 | +50x |
- {
+ SITEID = patient_info$SITEID, |
||
| 318 | -6x | +102 | +50x |
- if (worst_obs == TRUE) {
+ USUBJID = patient_info$USUBJID, |
| 319 | -3x | +103 | +50x |
- dplyr::mutate(., new_var = dplyr::case_when(+ PARAMCD = "AEREPTTE", |
| 320 | -3x | +104 | +50x |
- (AVALC == "ABNORMAL" | AVALC == "NORMAL") ~ "Y",+ PARAM = "Time to end of AE reporting period", |
| 321 | -3x | +105 | +50x |
- (!is.na(AVAL) & is.na(DTYPE)) ~ "Y",+ CNSR = 0, |
| 322 | -3x | +106 | +50x |
- TRUE ~ ""+ AVAL = lubridate::days(ady) / lubridate::years(1), |
| 323 | -+ | |||
| 107 | +50x |
- ))+ AVALU = "YEARS", |
||
| 324 | -+ | |||
| 108 | +50x |
- } else {
+ EVNTDESC = ifelse(enddts_min_index == 1, "Completion or Discontinuation", "End of AE Reporting Period"), |
||
| 325 | -3x | +109 | +50x |
- dplyr::mutate(., new_var = dplyr::case_when(+ CNSDTDSC = NA, |
| 326 | -3x | +110 | +50x |
- (AVALC == "ABNORMAL" | AVALC == "NORMAL") ~ "Y",+ ADTM = adtm, |
| 327 | -3x | +111 | +50x |
- (!is.na(AVAL) & is.na(DTYPE)) ~ "Y",+ ADY = ady, |
| 328 | -3x | +112 | +50x |
- TRUE ~ ""+ stringsAsFactors = FALSE |
| 329 | +113 |
- ))+ ) |
||
| 330 | +114 |
- }+ } |
||
| 331 | +115 |
- } %>%- |
- ||
| 332 | -6x | -
- dplyr::ungroup()+ |
||
| 333 | +116 |
-
+ # validate and initialize related variables for Hy's law |
||
| 334 | -6x | +117 | +5x |
- data_compare$new_var <- ifelse(data_compare$row_check %in% data$row_check, "Y", "")+ paramcd_hy <- c("HYSTTEUL", "HYSTTEBL")
|
| 335 | -6x | +118 | +5x |
- data_compare <- data_compare[, -which(names(data_compare) %in% c("row_check"))]
+ param_hy <- c("Time to Hy's Law Elevation in relation to ULN", "Time to Hy's Law Elevation in relation to Baseline")
|
| 336 | -+ | |||
| 119 | +5x |
-
+ param_init_list <- relvar_init(param_hy, paramcd_hy) |
||
| 337 | -6x | +120 | +5x |
- return(data_compare)+ adsl_hy <- dplyr::select(adsl, "STUDYID", "USUBJID", "TRTSDTM", "SITEID", "ARM") |
| 338 | +121 |
- }+ |
||
| 339 | +122 | - - | -||
| 340 | -3x | -
- adeg <- flag_variables(adeg, FALSE) %>% dplyr::rename(WORS01FL = "new_var")+ # create all combinations of unique values in STUDYID, USUBJID, PARAM, AVISIT |
||
| 341 | -3x | -
- adeg <- flag_variables(adeg, TRUE) %>% dplyr::rename(WORS02FL = "new_var")- |
- ||
| 342 | -+ | 123 | +5x |
-
+ adaette_hy <- expand.grid( |
| 343 | -3x | +124 | +5x |
- adeg <- adeg %>% dplyr::mutate(ANL01FL = factor(ifelse(+ STUDYID = unique(adsl$STUDYID), |
| 344 | -3x | +125 | +5x |
- (ABLFL == "Y" | (is.na(DTYPE) & WORS01FL == "Y")) &+ USUBJID = adsl$USUBJID, |
| 345 | -3x | +126 | +5x |
- (AVISIT != "SCREENING"),+ PARAM = as.factor(param_init_list$relvar1), |
| 346 | -3x | +127 | +5x |
- "Y",+ stringsAsFactors = FALSE |
| 347 | +128 |
- ""+ ) |
||
| 348 | +129 |
- )))+ |
||
| 349 | +130 |
-
+ # Add other variables to adaette_hy |
||
| 350 | -3x | +131 | +5x |
- adeg <- adeg %>%+ adaette_hy <- dplyr::left_join(adaette_hy, adsl_hy, by = c("STUDYID", "USUBJID")) %>%
|
| 351 | -3x | +132 | +5x |
- dplyr::group_by(USUBJID, PARAMCD, BASETYPE) %>%+ rel_var( |
| 352 | -3x | +133 | +5x |
- dplyr::mutate(BASEC = ifelse(+ var_name = "PARAMCD", |
| 353 | -3x | +134 | +5x |
- PARAMCD == "ECGINTP",+ related_var = "PARAM", |
| 354 | -3x | +135 | +5x |
- AVALC[AVISIT == "BASELINE"],+ var_values = param_init_list$relvar2+ |
+
| 136 | ++ |
+ ) %>% |
||
| 355 | -3x | +137 | +5x |
- as.character(BASE)+ dplyr::mutate( |
| 356 | -+ | |||
| 138 | +5x |
- )) %>%+ CNSR = sample(c(0, 1), prob = c(0.1, 0.9), size = dplyr::n(), replace = TRUE), |
||
| 357 | -3x | +139 | +5x |
- dplyr::mutate(ANL03FL = dplyr::case_when(+ EVNTDESC = dplyr::if_else( |
| 358 | -3x | +140 | +5x |
- DTYPE == "MINIMUM" ~ "Y",+ CNSR == 0, |
| 359 | -3x | +141 | +5x |
- ABLFL == "Y" & PARAMCD != "ECGINTP" ~ "Y",+ "First Post-Baseline Raised ALT or AST Elevation Result", |
| 360 | -3x | +142 | +5x |
- TRUE ~ ""+ NA_character_ |
| 361 | +143 |
- )) %>%+ ), |
||
| 362 | -3x | +144 | +5x |
- dplyr::mutate(ANL04FL = dplyr::case_when(+ CNSDTDSC = dplyr::if_else(CNSR == 0, NA_character_, |
| 363 | -3x | +145 | +5x |
- DTYPE == "MAXIMUM" ~ "Y",+ sample(c("Last Post-Baseline ALT or AST Result", "Treatment Start"),
|
| 364 | -3x | +146 | +5x |
- ABLFL == "Y" & PARAMCD != "ECGINTP" ~ "Y",+ prob = c(0.9, 0.1), |
| 365 | -3x | +147 | +5x |
- TRUE ~ ""+ size = dplyr::n(), replace = TRUE |
| 366 | +148 |
- )) %>%+ ) |
||
| 367 | -3x | +|||
| 149 | +
- dplyr::ungroup()+ ) |
|||
| 368 | +150 |
-
+ ) %>% |
||
| 369 | -3x | +151 | +5x |
- if (length(na_vars) > 0 && na_percentage > 0) {
+ dplyr::rowwise() %>% |
| 370 | -! | +|||
| 152 | +5x |
- adeg <- mutate_na(ds = adeg, na_vars = na_vars, na_percentage = na_percentage)+ dplyr::mutate(ADTM = dplyr::case_when( |
||
| 371 | -+ | |||
| 153 | +5x |
- }+ CNSDTDSC == "Treatment Start" ~ TRTSDTM, |
||
| 372 | -+ | |||
| 154 | +5x |
-
+ TRUE ~ TRTSDTM + sample(seq(0, study_duration_secs), size = dplyr::n(), replace = TRUE) |
||
| 373 | +155 |
- # apply metadata+ )) %>% |
||
| 374 | -3x | +156 | +5x |
- adeg <- apply_metadata(adeg, "metadata/ADEG.yml")+ dplyr::mutate( |
| 375 | -+ | |||
| 157 | +5x |
-
+ ADY_int = lubridate::date(ADTM) - lubridate::date(TRTSDTM) + 1, |
||
| 376 | -3x | +158 | +5x |
- return(adeg)+ ADY = as.numeric(ADY_int), |
| 377 | -+ | |||
| 159 | +5x |
- }+ AVAL = lubridate::days(ADY_int) / lubridate::weeks(1), |
| 1 | -+ | |||
| 160 | +5x |
- #' Time to Adverse Event Analysis Dataset (ADAETTE)+ AVALU = "WEEKS" |
||
| 2 | +161 |
- #'+ ) %>% |
||
| 3 | -+ | |||
| 162 | +5x |
- #' @description `r lifecycle::badge("stable")`
+ dplyr::select(-TRTSDTM, -ADY_int) |
||
| 4 | +163 |
- #'+ |
||
| 5 | -+ | |||
| 164 | +5x |
- #' Function to generate random Time-to-AE Dataset for a+ random_ae_data <- function(lookup_info, patient_info, patient_data) {
|
||
| 6 | -+ | |||
| 165 | +150x |
- #' given Subject-Level Analysis Dataset.+ cnsr <- sample(c(0, 1), 1, prob = c(1 - lookup_info$CNSR_P, lookup_info$CNSR_P)) |
||
| 7 | -+ | |||
| 166 | +150x |
- #'+ ae_rep_tte <- patient_data$AVAL[patient_data$PARAMCD == "AEREPTTE"] |
||
| 8 | -+ | |||
| 167 | +150x |
- #' @details+ data.frame( |
||
| 9 | -+ | |||
| 168 | +150x |
- #'+ ARM = rep(patient_data$ARM, 2), |
||
| 10 | -+ | |||
| 169 | +150x |
- #' Keys: `STUDYID`, `USUBJID`, `PARAMCD`+ STUDYID = rep(patient_data$STUDYID, 2), |
||
| 11 | -+ | |||
| 170 | +150x |
- #'+ SITEID = rep(patient_data$SITEID, 2), |
||
| 12 | -+ | |||
| 171 | +150x |
- #' @inheritParams argument_convention+ USUBJID = rep(patient_data$USUBJID, 2), |
||
| 13 | -+ | |||
| 172 | +150x |
- #' @param event_descr (`character vector`)\cr Descriptions of events. Defaults to `NULL`.+ PARAMCD = c( |
||
| 14 | -+ | |||
| 173 | +150x |
- #' @param censor_descr (`character vector`)\cr Descriptions of censors. Defaults to `NULL`.+ paste0("AETTE", lookup_info$CATCD),
|
||
| 15 | -+ | |||
| 174 | +150x |
- #' @template param_cached+ paste0("AETOT", lookup_info$CATCD)
|
||
| 16 | +175 |
- #' @templateVar data adaette+ ), |
||
| 17 | -+ | |||
| 176 | +150x |
- #'+ PARAM = c( |
||
| 18 | -+ | |||
| 177 | +150x |
- #' @return `data.frame`+ paste("Time to first occurrence of", lookup_info$CAT),
|
||
| 19 | -+ | |||
| 178 | +150x |
- #' @export+ paste("Number of occurrences of", lookup_info$CAT)
|
||
| 20 | +179 |
- #'+ ), |
||
| 21 | -+ | |||
| 180 | +150x |
- #' @author Xiuting Mi+ CNSR = c( |
||
| 22 | -+ | |||
| 181 | +150x |
- #'+ cnsr, |
||
| 23 | -+ | |||
| 182 | +150x |
- #' @examples+ NA |
||
| 24 | +183 |
- #' adsl <- radsl(N = 10, seed = 1, study_duration = 2)+ ), |
||
| 25 | -+ | |||
| 184 | +150x |
- #'+ AVAL = c( |
||
| 26 | +185 |
- #' adaette <- radaette(adsl, seed = 2)+ # We generate these values conditional on the censoring information. |
||
| 27 | +186 |
- #' adaette+ # If this time to event is censored, then there were no AEs reported and the time is set |
||
| 28 | +187 |
- radaette <- function(adsl,+ # to the AE reporting period time. Otherwise we draw from truncated distributions to make |
||
| 29 | +188 |
- event_descr = NULL,+ # sure that we are within the AE reporting time and above 0 AEs. |
||
| 30 | -+ | |||
| 189 | +150x |
- censor_descr = NULL,+ ifelse(cnsr == 1, ae_rep_tte, rtexp(1, lookup_info$LAMBDA * 365.25, r = ae_rep_tte)), |
||
| 31 | -+ | |||
| 190 | +150x |
- lookup = NULL,+ ifelse(cnsr == 1, 0, rtpois(1, lookup_info$LAMBDA * 365.25)) |
||
| 32 | +191 |
- seed = NULL,+ ), |
||
| 33 | -+ | |||
| 192 | +150x |
- na_percentage = 0,+ AVALU = c( |
||
| 34 | -+ | |||
| 193 | +150x |
- na_vars = list(CNSR = c(NA, 0.1), AVAL = c(1234, 0.1)),+ "YEARS",+ |
+ ||
| 194 | +150x | +
+ NA |
||
| 35 | +195 |
- cached = FALSE) {
+ ), |
||
| 36 | -6x | +196 | +150x |
- checkmate::assert_flag(cached)+ EVNTDESC = c( |
| 37 | -6x | +197 | +150x |
- if (cached) {
+ ifelse(cnsr == 0, sample(evntdescr_sel, 1), ""), |
| 38 | -1x | +198 | +150x |
- return(get_cached_data("cadaette"))
+ NA |
| 39 | +199 |
- }+ ), |
||
| 40 | -+ | |||
| 200 | +150x |
-
+ CNSDTDSC = c( |
||
| 41 | -5x | +201 | +150x |
- checkmate::assert_data_frame(adsl)+ ifelse(cnsr == 1, sample(cnsdtdscr_sel, 1), ""), |
| 42 | -5x | +202 | +150x | +
+ NA+ |
+
| 203 | +
- checkmate::assert_character(censor_descr, null.ok = TRUE, min.len = 1, any.missing = FALSE)+ ), |
|||
| 43 | -5x | +204 | +150x |
- checkmate::assert_character(event_descr, null.ok = TRUE, min.len = 1, any.missing = FALSE)+ stringsAsFactors = FALSE |
| 44 | -5x | +205 | +150x |
- checkmate::assert_number(seed, null.ok = TRUE)+ ) %>% dplyr::mutate( |
| 45 | -5x | +206 | +150x |
- checkmate::assert_number(na_percentage, lower = 0, upper = 1)+ ADY = dplyr::if_else(is.na(AVALU), NA_real_, ceiling(as.numeric(lubridate::dyears(AVAL), "days"))), |
| 46 | -5x | +207 | +150x |
- checkmate::assert_true(na_percentage < 1)+ ADTM = dplyr::if_else( |
| 47 | -+ | |||
| 208 | +150x |
-
+ is.na(AVALU), |
||
| 48 | -5x | +209 | +150x |
- checkmate::assert_data_frame(lookup, null.ok = TRUE)+ lubridate::as_datetime(NA), |
| 49 | -5x | +210 | +150x |
- lookup_adaette <- if (!is.null(lookup)) {
+ patient_info$TRTSDTM + lubridate::days(ADY) |
| 50 | -! | +|||
| 211 | +
- lookup+ ) |
|||
| 51 | +212 |
- } else {
+ ) |
||
| 52 | -5x | +|||
| 213 | +
- tibble::tribble(+ } |
|||
| 53 | -5x | +|||
| 214 | +
- ~ARM, ~CATCD, ~CAT, ~LAMBDA, ~CNSR_P,+ |
|||
| 54 | +215 | 5x |
- "ARM A", "1", "any adverse event", 1 / 80, 0.4,+ adaette <- split(adsl, adsl$USUBJID) %>% |
|
| 55 | +216 | 5x |
- "ARM B", "1", "any adverse event", 1 / 100, 0.2,+ lapply(function(patient_info) {
|
|
| 56 | -5x | +217 | +50x |
- "ARM C", "1", "any adverse event", 1 / 60, 0.42,+ patient_data <- random_patient_data(patient_info) |
| 57 | -5x | +218 | +50x |
- "ARM A", "2", "any serious adverse event", 1 / 100, 0.3,+ lookup_arm <- lookup_adaette %>% |
| 58 | -5x | +219 | +50x |
- "ARM B", "2", "any serious adverse event", 1 / 150, 0.1,+ dplyr::filter(ARM == as.character(patient_info$ARMCD)) |
| 59 | -5x | +220 | +50x |
- "ARM C", "2", "any serious adverse event", 1 / 80, 0.32,+ ae_data <- split(lookup_arm, lookup_arm$CATCD) %>% |
| 60 | -5x | +221 | +50x |
- "ARM A", "3", "a grade 3-5 adverse event", 1 / 80, 0.2,+ lapply(random_ae_data, patient_data = patient_data, patient_info = patient_info) %>% |
| 61 | -5x | +222 | +50x |
- "ARM B", "3", "a grade 3-5 adverse event", 1 / 100, 0.08,+ Reduce(rbind, .) |
| 62 | -5x | +223 | +50x |
- "ARM C", "3", "a grade 3-5 adverse event", 1 / 60, 0.23+ dplyr::bind_rows(patient_data, ae_data) |
| 63 | +224 |
- )+ }) %>% |
||
| 64 | -+ | |||
| 225 | +5x |
- }+ Reduce(rbind, .) %>% |
||
| 65 | -+ | |||
| 226 | +5x |
-
+ rcd_var_relabel( |
||
| 66 | +227 | 5x |
- if (!is.null(seed)) {
+ STUDYID = "Study Identifier", |
|
| 67 | +228 | 5x |
- set.seed(seed)+ USUBJID = "Unique Subject Identifier" |
|
| 68 | +229 |
- }- |
- ||
| 69 | -5x | -
- study_duration_secs <- lubridate::seconds(attr(adsl, "study_duration_secs"))+ ) |
||
| 70 | +230 | |||
| 71 | +231 | 5x |
- evntdescr_sel <- if (!is.null(event_descr)) {
+ adaette <- rcd_var_relabel( |
|
| 72 | -! | +|||
| 232 | +5x |
- event_descr+ adaette, |
||
| 73 | -+ | |||
| 233 | +5x |
- } else {
+ STUDYID = "Study Identifier", |
||
| 74 | +234 | 5x |
- "Preferred Term"+ USUBJID = "Unique Subject Identifier" |
|
| 75 | +235 |
- }+ ) |
||
| 76 | +236 | |||
| 77 | +237 | 5x |
- cnsdtdscr_sel <- if (!is.null(censor_descr)) {
- |
- |
| 78 | -! | -
- censor_descr+ adaette <- rbind(adaette, adaette_hy) |
||
| 79 | +238 |
- } else {
+
|
||
| 80 | +239 | 5x |
- c(+ adaette <- dplyr::inner_join( |
|
| 81 | +240 | 5x |
- "Clinical Cut Off",+ dplyr::select(adaette, -"SITEID", -"ARM"), |
|
| 82 | +241 | 5x |
- "Completion or Discontinuation",+ adsl, |
|
| 83 | +242 | 5x |
- "End of AE Reporting Period"- |
- |
| 84 | -- |
- )+ by = c("STUDYID", "USUBJID")
|
||
| 85 | +243 |
- }+ ) %>% |
||
| 86 | -+ | |||
| 244 | +5x |
-
+ dplyr::group_by(USUBJID) %>% |
||
| 87 | +245 | 5x |
- random_patient_data <- function(patient_info) {
+ dplyr::arrange(ADTM) %>% |
|
| 88 | -50x | +246 | +5x |
- startdt <- lubridate::date(patient_info$TRTSDTM)+ dplyr::mutate(TTESEQ = seq_len(dplyr::n())) %>% |
| 89 | -50x | +247 | +5x |
- trtedtm <- lubridate::floor_date(dplyr::case_when(+ dplyr::mutate(ASEQ = TTESEQ) %>% |
| 90 | -50x | +248 | +5x |
- is.na(patient_info$TRTEDTM) ~ lubridate::date(patient_info$TRTSDTM) + study_duration_secs,+ dplyr::mutate(PARAM = as.factor(PARAM)) %>% |
| 91 | -50x | +249 | +5x |
- TRUE ~ lubridate::date(patient_info$TRTEDTM)+ dplyr::mutate(PARAMCD = as.factor(PARAMCD)) %>% |
| 92 | -50x | +250 | +5x |
- ), unit = "day")+ dplyr::ungroup() %>% |
| 93 | -50x | +251 | +5x |
- enddts <- c(patient_info$EOSDT, lubridate::date(trtedtm))+ dplyr::arrange( |
| 94 | -50x | +252 | +5x |
- enddts_min_index <- which.min(enddts)+ STUDYID, |
| 95 | -50x | +253 | +5x |
- adt <- enddts[enddts_min_index]+ USUBJID, |
| 96 | -50x | +254 | +5x |
- adtm <- lubridate::as_datetime(adt)+ PARAMCD, |
| 97 | -50x | +255 | +5x |
- ady <- as.numeric(adt - startdt + 1)+ ADTM, |
| 98 | -50x | +256 | +5x |
- data.frame(+ TTESEQ |
| 99 | -50x | +|||
| 257 | +
- ARM = patient_info$ARM,+ ) |
|||
| 100 | -50x | +|||
| 258 | +
- STUDYID = patient_info$STUDYID,+ |
|||
| 101 | -50x | +259 | +5x |
- SITEID = patient_info$SITEID,+ if (length(na_vars) > 0 && na_percentage > 0) {
|
| 102 | -50x | +|||
| 260 | +! |
- USUBJID = patient_info$USUBJID,+ adaette <- dplyr::mutate(ds = adaette, na_vars = na_vars, na_percentage = na_percentage) |
||
| 103 | -50x | +|||
| 261 | +
- PARAMCD = "AEREPTTE",+ } |
|||
| 104 | -50x | +|||
| 262 | +
- PARAM = "Time to end of AE reporting period",+ |
|||
| 105 | -50x | +|||
| 263 | +
- CNSR = 0,+ # apply metadata |
|||
| 106 | -50x | +264 | +5x |
- AVAL = lubridate::days(ady) / lubridate::years(1),+ adaette <- apply_metadata(adaette, "metadata/ADAETTE.yml") |
| 107 | -50x | +|||
| 265 | +
- AVALU = "YEARS",+ |
|||
| 108 | -50x | +266 | +5x |
- EVNTDESC = ifelse(enddts_min_index == 1, "Completion or Discontinuation", "End of AE Reporting Period"),+ return(adaette) |
| 109 | -50x | +|||
| 267 | +
- CNSDTDSC = NA,+ } |
|||
| 110 | -50x | +
| 1 | +
- ADTM = adtm,+ #' Pharmacokinetics Parameters Dataset (ADPP) |
|||
| 111 | -50x | +|||
| 2 | +
- ADY = ady,+ #' |
|||
| 112 | -50x | +|||
| 3 | +
- stringsAsFactors = FALSE+ #' @description `r lifecycle::badge("stable")`
|
|||
| 113 | +4 |
- )+ #' |
||
| 114 | +5 |
- }+ #' Function for generating a random Pharmacokinetics Parameters Dataset for a given |
||
| 115 | +6 |
-
+ #' Subject-Level Analysis Dataset. |
||
| 116 | +7 |
- # validate and initialize related variables for Hy's law+ #' |
||
| 117 | -5x | +|||
| 8 | +
- paramcd_hy <- c("HYSTTEUL", "HYSTTEBL")
+ #' @details One record per study, subject, parameter category, parameter and visit. |
|||
| 118 | -5x | +|||
| 9 | +
- param_hy <- c("Time to Hy's Law Elevation in relation to ULN", "Time to Hy's Law Elevation in relation to Baseline")
+ #' |
|||
| 119 | -5x | +|||
| 10 | +
- param_init_list <- relvar_init(param_hy, paramcd_hy)+ #' @inheritParams argument_convention |
|||
| 120 | -5x | +|||
| 11 | +
- adsl_hy <- dplyr::select(adsl, "STUDYID", "USUBJID", "TRTSDTM", "SITEID", "ARM")+ #' @param ppcat (`character vector`)\cr Categories of parameters. |
|||
| 121 | +12 |
-
+ #' @param ppspec (`character vector`)\cr Specimen material types. |
||
| 122 | +13 |
- # create all combinations of unique values in STUDYID, USUBJID, PARAM, AVISIT+ #' @template param_cached |
||
| 123 | -5x | +|||
| 14 | +
- adaette_hy <- expand.grid(+ #' @templateVar data adpp |
|||
| 124 | -5x | +|||
| 15 | +
- STUDYID = unique(adsl$STUDYID),+ #' |
|||
| 125 | -5x | +|||
| 16 | +
- USUBJID = adsl$USUBJID,+ #' @return `data.frame` |
- |||
| 126 | -5x | +|||
| 17 | +
- PARAM = as.factor(param_init_list$relvar1),+ #' @export |
|||
| 127 | -5x | +|||
| 18 | +
- stringsAsFactors = FALSE+ #' |
|||
| 128 | +19 |
- )+ #' @examples |
||
| 129 | +20 |
-
+ #' adsl <- radsl(N = 10, seed = 1, study_duration = 2) |
||
| 130 | +21 |
- # Add other variables to adaette_hy+ #' |
||
| 131 | -5x | +|||
| 22 | +
- adaette_hy <- dplyr::left_join(adaette_hy, adsl_hy, by = c("STUDYID", "USUBJID")) %>%
+ #' adpp <- radpp(adsl, seed = 2) |
|||
| 132 | -5x | +|||
| 23 | +
- rel_var(+ #' adpp |
|||
| 133 | -5x | +|||
| 24 | +
- var_name = "PARAMCD",+ radpp <- function(adsl, |
|||
| 134 | -5x | +|||
| 25 | +
- related_var = "PARAM",+ ppcat = c("Plasma Drug X", "Plasma Drug Y", "Metabolite Drug X", "Metabolite Drug Y"),
|
|||
| 135 | -5x | +|||
| 26 | +
- var_values = param_init_list$relvar2+ ppspec = c( |
|||
| 136 | +27 |
- ) %>%+ "Plasma", "Plasma", "Plasma", "Matrix of PD", "Matrix of PD", |
||
| 137 | -5x | +|||
| 28 | +
- dplyr::mutate(+ "Urine", "Urine", "Urine", "Urine" |
|||
| 138 | -5x | +|||
| 29 | +
- CNSR = sample(c(0, 1), prob = c(0.1, 0.9), size = dplyr::n(), replace = TRUE),+ ), |
|||
| 139 | -5x | +|||
| 30 | +
- EVNTDESC = dplyr::if_else(+ paramcd = c( |
|||
| 140 | -5x | +|||
| 31 | +
- CNSR == 0,+ "AUCIFO", "CMAX", "CLO", "RMAX", "TON", |
|||
| 141 | -5x | +|||
| 32 | +
- "First Post-Baseline Raised ALT or AST Elevation Result",+ "RENALCL", "RENALCLD", "RCAMINT", "RCPCINT" |
|||
| 142 | -5x | +|||
| 33 | +
- NA_character_+ ), |
|||
| 143 | +34 |
- ),+ param = c( |
||
| 144 | -5x | +|||
| 35 | +
- CNSDTDSC = dplyr::if_else(CNSR == 0, NA_character_,+ "AUC Infinity Obs", "Max Conc", "Total CL Obs", "Time of Maximum Response", |
|||
| 145 | -5x | +|||
| 36 | +
- sample(c("Last Post-Baseline ALT or AST Result", "Treatment Start"),
+ "Time to Onset", "Renal CL", "Renal CL Norm by Dose", |
|||
| 146 | -5x | +|||
| 37 | +
- prob = c(0.9, 0.1),+ "Amt Rec from T1 to T2", "Pct Rec from T1 to T2" |
|||
| 147 | -5x | +|||
| 38 | +
- size = dplyr::n(), replace = TRUE+ ), |
|||
| 148 | +39 |
- )+ paramu = c("day*ug/mL", "ug/mL", "ml/day/kg", "hr", "hr", "L/hr", "L/hr/mg", "mg", "%"),
|
||
| 149 | +40 |
- )+ aval_mean = c(200, 30, 5, 10, 3, 0.05, 0.005, 1.5613, 15.65), |
||
| 150 | +41 |
- ) %>%+ visit_format = "CYCLE", |
||
| 151 | -5x | +|||
| 42 | +
- dplyr::rowwise() %>%+ n_days = 2L, |
|||
| 152 | -5x | +|||
| 43 | +
- dplyr::mutate(ADTM = dplyr::case_when(+ seed = NULL, |
|||
| 153 | -5x | +|||
| 44 | +
- CNSDTDSC == "Treatment Start" ~ TRTSDTM,+ na_percentage = 0, |
|||
| 154 | -5x | +|||
| 45 | +
- TRUE ~ TRTSDTM + sample(seq(0, study_duration_secs), size = dplyr::n(), replace = TRUE)+ na_vars = list( |
|||
| 155 | +46 |
- )) %>%+ AVAL = c(NA, 0.1) |
||
| 156 | -5x | +|||
| 47 | +
- dplyr::mutate(+ ), |
|||
| 157 | -5x | +|||
| 48 | +
- ADY_int = lubridate::date(ADTM) - lubridate::date(TRTSDTM) + 1,+ cached = FALSE) {
|
|||
| 158 | -5x | +49 | +4x |
- ADY = as.numeric(ADY_int),+ checkmate::assert_flag(cached) |
| 159 | -5x | +50 | +4x |
- AVAL = lubridate::days(ADY_int) / lubridate::weeks(1),+ if (cached) {
|
| 160 | -5x | +51 | +1x |
- AVALU = "WEEKS"+ return(get_cached_data("cadlb"))
|
| 161 | +52 |
- ) %>%- |
- ||
| 162 | -5x | -
- dplyr::select(-TRTSDTM, -ADY_int)+ } |
||
| 163 | +53 | |||
| 164 | -5x | +54 | +3x |
- random_ae_data <- function(lookup_info, patient_info, patient_data) {
+ checkmate::assert_character(ppcat) |
| 165 | -150x | +55 | +3x |
- cnsr <- sample(c(0, 1), 1, prob = c(1 - lookup_info$CNSR_P, lookup_info$CNSR_P))+ checkmate::assert_character(ppspec) |
| 166 | -150x | +56 | +3x |
- ae_rep_tte <- patient_data$AVAL[patient_data$PARAMCD == "AEREPTTE"]+ checkmate::assert_character(paramcd) |
| 167 | -150x | +57 | +3x |
- data.frame(+ checkmate::assert_character(param) |
| 168 | -150x | +58 | +3x |
- ARM = rep(patient_data$ARM, 2),+ checkmate::assert_character(paramu) |
| 169 | -150x | +59 | +3x |
- STUDYID = rep(patient_data$STUDYID, 2),+ checkmate::assert_vector(aval_mean) |
| 170 | -150x | +60 | +3x |
- SITEID = rep(patient_data$SITEID, 2),+ checkmate::assert_string(visit_format) |
| 171 | -150x | +61 | +3x |
- USUBJID = rep(patient_data$USUBJID, 2),+ checkmate::assert_integer(n_days) |
| 172 | -150x | +62 | +3x |
- PARAMCD = c(+ checkmate::assert_number(seed, null.ok = TRUE) |
| 173 | -150x | +63 | +3x |
- paste0("AETTE", lookup_info$CATCD),
+ checkmate::assert_number(na_percentage, lower = 0, upper = 1) |
| 174 | -150x | -
- paste0("AETOT", lookup_info$CATCD)
- |
- ||
| 175 | -+ | 64 | +3x |
- ),+ checkmate::assert_true(na_percentage < 1) |
| 176 | -150x | +65 | +3x |
- PARAM = c(+ checkmate::assert_list(na_vars) |
| 177 | -150x | +|||
| 66 | +
- paste("Time to first occurrence of", lookup_info$CAT),
+
|
|||
| 178 | -150x | -
- paste("Number of occurrences of", lookup_info$CAT)
- |
- ||
| 179 | -+ | 67 | +3x |
- ),+ checkmate::assertTRUE(length(ppspec) == length(paramcd)) |
| 180 | -150x | +68 | +3x |
- CNSR = c(+ checkmate::assertTRUE(length(ppspec) == length(param)) |
| 181 | -150x | +69 | +3x |
- cnsr,+ checkmate::assertTRUE(length(ppspec) == length(paramu)) |
| 182 | -150x | +70 | +3x |
- NA+ checkmate::assertTRUE(length(ppspec) == length(aval_mean)) |
| 183 | +71 |
- ),+ |
||
| 184 | -150x | +72 | +3x |
- AVAL = c(+ if (!is.null(seed)) {
|
| 185 | -+ | |||
| 73 | +3x |
- # We generate these values conditional on the censoring information.+ set.seed(seed) |
||
| 186 | +74 |
- # If this time to event is censored, then there were no AEs reported and the time is set+ } |
||
| 187 | +75 |
- # to the AE reporting period time. Otherwise we draw from truncated distributions to make+ |
||
| 188 | +76 |
- # sure that we are within the AE reporting time and above 0 AEs.+ # validate and initialize related variables |
||
| 189 | -150x | +77 | +3x |
- ifelse(cnsr == 1, ae_rep_tte, rtexp(1, lookup_info$LAMBDA * 365.25, r = ae_rep_tte)),+ ppspec_init_list <- relvar_init(param, ppspec) |
| 190 | -150x | +78 | +3x |
- ifelse(cnsr == 1, 0, rtpois(1, lookup_info$LAMBDA * 365.25))+ param_init_list <- relvar_init(param, paramcd)+ |
+
| 79 | +3x | +
+ unit_init_list <- relvar_init(param, paramu) |
||
| 191 | +80 |
- ),+ |
||
| 192 | -150x | +81 | +3x |
- AVALU = c(+ adpp <- expand.grid( |
| 193 | -150x | +82 | +3x |
- "YEARS",+ STUDYID = unique(adsl$STUDYID), |
| 194 | -150x | +83 | +3x |
- NA+ USUBJID = adsl$USUBJID, |
| 195 | -+ | |||
| 84 | +3x |
- ),+ PPCAT = as.factor(ppcat), |
||
| 196 | -150x | +85 | +3x |
- EVNTDESC = c(+ PARAM = as.factor(param_init_list$relvar1), |
| 197 | -150x | +86 | +3x |
- ifelse(cnsr == 0, sample(evntdescr_sel, 1), ""),+ AVISIT = visit_schedule(visit_format = visit_format, n_assessments = 1L, n_days = n_days), |
| 198 | -150x | +87 | +3x |
- NA+ stringsAsFactors = FALSE |
| 199 | +88 |
- ),+ ) |
||
| 200 | -150x | +89 | +3x |
- CNSDTDSC = c(+ adpp <- adpp %>% |
| 201 | -150x | +90 | +3x |
- ifelse(cnsr == 1, sample(cnsdtdscr_sel, 1), ""),+ dplyr::mutate(AVAL = stats::rnorm(nrow(adpp), mean = 1, sd = 0.2)) %>% |
| 202 | -150x | +91 | +3x |
- NA+ dplyr::left_join(data.frame(PARAM = param, ADJUST = aval_mean), by = "PARAM") %>% |
| 203 | -+ | |||
| 92 | +3x |
- ),+ dplyr::mutate(AVAL = AVAL * ADJUST) %>% |
||
| 204 | -150x | +93 | +3x |
- stringsAsFactors = FALSE+ dplyr::select(-"ADJUST") |
| 205 | -150x | +|||
| 94 | +
- ) %>% dplyr::mutate(+ |
- |||
| 206 | -150x | +|||
| 95 | +
- ADY = dplyr::if_else(is.na(AVALU), NA_real_, ceiling(as.numeric(lubridate::dyears(AVAL), "days"))),+ # assign related variable values: PARAMxPPSPEC are related |
|||
| 207 | -150x | +96 | +3x |
- ADTM = dplyr::if_else(+ adpp <- adpp %>% rel_var( |
| 208 | -150x | +97 | +3x |
- is.na(AVALU),+ var_name = "PPSPEC", |
| 209 | -150x | +98 | +3x |
- lubridate::as_datetime(NA),+ related_var = "PARAM", |
| 210 | -150x | +99 | +3x |
- patient_info$TRTSDTM + lubridate::days(ADY)+ var_values = ppspec_init_list$relvar2 |
| 211 | +100 |
- )+ ) |
||
| 212 | +101 |
- )+ |
||
| 213 | +102 |
- }+ # assign related variable values: PARAMxPARAMCD are related |
||
| 214 | -+ | |||
| 103 | +3x |
-
+ adpp <- adpp %>% rel_var( |
||
| 215 | -5x | +104 | +3x |
- adaette <- split(adsl, adsl$USUBJID) %>%+ var_name = "PARAMCD", |
| 216 | -5x | +105 | +3x |
- lapply(function(patient_info) {
+ related_var = "PARAM", |
| 217 | -50x | +106 | +3x |
- patient_data <- random_patient_data(patient_info)+ var_values = param_init_list$relvar2 |
| 218 | -50x | +|||
| 107 | +
- lookup_arm <- lookup_adaette %>%+ ) |
|||
| 219 | -50x | +|||
| 108 | +
- dplyr::filter(ARM == as.character(patient_info$ARMCD))+ + |
+ |||
| 109 | ++ |
+ # assign related variable values: PARAMxAVALU are related |
||
| 220 | -50x | +110 | +3x |
- ae_data <- split(lookup_arm, lookup_arm$CATCD) %>%+ adpp <- adpp %>% rel_var( |
| 221 | -50x | +111 | +3x |
- lapply(random_ae_data, patient_data = patient_data, patient_info = patient_info) %>%+ var_name = "AVALU", |
| 222 | -50x | +112 | +3x |
- Reduce(rbind, .)+ related_var = "PARAM", |
| 223 | -50x | +113 | +3x |
- dplyr::bind_rows(patient_data, ae_data)+ var_values = unit_init_list$relvar2 |
| 224 | +114 |
- }) %>%+ ) |
||
| 225 | -5x | +|||
| 115 | +
- Reduce(rbind, .) %>%+ |
|||
| 226 | -5x | +|||
| 116 | +
- var_relabel(+ # derive AVISITN based AVISIT and AVALC based on AVAL |
|||
| 227 | -5x | +117 | +3x |
- STUDYID = "Study Identifier",+ adpp <- adpp %>% |
| 228 | -5x | +118 | +3x |
- USUBJID = "Unique Subject Identifier"+ dplyr::mutate(AVALC = as.character(AVAL)) %>% |
| 229 | -+ | |||
| 119 | +3x |
- )+ dplyr::mutate( |
||
| 230 | -+ | |||
| 120 | +3x |
-
+ AVISITN = dplyr::case_when( |
||
| 231 | -5x | +121 | +3x |
- adaette <- var_relabel(+ AVISIT == "SCREENING" ~ 0, |
| 232 | -5x | +122 | +3x |
- adaette,+ (grepl("^WEEK", AVISIT) | grepl("^CYCLE", AVISIT)) ~ as.numeric(AVISIT) - 1,
|
| 233 | -5x | +123 | +3x |
- STUDYID = "Study Identifier",+ TRUE ~ NA_real_ |
| 234 | -5x | +|||
| 124 | +
- USUBJID = "Unique Subject Identifier"+ ) |
|||
| 235 | +125 |
- )+ ) |
||
| 236 | +126 | |||
| 127 | ++ |
+ # derive REGIMEN variable+ |
+ ||
| 237 | -5x | +128 | +3x |
- adaette <- rbind(adaette, adaette_hy)+ adpp <- adpp %>% dplyr::mutate(REGIMEN = "BID") |
| 238 | +129 | |||
| 130 | ++ |
+ # derive PPSTINT and PPENINT based on PARAMCD+ |
+ ||
| 239 | -5x | +131 | +3x |
- adaette <- dplyr::inner_join(+ t1_t2 <- data.frame( |
| 240 | -5x | +132 | +3x |
- dplyr::select(adaette, -"SITEID", -"ARM"),+ PARAMCD = c("RCAMINT", "RCAMINT", "RCPCINT", "RCPCINT"),
|
| 241 | -5x | +133 | +3x |
- adsl,+ PPSTINT = c("P0H", "P0H", "P0H", "P0H"),
|
| 242 | -5x | +134 | +3x |
- by = c("STUDYID", "USUBJID")
+ PPENINT = c("P12H", "P24H", "P12H", "P24H")
|
| 243 | +135 |
- ) %>%+ ) |
||
| 244 | -5x | +136 | +3x |
- dplyr::group_by(USUBJID) %>%+ adpp <- adpp %>% |
| 245 | -5x | +137 | +3x |
- dplyr::arrange(ADTM) %>%+ dplyr::left_join(t1_t2, by = c("PARAMCD"), multiple = "all", relationship = "many-to-many")
|
| 246 | -5x | +|||
| 138 | +
- dplyr::mutate(TTESEQ = seq_len(dplyr::n())) %>%+ |
|||
| 247 | -5x | +139 | +3x |
- dplyr::mutate(ASEQ = TTESEQ) %>%+ adpp <- dplyr::inner_join(adpp, adsl, by = c("STUDYID", "USUBJID")) %>%
|
| 248 | -5x | +140 | +3x |
- dplyr::mutate(PARAM = as.factor(PARAM)) %>%+ dplyr::filter( |
| 249 | -5x | +141 | +3x |
- dplyr::mutate(PARAMCD = as.factor(PARAMCD)) %>%+ ACTARM != "B: Placebo", |
| 250 | -5x | +142 | +3x |
- dplyr::ungroup() %>%+ !(ACTARM == "A: Drug X" & (PPCAT == "Plasma Drug Y" | PPCAT == "Metabolite Drug Y")) |
| 251 | -5x | +|||
| 143 | +
- dplyr::arrange(+ ) |
|||
| 252 | -5x | +|||
| 144 | +
- STUDYID,+ + |
+ |||
| 145 | ++ |
+ # derive PKARMCD column for creating more cohorts |
||
| 253 | -5x | +146 | +3x |
- USUBJID,+ adpp <- adpp %>% |
| 254 | -5x | +147 | +3x |
- PARAMCD,+ dplyr::mutate(PKARMCD = factor(1 + (seq_len(nrow(adpp)) - 1) %/% (nrow(adpp) / 10), labels = c( |
| 255 | -5x | +148 | +3x |
- ADTM,+ "Drug A", "Drug B", "Drug C", "Drug D", "Drug E", "Drug F", "Drug G", "Drug H", |
| 256 | -5x | +149 | +3x |
- TTESEQ+ "Drug I", "Drug J" |
| 257 | +150 |
- )+ ))) |
||
| 258 | +151 | |||
| 259 | -5x | +152 | +3x |
if (length(na_vars) > 0 && na_percentage > 0) {
|
| 260 | +153 | ! |
- adaette <- dplyr::mutate(ds = adaette, na_vars = na_vars, na_percentage = na_percentage)+ adpp <- mutate_na(ds = adpp, na_vars = na_vars, na_percentage = na_percentage) |
|
| 261 | +154 |
} |
||
| 262 | +155 | |||
| 263 | -- |
- # apply metadata- |
- ||
| 264 | -5x | -
- adaette <- apply_metadata(adaette, "metadata/ADAETTE.yml")- |
- ||
| 265 | -+ | 156 | +3x |
-
+ adpp <- apply_metadata(adpp, "metadata/ADPP.yml") |
| 266 | -5x | +157 | +3x |
- return(adaette)+ return(adpp) |
| 267 | +158 |
}@@ -21930,14 +21838,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 |
- #' @export+ #' adeg <- radeg(adsl, visit_format = "CYCLE", n_assessments = 2L, seed = 2) |
|||
| 30 |
- #'+ #' adeg |
|||
| 31 |
- #' @examples+ radeg <- function(adsl, |
|||
| 32 |
- #' sample_fct(letters[1:3], 10)+ egcat = c("INTERVAL", "INTERVAL", "MEASUREMENT", "FINDING"),
|
|||
| 33 |
- #' 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 |
- #' For example, `relvar_init("Alanine Aminotransferase Measurement", "ALT")`.
+ n_days = 5L, |
|||
| 44 |
- #'+ max_n_eg = 10L, |
|||
| 45 |
- #' @param relvar1 (`list` of `character`)\cr List of n elements.+ lookup = NULL, |
|||
| 46 |
- #' @param relvar2 (`list` of `character`)\cr List of n elements.+ seed = NULL, |
|||
| 47 |
- #'+ na_percentage = 0, |
|||
| 48 |
- #' @return A vector of n elements.+ na_vars = list( |
|||
| 49 |
- #'+ ABLFL = c(1235, 0.1), BASE = c(NA, 0.1), BASEC = c(NA, 0.1), |
|||
| 50 |
- #' @keywords internal+ CHG = c(1234, 0.1), PCHG = c(1234, 0.1) |
|||
| 51 |
- relvar_init <- function(relvar1, relvar2) {
+ ), |
|||
| 52 | -64x | +
- checkmate::assert_character(relvar1, min.len = 1, any.missing = FALSE)+ cached = FALSE) {
|
||
| 53 | -64x | +4x |
- checkmate::assert_character(relvar2, min.len = 1, any.missing = FALSE)+ checkmate::assert_flag(cached) |
|
| 54 | -+ | 4x |
-
+ if (cached) {
|
|
| 55 | -64x | +1x |
- if (length(relvar1) != length(relvar2)) {
+ return(get_cached_data("cadeg"))
|
|
| 56 | -1x | +
- message(simpleError(+ } |
||
| 57 | -1x | +
- "The argument value length of relvar1 and relvar2 differ. They must contain the same number of elements."+ |
||
| 58 | -+ | 3x |
- ))+ checkmate::assert_data_frame(adsl) |
|
| 59 | -! | +3x |
- return(NA)+ checkmate::assert_character(egcat, min.len = 1, any.missing = FALSE) |
|
| 60 | -+ | 3x |
- }+ checkmate::assert_character(param, min.len = 1, any.missing = FALSE) |
|
| 61 | -63x | +3x |
- return(list("relvar1" = relvar1, "relvar2" = relvar2))
+ checkmate::assert_character(paramcd, min.len = 1, any.missing = FALSE) |
|
| 62 | -+ | 3x |
- }+ checkmate::assert_character(paramu, min.len = 1, any.missing = FALSE) |
|
| 63 | -+ | 3x |
-
+ checkmate::assert_string(visit_format) |
|
| 64 | -+ | 3x |
- #' Related Variables: Assign+ checkmate::assert_integer(n_assessments, len = 1, any.missing = FALSE) |
|
| 65 | -+ | 3x |
- #'+ checkmate::assert_integer(n_days, len = 1, any.missing = FALSE) |
|
| 66 | -+ | 3x |
- #' Assign values to a related variable within a domain.+ checkmate::assert_integer(max_n_eg, len = 1, any.missing = FALSE) |
|
| 67 | -+ | 3x |
- #'+ checkmate::assert_data_frame(lookup, null.ok = TRUE) |
|
| 68 | -+ | 3x |
- #' @param df (`data.frame`)\cr Data frame containing the related variables.+ checkmate::assert_number(seed, null.ok = TRUE) |
|
| 69 | -+ | 3x |
- #' @param var_name (`character`)\cr Name of variable related to `rel_var` to add to `df`.+ checkmate::assert_number(na_percentage, lower = 0, upper = 1) |
|
| 70 | -+ | 3x |
- #' @param var_values (`any`)\cr Vector of values related to values of `related_var`.+ checkmate::assert_true(na_percentage < 1) |
|
| 71 |
- #' @param related_var (`character`)\cr Name of variable within `df` with values to which values+ |
|||
| 72 |
- #' of `var_name` must relate.+ # validate and initialize related variables |
|||
| 73 | -+ | 3x |
- #'+ egcat_init_list <- relvar_init(param, egcat) |
|
| 74 | -+ | 3x |
- #' @return `df` with added factor variable `var_name` containing `var_values` corresponding to `related_var`.+ param_init_list <- relvar_init(param, paramcd) |
|
| 75 | -+ | 3x |
- #' @export+ unit_init_list <- relvar_init(param, paramu) |
|
| 76 |
- #'+ |
|||
| 77 | -+ | 3x |
- #' @examples+ if (!is.null(seed)) {
|
|
| 78 | -+ | 3x |
- #' # Example with data.frame.+ set.seed(seed) |
|
| 79 |
- #' params <- c("Level A", "Level B", "Level C")
+ } |
|||
| 80 | -+ | 3x |
- #' adlb_df <- data.frame(+ study_duration_secs <- lubridate::seconds(attr(adsl, "study_duration_secs")) |
|
| 81 |
- #' ID = 1:9,+ |
|||
| 82 | -+ | 3x |
- #' PARAM = factor(+ adeg <- expand.grid( |
|
| 83 | -+ | 3x |
- #' rep(c("Level A", "Level B", "Level C"), 3),
+ STUDYID = unique(adsl$STUDYID), |
|
| 84 | -+ | 3x |
- #' levels = params+ USUBJID = adsl$USUBJID, |
|
| 85 | -+ | 3x |
- #' )+ PARAM = as.factor(param_init_list$relvar1), |
|
| 86 | -+ | 3x |
- #' )+ AVISIT = visit_schedule(visit_format = visit_format, n_assessments = n_assessments, n_days = n_days), |
|
| 87 | -+ | 3x |
- #' rel_var(+ stringsAsFactors = FALSE |
|
| 88 |
- #' df = adlb_df,+ ) |
|||
| 89 |
- #' var_name = "PARAMCD",+ |
|||
| 90 |
- #' var_values = c("A", "B", "C"),
+ # assign related variable values: PARAMxEGCAT are related |
|||
| 91 | -+ | 3x |
- #' related_var = "PARAM"+ adeg <- adeg %>% rel_var( |
|
| 92 | -+ | 3x |
- #' )+ var_name = "EGCAT", |
|
| 93 | -+ | 3x |
- #'+ related_var = "PARAM", |
|
| 94 | -+ | 3x |
- #' # Example with tibble.+ var_values = egcat_init_list$relvar2 |
|
| 95 |
- #' adlb_tbl <- tibble::tibble(+ ) |
|||
| 96 |
- #' ID = 1:9,+ |
|||
| 97 |
- #' PARAM = factor(+ # assign related variable values: PARAMxPARAMCD are related |
|||
| 98 | -+ | 3x |
- #' rep(c("Level A", "Level B", "Level C"), 3),
+ adeg <- adeg %>% rel_var( |
|
| 99 | -+ | 3x |
- #' levels = params+ var_name = "PARAMCD", |
|
| 100 | -+ | 3x |
- #' )+ related_var = "PARAM", |
|
| 101 | -+ | 3x |
- #' )+ var_values = param_init_list$relvar2 |
|
| 102 |
- #' rel_var(+ ) |
|||
| 103 |
- #' df = adlb_tbl,+ |
|||
| 104 | -+ | 3x |
- #' var_name = "PARAMCD",+ adeg <- adeg %>% dplyr::mutate(AVAL = dplyr::case_when( |
|
| 105 | -+ | 3x |
- #' var_values = c("A", "B", "C"),
+ PARAMCD == "QT" ~ stats::rnorm(nrow(adeg), mean = 350, sd = 100), |
|
| 106 | -+ | 3x |
- #' related_var = "PARAM"+ PARAMCD == "RR" ~ stats::rnorm(nrow(adeg), mean = 1050, sd = 300), |
|
| 107 | -+ | 3x |
- #' )+ PARAMCD == "HR" ~ stats::rnorm(nrow(adeg), mean = 70, sd = 20), |
|
| 108 | -+ | 3x |
- rel_var <- function(df, var_name, related_var, var_values = NULL) {
+ PARAMCD == "ECGINTP" ~ NA_real_ |
|
| 109 | -64x | +
- checkmate::assert_data_frame(df)+ )) |
||
| 110 | -64x | +
- checkmate::assert_string(var_name)+ |
||
| 111 | -64x | +3x |
- checkmate::assert_string(related_var)+ adeg <- adeg %>% |
|
| 112 | -64x | +3x |
- n_relvar1 <- length(unique(df[, related_var, drop = TRUE]))+ dplyr::mutate(EGTESTCD = PARAMCD) %>% |
|
| 113 | -64x | +3x |
- checkmate::assert_vector(var_values, null.ok = TRUE, len = n_relvar1, any.missing = FALSE)+ dplyr::mutate(EGTEST = PARAM) |
|
| 114 | -1x | +
- if (is.null(var_values)) var_values <- rep(NA, n_relvar1)+ |
||
| 115 | -+ | 3x |
-
+ adeg <- adeg %>% dplyr::mutate(AVISITN = dplyr::case_when( |
|
| 116 | -64x | +3x |
- relvar1 <- unique(df[, related_var, drop = TRUE])+ AVISIT == "SCREENING" ~ -1, |
|
| 117 | -64x | +3x |
- relvar2_values <- rep(NA, nrow(df))+ AVISIT == "BASELINE" ~ 0, |
|
| 118 | -64x | +3x |
- for (r in seq_len(n_relvar1)) {
+ (grepl("^WEEK", AVISIT) | grepl("^CYCLE", AVISIT)) ~ as.numeric(AVISIT) - 2,
|
|
| 119 | -538x | +3x |
- matched <- which(df[, related_var, drop = TRUE] == relvar1[r])+ TRUE ~ NA_real_ |
|
| 120 | -538x | +
- relvar2_values[matched] <- var_values[r]+ )) |
||
| 121 |
- }+ |
|||
| 122 | -64x | +3x |
- df[[var_name]] <- factor(relvar2_values)+ adeg <- adeg %>% rel_var( |
|
| 123 | -64x | +3x |
- return(df)+ var_name = "AVALU", |
|
| 124 | -+ | 3x |
- }+ related_var = "PARAM", |
|
| 125 | -+ | 3x |
-
+ var_values = unit_init_list$relvar2 |
|
| 126 |
- #' Create Visit Schedule+ ) |
|||
| 127 |
- #'+ |
|||
| 128 |
- #' Create a visit schedule as a factor.+ # order to prepare for change from screening and baseline values |
|||
| 129 | -+ | 3x |
- #'+ adeg <- adeg[order(adeg$STUDYID, adeg$USUBJID, adeg$PARAMCD, adeg$AVISITN), ] |
|
| 130 |
- #' X number of visits, or X number of cycles and Y number of days.+ |
|||
| 131 | -+ | 3x |
- #'+ adeg <- Reduce(rbind, lapply(split(adeg, adeg$USUBJID), function(x) {
|
|
| 132 | -+ | 30x |
- #' @inheritParams argument_convention+ x$STUDYID <- adsl$STUDYID[which(adsl$USUBJID == x$USUBJID[1])] |
|
| 133 | -+ | 30x |
- #'+ x$ABLFL <- ifelse(toupper(visit_format) == "WEEK" & x$AVISIT == "BASELINE", |
|
| 134 | -+ | 30x |
- #' @return A factor of length `n_assessments`.+ "Y", |
|
| 135 | -+ | 30x |
- #' @export+ ifelse(toupper(visit_format) == "CYCLE" & x$AVISIT == "CYCLE 1 DAY 1", "Y", "") |
|
| 136 |
- #'+ ) |
|||
| 137 | -+ | 30x |
- #' @examples+ x |
|
| 138 |
- #' visit_schedule(visit_format = "WEeK", n_assessments = 10L)+ })) |
|||
| 139 |
- #' visit_schedule(visit_format = "CyCLE", n_assessments = 5L, n_days = 2L)+ |
|||
| 140 | -+ | 3x |
- visit_schedule <- function(visit_format = "WEEK",+ adeg$BASE <- ifelse(adeg$AVISITN >= 0, retain(adeg, adeg$AVAL, adeg$ABLFL == "Y"), adeg$AVAL) |
|
| 141 |
- n_assessments = 10L,+ |
|||
| 142 | -+ | 3x |
- n_days = 5L) {
+ adeg <- adeg %>% dplyr::mutate(ANRLO = dplyr::case_when( |
|
| 143 | -56x | +3x |
- checkmate::assert_string(visit_format, pattern = "^WEEK$|^CYCLE$", ignore.case = TRUE)+ PARAMCD == "QT" ~ 200, |
|
| 144 | -56x | +3x |
- checkmate::assert_integer(n_assessments, len = 1, any.missing = FALSE)+ PARAMCD == "RR" ~ 600, |
|
| 145 | -56x | +3x |
- checkmate::assert_integer(n_days, len = 1, any.missing = FALSE)+ PARAMCD == "HR" ~ 40, |
|
| 146 | -+ | 3x |
-
+ PARAMCD == "ECGINTP" ~ NA_real_ |
|
| 147 | -56x | +
- if (toupper(visit_format) == "WEEK") {
+ )) |
||
| 148 |
- # numeric vector of n assessments/cycles/days+ |
|||
| 149 | -49x | +3x |
- assessments <- 1:n_assessments+ adeg <- adeg %>% dplyr::mutate(ANRHI = dplyr::case_when( |
|
| 150 | -+ | 3x |
- # numeric vector for ordering including screening (-1) and baseline (0) place holders+ PARAMCD == "QT" ~ 500, |
|
| 151 | -49x | +3x |
- assessments_ord <- -1:n_assessments+ PARAMCD == "RR" ~ 1500, |
|
| 152 | -+ | 3x |
- # character vector of nominal visit values+ PARAMCD == "HR" ~ 100, |
|
| 153 | -49x | +3x |
- visit_values <- c("SCREENING", "BASELINE", paste(toupper(visit_format), assessments, "DAY", (assessments * 7) + 1))
+ PARAMCD == "ECGINTP" ~ NA_real_ |
|
| 154 | -7x | +
- } else if (toupper(visit_format) == "CYCLE") {
+ )) |
||
| 155 | -7x | +
- cycles <- sort(rep(1:n_assessments, times = 1, each = n_days))+ |
||
| 156 | -7x | +3x |
- days <- rep(seq(1:n_days), times = n_assessments, each = 1)+ adeg <- adeg %>% dplyr::mutate(ANRIND = factor(dplyr::case_when( |
|
| 157 | -7x | +3x |
- assessments_ord <- 0:(n_assessments * n_days)+ AVAL < ANRLO ~ "LOW", |
|
| 158 | -7x | +3x |
- visit_values <- c("SCREENING", paste(toupper(visit_format), cycles, "DAY", days))
+ AVAL >= ANRLO & AVAL <= ANRHI ~ "NORMAL", |
|
| 159 | -+ | 3x |
- }+ AVAL > ANRHI ~ "HIGH" |
|
| 160 |
-
+ ))) |
|||
| 161 |
- # create and order factor variable to return from function+ |
|||
| 162 | -56x | +3x |
- visit_values <- stats::reorder(factor(visit_values), assessments_ord)+ adeg <- adeg %>% |
|
| 163 | -+ | 3x |
- }+ dplyr::mutate(CHG = ifelse(AVISITN > 0, AVAL - BASE, NA)) %>% |
|
| 164 | -+ | 3x |
-
+ dplyr::mutate(PCHG = ifelse(AVISITN > 0, 100 * (CHG / BASE), NA)) %>% |
|
| 165 | -+ | 3x |
- #' Primary Keys: Retain Values+ dplyr::mutate(BASETYPE = "LAST") %>% |
|
| 166 | -+ | 3x |
- #'+ dplyr::group_by(USUBJID, PARAMCD, BASETYPE) %>% |
|
| 167 | -+ | 3x |
- #' Retain values within primary keys.+ dplyr::mutate(BNRIND = ANRIND[ABLFL == "Y"]) %>% |
|
| 168 | -+ | 3x |
- #'+ dplyr::ungroup() %>% |
|
| 169 | -+ | 3x |
- #' @param df (`data.frame`)\cr Data frame in which to apply the retain.+ dplyr::mutate(ATPTN = 1) %>% |
|
| 170 | -+ | 3x |
- #' @param value_var (`any`)\cr Variable in `df` containing the value to be retained.+ dplyr::mutate(DTYPE = NA) |
|
| 171 |
- #' @param event (`expression`)\cr Expression returning a logical value to trigger the retain.+ |
|||
| 172 | -+ | 3x |
- #' @param outside (`any`)\cr Additional value to retain. Defaults to `NA`.+ adeg$ANRIND <- factor(adeg$ANRIND, levels = c("LOW", "NORMAL", "HIGH"))
|
|
| 173 | -+ | 3x |
- #' @return A vector of values where expression is true.+ adeg$BNRIND <- factor(adeg$BNRIND, levels = c("LOW", "NORMAL", "HIGH"))
|
|
| 174 |
- #' @keywords internal+ |
|||
| 175 | -+ | 3x |
- retain <- function(df, value_var, event, outside = NA) {
+ adeg <- rcd_var_relabel( |
|
| 176 | -31x | +3x |
- indices <- c(1, which(event == TRUE), nrow(df) + 1)+ adeg, |
|
| 177 | -31x | +3x |
- values <- c(outside, value_var[event == TRUE])+ STUDYID = "Study Identifier", |
|
| 178 | -31x | +3x |
- rep(values, diff(indices))+ USUBJID = "Unique Subject Identifier" |
|
| 179 |
- }+ ) |
|||
| 181 |
- #' Primary Keys: Labels+ # merge ADSL to be able to add EG date and study day variables |
|||
| 182 | -+ | 3x |
- #'+ adeg <- dplyr::inner_join( |
|
| 183 | -+ | 3x |
- #' Relabel a subset of variables in a data set.+ adeg, |
|
| 184 | -+ | 3x |
- #'+ adsl, |
|
| 185 | -+ | 3x |
- #' @param x (`data.frame`)\cr Data frame containing variables to which labels are applied.+ by = c("STUDYID", "USUBJID")
|
|
| 186 |
- #' @param ... (`named character`)\cr Name-Value pairs, where name corresponds to a variable+ ) %>% |
|||
| 187 | -+ | 3x |
- #' name in `x` and the value to the new variable label.+ dplyr::rowwise() %>% |
|
| 188 | -+ | 3x |
- #' @return x (`data.frame`)\cr Data frame with labels applied.+ dplyr::mutate(TRTENDT = lubridate::date(dplyr::case_when( |
|
| 189 | -+ | 3x |
- #'+ is.na(TRTEDTM) ~ lubridate::floor_date(lubridate::date(TRTSDTM) + study_duration_secs, unit = "day"), |
|
| 190 | -+ | 3x |
- #' @export+ TRUE ~ TRTEDTM |
|
| 191 |
- #'+ ))) %>% |
|||
| 192 | -+ | 3x |
- #' @examples+ dplyr::ungroup() |
|
| 193 |
- #' adsl <- radsl()+ |
|||
| 194 | -+ | 3x |
- #' var_relabel(adsl,+ adeg <- adeg %>% |
|
| 195 | -+ | 3x |
- #' STUDYID = "Study Identifier",+ dplyr::group_by(USUBJID) %>% |
|
| 196 | -+ | 3x |
- #' USUBJID = "Unique Subject Identifier"+ dplyr::arrange(USUBJID, AVISITN) %>% |
|
| 197 | -+ | 3x |
- #' )+ dplyr::mutate(ADTM = rep( |
|
| 198 | -+ | 3x |
- var_relabel <- function(x, ...) {
+ sort(sample( |
|
| 199 | -82x | +3x |
- dots <- list(...)+ seq(lubridate::as_datetime(TRTSDTM[1]), lubridate::as_datetime(TRTENDT[1]), by = "day"), |
|
| 200 | -82x | +3x |
- varnames <- names(dots)+ size = nlevels(AVISIT) |
|
| 201 | -82x | +
- if (is.null(varnames)) {
+ )), |
||
| 202 | -1x | +3x |
- stop("missing variable declarations")
+ each = n() / nlevels(AVISIT) |
|
| 203 |
- }+ )) %>% |
|||
| 204 | -81x | +3x |
- map_varnames <- match(varnames, names(x))+ dplyr::ungroup() %>% |
|
| 205 | -81x | +3x |
- for (i in seq_along(map_varnames)) {
+ dplyr::mutate(ADY = ceiling(difftime(ADTM, TRTSDTM, units = "days"))) %>% |
|
| 206 | -161x | +3x |
- attr(x[[map_varnames[[i]]]], "label") <- dots[[i]]+ dplyr::select(-TRTENDT) %>% |
|
| 207 | -+ | 3x |
- }+ dplyr::arrange(STUDYID, USUBJID, ADTM) |
|
| 208 | -81x | +
- x+ |
||
| 209 | -+ | 3x |
- }+ adeg <- adeg %>% |
|
| 210 | -+ | 3x |
-
+ dplyr::mutate(ASPID = sample(seq_len(dplyr::n()))) %>% |
|
| 211 | -+ | 3x |
- #' Apply Metadata+ dplyr::group_by(USUBJID) %>% |
|
| 212 | -+ | 3x |
- #'+ dplyr::mutate(EGSEQ = seq_len(dplyr::n())) %>% |
|
| 213 | -+ | 3x |
- #' Apply label and variable ordering attributes to domains.+ dplyr::mutate(ASEQ = EGSEQ) %>% |
|
| 214 | -+ | 3x |
- #'+ dplyr::ungroup() %>% |
|
| 215 | -+ | 3x |
- #' @param df (`data.frame`)\cr Data frame to which metadata is applied.+ dplyr::arrange( |
|
| 216 | -+ | 3x |
- #' @param filename (`yaml`)\cr File containing domain metadata.+ STUDYID, |
|
| 217 | -+ | 3x |
- #' @param add_adsl (`logical`)\cr Should ADSL data be merged to domain.+ USUBJID, |
|
| 218 | -+ | 3x |
- #' @param adsl_filename (`yaml`)\cr File containing ADSL metadata.+ PARAMCD, |
|
| 219 | -+ | 3x |
- #' @return Data frame with metadata applied.+ BASETYPE, |
|
| 220 | -+ | 3x |
- #'+ AVISITN, |
|
| 221 | -+ | 3x |
- #' @export+ ATPTN, |
|
| 222 | -+ | 3x |
- #' @examples+ DTYPE, |
|
| 223 | -+ | 3x |
- #' seed <- 1+ ADTM, |
|
| 224 | -+ | 3x |
- #' adsl <- radsl(seed = seed)+ EGSEQ, |
|
| 225 | -+ | 3x |
- #' adsub <- radsub(adsl, seed = seed)+ ASPID |
|
| 226 |
- #' yaml_path <- file.path(path.package("random.cdisc.data"), "inst", "metadata")
+ ) |
|||
| 227 |
- #' adsl <- apply_metadata(adsl, file.path(yaml_path, "ADSL.yml"), FALSE)+ |
|||
| 228 | -+ | 3x |
- #' adsub <- apply_metadata(+ adeg <- adeg %>% dplyr::mutate(ONTRTFL = factor(dplyr::case_when( |
|
| 229 | -+ | 3x |
- #' adsub, file.path(yaml_path, "ADSUB.yml"), TRUE,+ !AVISIT %in% c("SCREENING", "BASELINE") ~ "Y",
|
|
| 230 | -+ | 3x |
- #' file.path(yaml_path, "ADSL.yml")+ TRUE ~ "" |
|
| 231 |
- #' )+ ))) |
|||
| 232 |
- apply_metadata <- function(df, filename, add_adsl = TRUE, adsl_filename = "metadata/ADSL.yml") {
+
|
|||
| 233 | -90x | +3x |
- checkmate::assert_data_frame(df)+ adeg <- adeg %>% dplyr::mutate(AVALC = ifelse( |
|
| 234 | -90x | +3x |
- checkmate::assert_string(filename)+ PARAMCD == "ECGINTP", |
|
| 235 | -90x | +3x |
- checkmate::assert_flag(add_adsl)+ as.character(sample_fct(c("ABNORMAL", "NORMAL"), nrow(adeg), prob = c(0.25, 0.75))),
|
|
| 236 | -90x | +3x |
- checkmate::assert_string(adsl_filename)+ as.character(AVAL) |
|
| 237 |
-
+ )) |
|||
| 238 | -90x | +
- apply_type <- function(df, var, type) {
+
|
||
| 239 | -5986x | +
- if (is.null(type)) {
+ # Temporarily creating a row_check column to easily match newly created |
||
| 240 | -! | +
- return()+ # observations with their row correct arrangement. |
||
| 241 | -+ | 3x |
- }+ adeg <- adeg %>% |
|
| 242 | -+ | 3x |
-
+ dplyr::mutate(row_check = seq_len(nrow(adeg))) |
|
| 243 | -5986x | +
- if (type == "character" && !is.character(df[[var]])) {
+
|
||
| 244 | -12x | +
- df[[var]] <- as.character(df[[var]])+ # Created function to add in new observations for DTYPE, "MINIMUM" & "MAXIMUM" in this case. |
||
| 245 | -5974x | +3x |
- } else if (type == "factor" && !is.factor(df[[var]])) {
+ get_groups <- function(data, |
|
| 246 | -730x | +3x |
- df[[var]] <- as.factor(df[[var]])+ minimum) {
|
|
| 247 | -5244x | +6x |
- } else if (type == "integer" && !is.integer(df[[var]])) {
+ data <- data %>% |
|
| 248 | -225x | +6x |
- df[[var]] <- as.integer(df[[var]])+ dplyr::group_by(USUBJID, PARAMCD, BASETYPE) %>% |
|
| 249 | -5019x | +6x |
- } else if (type == "numeric" && !is.numeric(df[[var]])) {
+ dplyr::arrange(ADTM, ASPID, EGSEQ) %>% |
|
| 250 | -3x | +6x |
- df[[var]] <- as.numeric(df[[var]])+ dplyr::filter( |
|
| 251 | -5016x | +6x |
- } else if (type == "logical" && !is.logical(df[[var]])) {
+ (AVISIT != "BASELINE" & AVISIT != "SCREENING") & |
|
| 252 | -! | +6x |
- df[[var]] <- as.logical(df[[var]])+ (ONTRTFL == "Y" | ADTM <= TRTSDTM) |
|
| 253 | -5016x | +
- } else if (type == "datetime" && !lubridate::is.POSIXct(df[[var]])) {
+ ) %>% |
||
| 254 | -9x | +
- df[[var]] <- as.POSIXct(df[[var]])+ {
|
||
| 255 | -5007x | +6x |
- } else if (type == "date" && !lubridate::is.Date(df[[var]])) {
+ if (minimum == TRUE) {
|
|
| 256 | -! | +3x |
- df[[var]] <- as.Date(df[[var]])+ dplyr::filter(., AVAL == min(AVAL)) %>% |
|
| 257 | -+ | 3x |
- }+ dplyr::mutate(., DTYPE = "MINIMUM", AVISIT = "POST-BASELINE MINIMUM") |
|
| 258 | -5986x | +
- return(df)+ } else {
|
||
| 259 | -+ | 3x |
- }+ dplyr::filter(., AVAL == max(AVAL)) %>% |
|
| 260 | -+ | 3x |
-
+ dplyr::mutate(., DTYPE = "MAXIMUM", AVISIT = "POST-BASELINE MAXIMUM") |
|
| 261 |
- # remove existing attributes+ } |
|||
| 262 | -90x | +
- for (i in base::setdiff(names(attributes(df)), names(attributes(data.frame())))) {
+ } %>% |
||
| 263 | -3x | +6x |
- attr(df, i) <- NULL+ dplyr::slice(1) %>% |
|
| 264 | -+ | 6x |
- }+ dplyr::ungroup() |
|
| 266 | -+ | 6x |
- # get metadata+ return(data) |
|
| 267 | -90x | +
- metadata <- yaml::yaml.load_file(system.file(filename, package = "random.cdisc.data"))+ } |
||
| 268 | -90x | +
- adsl_metadata <- if (add_adsl) {
+
|
||
| 269 | -64x | +
- yaml::yaml.load_file(system.file(adsl_filename, package = "random.cdisc.data"))+ # Binding the new observations to the dataset from the function above and rearranging in the correct order. |
||
| 270 | -+ | 3x |
- } else {
+ adeg <- rbind(adeg, get_groups(adeg, TRUE), get_groups(adeg, FALSE)) %>% |
|
| 271 | -26x | +3x |
- NULL+ dplyr::arrange(row_check) %>% |
|
| 272 | -+ | 3x |
- }+ dplyr::group_by(USUBJID, PARAMCD, BASETYPE) %>% |
|
| 273 | -90x | +3x |
- metadata_variables <- append(adsl_metadata$variables, metadata$variables)+ dplyr::arrange(AVISIT, .by_group = TRUE) %>% |
|
| 274 | -90x | +3x |
- metadata_varnames <- names(metadata_variables)+ dplyr::ungroup() |
|
| 276 |
- # find variables that does not have labels and are not it metadata+ # Dropping the "row_check" column created above. |
|||
| 277 | -90x | +3x |
- missing_vars_map <- vapply(+ adeg <- adeg[, -which(names(adeg) %in% c("row_check"))]
|
|
| 278 | -90x | +
- names(df),+ |
||
| 279 | -90x | +
- function(x) {
+ # Created function to easily match rows which comply to ONTRTFL derivation |
||
| 280 | -5986x | +3x |
- !(x %in% c("STUDYID", "USUBJID", metadata_varnames)) && is.null(attr(df[[x]], "label"))
+ flag_variables <- function(data, worst_obs) {
|
|
| 281 | -+ | 6x |
- },+ data_compare <- data %>% |
|
| 282 | -90x | +6x |
- logical(1)+ dplyr::mutate(row_check = seq_len(nrow(data))) |
|
| 283 |
- )+ |
|||
| 284 | -90x | +6x |
- missing_vars <- names(df)[missing_vars_map]+ data <- data_compare %>% |
|
| 285 | -90x | +
- if (length(missing_vars) > 0) {
+ {
|
||
| 286 | -! | +6x |
- msg <- paste0(+ if (worst_obs == FALSE) {
|
|
| 287 | -! | +3x |
- "Following variables does not have label or are not found in ",+ dplyr::group_by(., USUBJID, PARAMCD, BASETYPE, AVISIT) %>% |
|
| 288 | -! | +3x |
- filename,+ dplyr::arrange(., ADTM, ASPID, EGSEQ) |
|
| 289 |
- ": ",+ } else {
|
|||
| 290 | -! | +3x |
- paste0(missing_vars, collapse = ", ")+ dplyr::group_by(., USUBJID, PARAMCD, BASETYPE) |
|
| 291 |
- )+ } |
|||
| 292 | -! | +
- warning(msg)+ } %>% |
||
| 293 | -+ | 6x |
- }+ dplyr::filter( |
|
| 294 | -+ | 6x |
-
+ AVISITN > 0 & (ONTRTFL == "Y" | ADTM <= TRTSDTM) & |
|
| 295 | -90x | +6x |
- if (!all(metadata_varnames %in% names(df))) {
+ is.na(DTYPE) |
|
| 296 | -6x | +
- metadata_varnames <- metadata_varnames[metadata_varnames %in% names(df)]+ ) %>% |
||
| 297 |
- }+ {
|
|||
| 298 | -+ | 6x |
-
+ if (worst_obs == TRUE) {
|
|
| 299 | -+ | 3x |
- # assign labels to variables+ dplyr::arrange(., AVALC) %>% dplyr::filter(., ifelse( |
|
| 300 | -90x | +3x |
- for (var in metadata_varnames) {
+ PARAMCD == "ECGINTP", |
|
| 301 | -5986x | +3x |
- df <- apply_type(df, var, metadata_variables[[var]]$type)+ ifelse(AVALC == "ABNORMAL", AVALC == "ABNORMAL", AVALC == "NORMAL"), |
|
| 302 | -5986x | +3x |
- attr(df[[var]], "label") <- metadata_variables[[var]]$label+ AVAL == min(AVAL) |
|
| 303 |
- }+ )) |
|||
| 304 |
-
+ } else {
|
|||
| 305 | -+ | 3x |
- # reorder data frame columns to expected BDS order+ dplyr::filter(., ifelse( |
|
| 306 | -90x | +3x |
- df <- df[, unique(c("STUDYID", "USUBJID", metadata_varnames, names(df)))]
+ PARAMCD == "ECGINTP", |
|
| 307 | -+ | 3x |
-
+ AVALC == "ABNORMAL" | AVALC == "NORMAL", |
|
| 308 | -+ | 3x |
- # assign label to data frame+ AVAL == min(AVAL) |
|
| 309 | -90x | +
- attr(df, "label") <- metadata$domain$label+ )) |
||
| 310 |
-
+ } |
|||
| 311 | -90x | +
- df+ } %>% |
||
| 312 | -+ | 6x |
- }+ dplyr::slice(1) %>% |
|
| 313 |
-
+ {
|
|||
| 314 | -+ | 6x |
- #' Replace Values in a Vector by NA+ if (worst_obs == TRUE) {
|
|
| 315 | -+ | 3x |
- #'+ dplyr::mutate(., new_var = dplyr::case_when( |
|
| 316 | -+ | 3x |
- #' @description `r lifecycle::badge("stable")`
+ (AVALC == "ABNORMAL" | AVALC == "NORMAL") ~ "Y", |
|
| 317 | -+ | 3x |
- #'+ (!is.na(AVAL) & is.na(DTYPE)) ~ "Y", |
|
| 318 | -+ | 3x |
- #' Randomized replacement of values by `NA`.+ TRUE ~ "" |
|
| 319 |
- #'+ )) |
|||
| 320 |
- #' @inheritParams argument_convention+ } else {
|
|||
| 321 | -+ | 3x |
- #' @param v (`any`)\cr Vector of any type.+ dplyr::mutate(., new_var = dplyr::case_when( |
|
| 322 | -+ | 3x |
- #' @param percentage (`proportion`)\cr Value between 0 and 1 defining+ (AVALC == "ABNORMAL" | AVALC == "NORMAL") ~ "Y", |
|
| 323 | -+ | 3x |
- #' how much of the vector shall be replaced by `NA`. This number+ (!is.na(AVAL) & is.na(DTYPE)) ~ "Y", |
|
| 324 | -+ | 3x |
- #' is randomized by +/- 5% to have full randomization.+ TRUE ~ "" |
|
| 325 |
- #'+ )) |
|||
| 326 |
- #' @return The input vector `v` where a certain number of values are replaced by `NA`.+ } |
|||
| 327 |
- #'+ } %>% |
|||
| 328 | -+ | 6x |
- #' @export+ dplyr::ungroup() |
|
| 329 |
- replace_na <- function(v, percentage = 0.05, seed = NULL) {
+
|
|||
| 330 | -9x | +6x |
- checkmate::assert_number(percentage, lower = 0, upper = 1)+ data_compare$new_var <- ifelse(data_compare$row_check %in% data$row_check, "Y", "") |
|
| 331 | -+ | 6x |
-
+ data_compare <- data_compare[, -which(names(data_compare) %in% c("row_check"))]
|
|
| 332 | -9x | +
- if (percentage == 0) {
+
|
||
| 333 | -1x | +6x |
- return(v)+ return(data_compare) |
|
| 336 | -8x | +3x |
- if (!is.null(seed) && !is.na(seed)) {
+ adeg <- flag_variables(adeg, FALSE) %>% dplyr::rename(WORS01FL = "new_var") |
|
| 337 | -8x | +3x |
- set.seed(seed)+ adeg <- flag_variables(adeg, TRUE) %>% dplyr::rename(WORS02FL = "new_var") |
|
| 338 |
- }+ |
|||
| 339 | -+ | 3x |
-
+ adeg <- adeg %>% dplyr::mutate(ANL01FL = factor(ifelse( |
|
| 340 | -+ | 3x |
- # randomize the percentage+ (ABLFL == "Y" | (is.na(DTYPE) & WORS01FL == "Y")) & |
|
| 341 | -8x | +3x |
- ind <- sample(seq_along(v), round(length(v) * percentage))+ (AVISIT != "SCREENING"), |
|
| 342 | -+ | 3x |
-
+ "Y", |
|
| 343 | -8x | +
- v[ind] <- NA+ "" |
||
| 344 |
-
+ ))) |
|||
| 345 | -8x | +
- return(v)+ |
||
| 346 | -+ | 3x |
- }+ adeg <- adeg %>% |
|
| 347 | -+ | 3x |
-
+ dplyr::group_by(USUBJID, PARAMCD, BASETYPE) %>% |
|
| 348 | -+ | 3x |
- #' Replace Values with NA+ dplyr::mutate(BASEC = ifelse( |
|
| 349 | -+ | 3x |
- #'+ PARAMCD == "ECGINTP", |
|
| 350 | -+ | 3x |
- #' @description `r lifecycle::badge("stable")`
+ AVALC[AVISIT == "BASELINE"], |
|
| 351 | -+ | 3x |
- #'+ as.character(BASE) |
|
| 352 |
- #' Replace column values with `NA`s.+ )) %>% |
|||
| 353 | -+ | 3x |
- #'+ dplyr::mutate(ANL03FL = dplyr::case_when( |
|
| 354 | -+ | 3x |
- #' @inheritParams argument_convention+ DTYPE == "MINIMUM" ~ "Y", |
|
| 355 | -+ | 3x |
- #' @param ds (`data.frame`)\cr Any data set.+ ABLFL == "Y" & PARAMCD != "ECGINTP" ~ "Y", |
|
| 356 | -+ | 3x |
- #'+ TRUE ~ "" |
|
| 357 |
- #' @return dataframe without `NA` values.+ )) %>% |
|||
| 358 | -+ | 3x |
- #'+ dplyr::mutate(ANL04FL = dplyr::case_when( |
|
| 359 | -+ | 3x |
- #' @export+ DTYPE == "MAXIMUM" ~ "Y", |
|
| 360 | -+ | 3x |
- mutate_na <- function(ds, na_vars = NULL, na_percentage = 0.05) {
+ ABLFL == "Y" & PARAMCD != "ECGINTP" ~ "Y", |
|
| 361 | -5x | +3x |
- if (!is.null(na_vars)) {
+ TRUE ~ "" |
|
| 362 | -4x | +
- stopifnot(is.list(na_vars)) # any list is OK; as values can be left NA+ )) %>% |
||
| 363 | -4x | +3x |
- stopifnot(length(names(na_vars)) == length(na_vars)) # names for all elements+ dplyr::ungroup() |
|
| 364 |
- } else {
+
|
|||
| 365 | -1x | +3x |
- na_vars <- names(ds)+ if (length(na_vars) > 0 && na_percentage > 0) {
|
|
| 366 | +! | +
+ adeg <- mutate_na(ds = adeg, na_vars = na_vars, na_percentage = na_percentage)+ |
+ ||
| 367 |
} |
|||
| 367 | +368 | |||
| 369 | ++ |
+ # apply metadata+ |
+ ||
| 368 | -5x | +370 | +3x |
- stopifnot(is.numeric(na_percentage))+ adeg <- apply_metadata(adeg, "metadata/ADEG.yml")+ |
+
| 371 | ++ | + | ||
| 369 | -5x | +372 | +3x |
- stopifnot(na_percentage >= 0 && na_percentage < 1)+ return(adeg)+ |
+
| 373 | ++ |
+ }+ |
+
| 1 | ++ |
+ #' Hy's Law Analysis Dataset (ADHY)+ |
+ ||
| 2 | ++ |
+ #' |
||
| 370 | +3 |
-
+ #' @description `r lifecycle::badge("stable")`
|
||
| 371 | -5x | +|||
| 4 | +
- for (na_var in names(na_vars)) {
+ #' |
|||
| 372 | -8x | +|||
| 5 | +
- if (!is.na(na_var)) {
+ #' Function for generating a random Hy's Law Analysis Dataset for a given |
|||
| 373 | -8x | +|||
| 6 | +
- if (!na_var %in% names(ds)) {
+ #' Subject-Level Analysis Dataset. |
|||
| 374 | -1x | +|||
| 7 | +
- warning(paste(na_var, "not in column names"))+ #' |
|||
| 375 | +8 |
- } else {
+ #' @details One record per subject per parameter per analysis visit per analysis date. |
||
| 376 | -7x | +|||
| 9 | +
- ds <- ds %>%+ #' |
|||
| 377 | -7x | +|||
| 10 | +
- ungroup_rowwise_df() %>%+ #' Keys: `STUDYID`, `USUBJID`, `PARAMCD`, `AVISITN`, `ADTM`, `SRCSEQ` |
|||
| 378 | -7x | +|||
| 11 | +
- dplyr::mutate(+ # |
|||
| 379 | -7x | +|||
| 12 | +
- !!na_var := ds[[na_var]] %>%+ #' @inheritParams argument_convention |
|||
| 380 | -7x | +|||
| 13 | +
- replace_na(+ #' @template param_cached |
|||
| 381 | -7x | +|||
| 14 | +
- percentage = ifelse(is.na(na_vars[[na_var]][2]), na_percentage, na_vars[[na_var]][2]),+ #' @templateVar data adhy |
|||
| 382 | -7x | +|||
| 15 | +
- seed = na_vars[[na_var]][1]+ #' |
|||
| 383 | +16 |
- )+ #' @return `data.frame` |
||
| 384 | +17 |
- )+ #' @export |
||
| 385 | +18 |
- }+ #' |
||
| 386 | +19 |
- }+ #' @author wojciakw |
||
| 387 | +20 |
- }+ #' |
||
| 388 | -5x | +|||
| 21 | +
- return(ds)+ #' @examples |
|||
| 389 | +22 |
- }+ #' adsl <- radsl(N = 10, seed = 1, study_duration = 2) |
||
| 390 | +23 |
-
+ #' |
||
| 391 | +24 |
- ungroup_rowwise_df <- function(x) {
+ #' adhy <- radhy(adsl, seed = 2) |
||
| 392 | -7x | +|||
| 25 | +
- class(x) <- c("tbl", "tbl_df", "data.frame")
+ #' adhy |
|||
| 393 | -7x | +|||
| 26 | +
- return(x)+ radhy <- function(adsl, |
|||
| 394 | +27 |
- }+ param = c( |
||
| 395 | +28 |
-
+ "TBILI <= 2 times ULN and ALT value category", |
||
| 396 | +29 |
- #' Zero-Truncated Poisson Distribution+ "TBILI > 2 times ULN and AST value category", |
||
| 397 | +30 |
- #'+ "TBILI > 2 times ULN and ALT value category", |
||
| 398 | +31 |
- #' @description `r lifecycle::badge("stable")`
+ "TBILI <= 2 times ULN and AST value category", |
||
| 399 | +32 |
- #'+ "TBILI > 2 times ULN and ALKPH <= 2 times ULN and ALT value category", |
||
| 400 | +33 |
- #' This generates random numbers from a zero-truncated Poisson distribution,+ "TBILI > 2 times ULN and ALKPH <= 2 times ULN and AST value category", |
||
| 401 | +34 |
- #' i.e. from `X | X > 0` when `X ~ Poisson(lambda)`. The advantage here is that+ "TBILI > 2 times ULN and ALKPH <= 5 times ULN and ALT value category", |
||
| 402 | +35 |
- #' we guarantee to return exactly `n` numbers and without using a loop internally.+ "TBILI > 2 times ULN and ALKPH <= 5 times ULN and AST value category", |
||
| 403 | +36 |
- #' This solution was provided in a post by+ "TBILI <= 2 times ULN and two consecutive elevations of ALT in relation to ULN", |
||
| 404 | +37 |
- #' [Peter Dalgaard](https://stat.ethz.ch/pipermail/r-help/2005-May/070680.html).+ "TBILI > 2 times ULN and two consecutive elevations of AST in relation to ULN", |
||
| 405 | +38 |
- #'+ "TBILI <= 2 times ULN and two consecutive elevations of AST in relation to ULN", |
||
| 406 | +39 |
- #' @param n (`numeric`)\cr Number of random numbers.+ "TBILI > 2 times ULN and two consecutive elevations of ALT in relation to ULN", |
||
| 407 | +40 |
- #' @param lambda (`numeric`)\cr Non-negative mean(s).+ "TBILI > 2 times ULN and two consecutive elevations of ALT in relation to Baseline", |
||
| 408 | +41 |
- #'+ "TBILI <= 2 times ULN and two consecutive elevations of ALT in relation to Baseline", |
||
| 409 | +42 |
- #' @return The random numbers.+ "TBILI > 2 times ULN and two consecutive elevations of AST in relation to Baseline", |
||
| 410 | +43 |
- #' @export+ "TBILI <= 2 times ULN and two consecutive elevations of AST in relation to Baseline", |
||
| 411 | +44 |
- #'+ "ALT > 3 times ULN by Period", |
||
| 412 | +45 |
- #' @examples+ "AST > 3 times ULN by Period", |
||
| 413 | +46 |
- #' x <- rpois(1e6, lambda = 5)+ "ALT or AST > 3 times ULN by Period", |
||
| 414 | +47 |
- #' x <- x[x > 0]+ "ALT > 3 times Baseline by Period", |
||
| 415 | +48 |
- #' hist(x)+ "AST > 3 times Baseline by Period", |
||
| 416 | +49 |
- #'+ "ALT or AST > 3 times Baseline by Period" |
||
| 417 | +50 |
- #' y <- rtpois(1e6, lambda = 5)+ ), |
||
| 418 | +51 |
- #' hist(y)+ paramcd = c( |
||
| 419 | +52 |
- rtpois <- function(n, lambda) {
+ "BLAL", |
||
| 420 | -121x | +|||
| 53 | +
- stats::qpois(stats::runif(n, stats::dpois(0, lambda), 1), lambda)+ "BGAS", |
|||
| 421 | +54 |
- }+ "BGAL", |
||
| 422 | +55 |
-
+ "BLAS", |
||
| 423 | +56 |
- #' Truncated Exponential Distribution+ "BA2AL", |
||
| 424 | +57 |
- #'+ "BA2AS", |
||
| 425 | +58 |
- #' @description `r lifecycle::badge("stable")`
+ "BA5AL", |
||
| 426 | +59 |
- #'+ "BA5AS", |
||
| 427 | +60 |
- #' This generates random numbers from a truncated Exponential distribution,+ "BL2AL2CU", |
||
| 428 | +61 |
- #' i.e. from `X | X > l` or `X | X < r` when `X ~ Exp(rate)`. The advantage here is that+ "BG2AS2CU", |
||
| 429 | +62 |
- #' we guarantee to return exactly `n` numbers and without using a loop internally.+ "BL2AS2CU", |
||
| 430 | +63 |
- #' This can be derived from the quantile functions of the left- and right-truncated+ "BG2AL2CU", |
||
| 431 | +64 |
- #' Exponential distributions.+ "BG2AL2CB", |
||
| 432 | +65 |
- #'+ "BL2AL2CB", |
||
| 433 | +66 |
- #' @param n (`numeric`)\cr Number of random numbers.+ "BG2AS2CB", |
||
| 434 | +67 |
- #' @param rate (`numeric`)\cr Non-negative rate.+ "BL2AS2CB", |
||
| 435 | +68 |
- #' @param l (`numeric`)\cr Positive left-hand truncation parameter.+ "ALTPULN", |
||
| 436 | +69 |
- #' @param r (`numeric`)\cr Positive right-hand truncation parameter.+ "ASTPULN", |
||
| 437 | +70 |
- #'+ "ALTASTPU", |
||
| 438 | +71 |
- #' @return The random numbers. If neither `l` nor `r` are provided then the usual Exponential+ "ALTPBASE", |
||
| 439 | +72 |
- #' distribution is used.+ "ASTPBASE", |
||
| 440 | +73 |
- #' @export+ "ALTASTPB" |
||
| 441 | +74 |
- #'+ ), |
||
| 442 | +75 |
- #' @examples+ seed = NULL, |
||
| 443 | +76 |
- #' x <- stats::rexp(1e6, rate = 5)+ cached = FALSE) {
+ |
+ ||
| 77 | +4x | +
+ checkmate::assert_flag(cached) |
||
| 444 | +78 |
- #' x <- x[x > 0.5]+ + |
+ ||
| 79 | +4x | +
+ if (cached) {
+ |
+ ||
| 80 | +1x | +
+ return(get_cached_data("cadhy"))
|
||
| 445 | +81 |
- #' hist(x)+ } |
||
| 446 | +82 |
- #'+ + |
+ ||
| 83 | +3x | +
+ checkmate::assert_data_frame(adsl)+ |
+ ||
| 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) |
||
| 447 | +87 |
- #' y <- rtexp(1e6, rate = 5, l = 0.5)+ |
||
| 448 | +88 |
- #' hist(y)+ # validate and initialize related variables+ |
+ ||
| 89 | +3x | +
+ param_init_list <- relvar_init(param, paramcd) |
||
| 449 | +90 |
- #'+ + |
+ ||
| 91 | +3x | +
+ if (!is.null(seed)) {
+ |
+ ||
| 92 | +3x | +
+ set.seed(seed) |
||
| 450 | +93 |
- #' z <- rtexp(1e6, rate = 5, r = 0.5)+ }+ |
+ ||
| 94 | +3x | +
+ study_duration_secs <- lubridate::seconds(attr(adsl, "study_duration_secs")) |
||
| 451 | +95 |
- #' hist(z)+ |
||
| 452 | +96 |
- rtexp <- function(n, rate, l = NULL, r = NULL) {
+ # create all combinations of unique values in STUDYID, USUBJID, PARAM, AVISIT |
||
| 453 | -123x | +97 | +3x |
- if (!is.null(l)) {
+ adhy <- expand.grid( |
| 454 | -1x | +98 | +3x |
- l - log(1 - stats::runif(n)) / rate+ STUDYID = unique(adsl$STUDYID), |
| 455 | -122x | +99 | +3x |
- } else if (!is.null(r)) {
+ USUBJID = adsl$USUBJID, |
| 456 | -121x | +100 | +3x |
- -log(1 - stats::runif(n) * (1 - exp(-r * rate))) / rate+ PARAM = as.factor(param_init_list$relvar1), |
| 457 | -+ | |||
| 101 | +3x |
- } else {
+ AVISIT = as.factor(c("BASELINE", "POST-BASELINE")),
|
||
| 458 | -1x | +102 | +3x | +
+ APERIODC = as.factor(c("PERIOD 1", "PERIOD 2")),
+ |
+
| 103 | +3x |
- stats::rexp(n, rate)+ stringsAsFactors = FALSE |
||
| 459 | +104 |
- }+ ) |
||
| 460 | +105 |
- }+ |
| 1 | +106 |
- #' Pharmacokinetics Analysis Dataset (ADPC)+ # remove records that are not needed and were created as a side product of expand.grid above |
||||
| 2 | -+ | |||||
| 107 | +3x |
- #'+ adhy <- dplyr::filter(adhy, !(AVISIT == "BASELINE" & APERIODC == "PERIOD 2")) |
||||
| 3 | +108 |
- #' @description `r lifecycle::badge("stable")`
+
|
||||
| 4 | +109 |
- #'+ # define TBILI ALT/AST params, period dependent parameters and the parameters that will be assigned values "Y" or "N" |
||||
| 5 | -+ | |||||
| 110 | +3x |
- #' Function for generating a random Pharmacokinetics Analysis Dataset for a given+ paramcd_tbilialtast <- c("BLAL", "BGAS", "BGAL", "BLAS", "BA2AL", "BA2AS", "BA5AL", "BA5AS")
|
||||
| 6 | -+ | |||||
| 111 | +3x |
- #' Subject-Level Analysis Dataset.+ paramcd_by_period <- c("ALTPULN", "ASTPULN", "ALTASTPU", "ALTPBASE", "ASTPBASE", "ALTASTPB")
|
||||
| 7 | -+ | |||||
| 112 | +3x |
- #'+ paramcd_yn <- c( |
||||
| 8 | -+ | |||||
| 113 | +3x |
- #' @details One record per study, subject, parameter, and time point.+ "BL2AL2CU", "BG2AS2CU", "BL2AS2CU", "BG2AL2CU", "BG2AL2CB", "BL2AL2CB", "BG2AS2CB", "BL2AS2CB", |
||||
| 9 | -+ | |||||
| 114 | +3x |
- #'+ paramcd_by_period |
||||
| 10 | +115 |
- #' @inheritParams argument_convention+ ) |
||||
| 11 | +116 |
- #' @param avalu (`character`)\cr Analysis value units.+ |
||||
| 12 | +117 |
- #' @param constants (`character vector`)\cr Constant parameters to be used in formulas for creating analysis values.+ # add other variables to adhy |
||||
| 13 | -+ | |||||
| 118 | +3x |
- #' @param duration (`numeric`)\cr Duration in number of days.+ adhy <- adhy %>% |
||||
| 14 | -+ | |||||
| 119 | +3x |
- #' @template param_cached+ rel_var( |
||||
| 15 | -+ | |||||
| 120 | +3x |
- #' @templateVar data adpc+ var_name = "PARAMCD", |
||||
| 16 | -+ | |||||
| 121 | +3x |
- #'+ related_var = "PARAM", |
||||
| 17 | -+ | |||||
| 122 | +3x |
- #' @return `data.frame`+ var_values = param_init_list$relvar2 |
||||
| 18 | +123 |
- #' @export+ ) %>% |
||||
| 19 | -+ | |||||
| 124 | +3x |
- #'+ dplyr::mutate( |
||||
| 20 | -+ | |||||
| 125 | +3x |
- #' @examples+ AVALC = dplyr::case_when( |
||||
| 21 | -+ | |||||
| 126 | +3x |
- #' adsl <- radsl(N = 10, seed = 1, study_duration = 2)+ PARAMCD %in% paramcd_tbilialtast ~ sample( |
||||
| 22 | -+ | |||||
| 127 | +3x |
- #'+ x = c(">3-5ULN", ">5-10ULN", ">10-20ULN", ">20ULN", "Criteria not met"), size = dplyr::n(), replace = TRUE
|
||||
| 23 | +128 |
- #' adpc <- radpc(adsl, seed = 2)+ ), |
||||
| 24 | -+ | |||||
| 129 | +3x |
- #' adpc+ PARAMCD %in% paramcd_yn ~ sample( |
||||
| 25 | -+ | |||||
| 130 | +3x |
- #'+ x = c("Y", "N"), prob = c(0.1, 0.9), size = dplyr::n(), replace = TRUE
|
||||
| 26 | +131 |
- #' adpc <- radpc(adsl, seed = 2, duration = 3)+ ) |
||||
| 27 | +132 |
- #' adpc+ ), |
||||
| 28 | -+ | |||||
| 133 | +3x |
- radpc <- function(adsl,+ AVAL = dplyr::case_when( |
||||
| 29 | -+ | |||||
| 134 | +3x |
- avalu = "ug/mL",+ AVALC == ">3-5ULN" ~ 1, |
||||
| 30 | -+ | |||||
| 135 | +3x |
- constants = c(D = 100, ka = 0.8, ke = 1),+ AVALC == ">5-10ULN" ~ 2, |
||||
| 31 | -+ | |||||
| 136 | +3x |
- duration = 2,+ AVALC == ">10-20ULN" ~ 3, |
||||
| 32 | -+ | |||||
| 137 | +3x |
- seed = NULL,+ AVALC == ">20ULN" ~ 4, |
||||
| 33 | -+ | |||||
| 138 | +3x |
- na_percentage = 0,+ AVALC == "Y" ~ 1, |
||||
| 34 | -+ | |||||
| 139 | +3x |
- na_vars = list(+ AVALC == "N" ~ 0, |
||||
| 35 | -+ | |||||
| 140 | +3x |
- AVAL = c(NA, 0.1)+ AVALC == "Criteria not met" ~ 0 |
||||
| 36 | +141 |
- ),+ ), |
||||
| 37 | -+ | |||||
| 142 | +3x |
- cached = FALSE) {
+ AVISITN = dplyr::case_when( |
||||
| 38 | -5x | +143 | +3x |
- checkmate::assert_flag(cached)+ AVISIT == "BASELINE" ~ 0L, |
||
| 39 | -5x | +144 | +3x |
- if (cached) {
+ AVISIT == "POST-BASELINE" ~ 9995L, |
||
| 40 | -1x | +145 | +3x |
- return(get_cached_data("cadpc"))
+ TRUE ~ NA_integer_ |
||
| 41 | +146 |
- }+ ), |
||||
| 42 | -+ | |||||
| 147 | +3x |
-
+ APERIOD = dplyr::case_when( |
||||
| 43 | -4x | +148 | +3x |
- checkmate::assert_data_frame(adsl)+ APERIODC == "PERIOD 1" ~ 1L, |
||
| 44 | -4x | +149 | +3x |
- checkmate::assert_character(avalu, len = 1, any.missing = FALSE)+ APERIODC == "PERIOD 2" ~ 2L, |
||
| 45 | -4x | +150 | +3x |
- checkmate::assert_subset(names(constants), c("D", "ka", "ke"))
+ TRUE ~ NA_integer_ |
||
| 46 | -4x | +|||||
| 151 | +
- checkmate::assert_numeric(x = duration, max.len = 1)+ ), |
|||||
| 47 | -4x | +152 | +3x |
- checkmate::assert_number(seed, null.ok = TRUE)+ ABLFL = dplyr::if_else(AVISIT == "BASELINE", "Y", NA_character_), |
||
| 48 | -4x | +153 | +3x |
- checkmate::assert_number(na_percentage, lower = 0, upper = 1)+ ONTRTFL = dplyr::if_else(AVISIT == "POST-BASELINE", "Y", NA_character_), |
||
| 49 | -4x | +154 | +3x |
- checkmate::assert_true(na_percentage < 1)+ ANL01FL = "Y", |
||
| 50 | -4x | +155 | +3x |
- checkmate::assert_list(na_vars)+ SRCSEQ = NA_integer_ |
||
| 51 | +156 | ++ |
+ )+ |
+ |||
| 157 | ||||||
| 52 | -4x | +|||||
| 158 | +
- if (!is.null(seed)) {
+ # remove records for parameters with period 2 and not in paramcd_by_period |
|||||
| 53 | -4x | +159 | +3x |
- set.seed(seed)+ adhy <- dplyr::filter(adhy, PARAMCD %in% paramcd_by_period | APERIODC == "PERIOD 1") |
||
| 54 | +160 |
- }+ |
||||
| 55 | +161 |
-
+ # add baseline variables |
||||
| 56 | -4x | +162 | +3x |
- radpc_core <- function(day) {
+ adhy <- adhy %>% |
||
| 57 | -8x | +163 | +3x |
- adpc_day <- tidyr::expand_grid(+ dplyr::group_by(USUBJID, PARAMCD) %>% |
||
| 58 | -8x | +164 | +3x |
- data.frame(+ dplyr::mutate( |
||
| 59 | -8x | +165 | +3x |
- STUDYID = adsl$STUDYID,+ BASEC = AVALC[AVISIT == "BASELINE"], |
||
| 60 | -8x | +166 | +3x |
- USUBJID = adsl$USUBJID,+ BASE = AVAL[AVISIT == "BASELINE"] |
||
| 61 | -8x | +|||||
| 167 | +
- ARMCD = adsl$ARMCD,+ ) %>% |
|||||
| 62 | -8x | +168 | +3x |
- A0 = unname(constants["D"]),+ dplyr::ungroup() |
||
| 63 | -8x | +|||||
| 169 | +
- ka = unname(constants["ka"]) - stats::runif(length(adsl$USUBJID), -0.2, 0.2),+ |
|||||
| 64 | -8x | +170 | +3x |
- ke = unname(constants["ke"]) - stats::runif(length(adsl$USUBJID), -0.2, 0.2)+ adhy <- adhy %>% |
||
| 65 | -+ | |||||
| 171 | +3x |
- ),+ rcd_var_relabel( |
||||
| 66 | -8x | +172 | +3x |
- PCTPTNUM = if (day == 1) c(0, 0.5, 1, 1.5, 2, 3, 4, 8, 12) else 24 * (day - 1),+ STUDYID = attr(adsl$STUDYID, "label"), |
||
| 67 | -8x | +173 | +3x |
- PARAM = factor(c("Plasma Drug X", "Urine Drug X", "Plasma Drug Y", "Urine Drug Y"))
+ USUBJID = attr(adsl$USUBJID, "label") |
||
| 68 | +174 |
) |
||||
| 69 | -8x | -
- adpc_day <- adpc_day[!(grepl("Urine", adpc_day$PARAM) & adpc_day$PCTPTNUM %in% c(0.5, 1, 1.5, 2, 3)), ] %>%
- |
- ||||
| 70 | -8x | +|||||
| 175 | +
- dplyr::arrange(USUBJID, PARAM) %>%+ |
|||||
| 71 | -8x | +|||||
| 176 | +
- dplyr::mutate(+ # merge ADSL to be able to add analysis datetime and analysis relative day variables |
|||||
| 72 | -8x | +177 | +3x |
- VISITDY = day,+ adhy <- dplyr::inner_join(adhy, adsl, by = c("STUDYID", "USUBJID"))
|
||
| 73 | -8x | +|||||
| 178 | +
- VISIT = ifelse(day <= 7, paste("Day", VISITDY), paste("Week", (VISITDY - 1) / 7)),
+
|
|||||
| 74 | -8x | +|||||
| 179 | +
- PCVOLU = ifelse(grepl("Urine", PARAM), "mL", ""),
+ # define a simple helper function to create ADY variable |
|||||
| 75 | -8x | +180 | +3x |
- ASMED = ifelse(grepl("Urine", PARAM), "URINE", "PLASMA"),
+ add_ady <- function(x, avisit) {
|
||
| 76 | -8x | +181 | +6x |
- PCTPT = factor(dplyr::case_when(+ if (avisit == "BASELINE") {
|
||
| 77 | -8x | +182 | +3x |
- PCTPTNUM == 0 ~ "Predose",+ dplyr::mutate( |
||
| 78 | -8x | +183 | +3x |
- (day == 1 & grepl("Urine", PARAM)) ~
+ x, |
||
| 79 | -8x | +184 | +3x |
- paste0(lag(PCTPTNUM), "H - ", PCTPTNUM, "H"),+ ADY = sample(x = -(1:14), size = dplyr::n(), replace = TRUE) |
||
| 80 | -8x | +|||||
| 185 | +
- (day != 1 & grepl("Urine", PARAM)) ~
+ ) |
|||||
| 81 | -8x | +186 | +3x |
- paste0(as.numeric(PCTPTNUM) - 24, "H - ", PCTPTNUM, "H"),+ } else if (avisit == "POST-BASELINE") {
|
||
| 82 | -8x | +187 | +3x |
- TRUE ~ paste0(PCTPTNUM, "H")+ dplyr::rowwise(x) %>% |
||
| 83 | -+ | |||||
| 188 | +3x |
- )),+ dplyr::mutate(ADY = as.integer(sample( |
||||
| 84 | -8x | +189 | +3x |
- ARELTM1 = PCTPTNUM,+ dplyr::if_else( |
||
| 85 | -8x | +190 | +3x |
- NRELTM1 = PCTPTNUM,+ !is.na(TRTEDTM), |
||
| 86 | -8x | +191 | +3x |
- ARELTM2 = ARELTM1 - (24 * (day - 1)),+ as.numeric(difftime(TRTEDTM, TRTSDTM, units = "days")), |
||
| 87 | -8x | +192 | +3x |
- NRELTM2 = NRELTM1 - (24 * (day - 1)),+ as.numeric(study_duration_secs, "days") |
||
| 88 | -8x | +|||||
| 193 | +
- A0 = ifelse(PARAM == "Plasma Drug Y", A0, A0 / 2),+ ), |
|||||
| 89 | -8x | +194 | +3x |
- AVAL = round(+ size = 1, |
||
| 90 | -8x | +195 | +3x |
- (A0 * ka * (+ replace = TRUE |
||
| 91 | -8x | +|||||
| 196 | +
- exp(-ka * ARELTM1) - exp(-ke * ARELTM1)+ ))) |
|||||
| 92 | +197 |
- ))+ } else {
|
||||
| 93 | -8x | +|||||
| 198 | +! |
- / (ke - ka),+ dplyr::mutate(x, ADY = NA_integer_) |
||||
| 94 | -8x | +|||||
| 199 | +
- digits = 3+ } |
|||||
| 95 | +200 |
- )+ } |
||||
| 96 | +201 |
- ) %>%+ + |
+ ||||
| 202 | ++ |
+ # add ADY and ADTM variables |
||||
| 97 | -8x | +203 | +3x |
- dplyr::mutate(+ adhy <- adhy %>% |
||
| 98 | -8x | +204 | +3x |
- PCVOL = ifelse(+ dplyr::group_by(AVISIT, .add = FALSE) %>% |
||
| 99 | -8x | +205 | +3x |
- ASMED == "URINE",+ dplyr::group_modify(~ add_ady(.x, .y$AVISIT)) %>% |
||
| 100 | -8x | +206 | +3x |
- round(abs(((PCTPTNUM - 1) %% 24) * A0 * ka * exp(PCTPTNUM %% 1.8 / 10)), 2),+ dplyr::ungroup() %>% |
||
| 101 | -8x | +207 | +3x |
- NA+ dplyr::mutate(ADTM = TRTSDTM + lubridate::days(ADY)) |
||
| 102 | +208 |
- ),+ |
||||
| 103 | +209 |
- # PK Equation+ # order columns and arrange rows; column order follows ADaM_1.1 specification |
||||
| 104 | -8x | +210 | +3x |
- AVALC = ifelse(AVAL == 0, "BLQ", as.character(AVAL)),+ adhy <- |
||
| 105 | -8x | +211 | +3x |
- AVALU = avalu,+ adhy[, c( |
||
| 106 | -8x | +212 | +3x |
- RELTMU = "hr"+ colnames(adsl), |
||
| 107 | -+ | |||||
| 213 | +3x |
- ) %>%+ "PARAM", |
||||
| 108 | -8x | +214 | +3x |
- dplyr::select(-c("A0", "ka", "ke"))
+ "PARAMCD", |
||
| 109 | -+ | |||||
| 215 | +3x |
-
+ "AVAL", |
||||
| 110 | -8x | +216 | +3x |
- return(adpc_day)+ "AVALC", |
||
| 111 | -+ | |||||
| 217 | +3x |
- }+ "BASE", |
||||
| 112 | -+ | |||||
| 218 | +3x |
-
+ "BASEC", |
||||
| 113 | -4x | +219 | +3x |
- adpc <- list()+ "ABLFL", |
||
| 114 | -+ | |||||
| 220 | +3x |
-
+ "ADTM", |
||||
| 115 | -4x | +221 | +3x |
- for (day in seq(duration)[seq(duration) <= 7 | ((seq(duration) - 1) %% 7 == 0)]) {
+ "ADY", |
||
| 116 | -8x | +222 | +3x |
- adpc[[day]] <- radpc_core(day = day)+ "AVISIT", |
||
| 117 | -+ | |||||
| 223 | +3x |
- }+ "AVISITN", |
||||
| 118 | -+ | |||||
| 224 | +3x |
-
+ "APERIOD", |
||||
| 119 | -4x | +225 | +3x |
- adpc <- do.call(rbind, adpc)+ "APERIODC", |
||
| 120 | -+ | |||||
| 226 | +3x |
-
+ "ONTRTFL", |
||||
| 121 | -4x | +227 | +3x |
- adpc <- dplyr::inner_join(adpc, adsl, by = c("STUDYID", "USUBJID", "ARMCD")) %>%
+ "SRCSEQ", |
||
| 122 | -4x | +228 | +3x |
- dplyr::filter(ACTARM != "B: Placebo", !(ACTARM == "A: Drug X" & PARAM == "Plasma Drug Y"))+ "ANL01FL" |
||
| 123 | +229 |
-
+ )] |
||||
| 124 | -4x | +|||||
| 230 | +
- if (length(na_vars) > 0 && na_percentage > 0) {
+
|
|||||
| 125 | -! | +|||||
| 231 | +3x |
- adpc <- mutate_na(ds = adpc, na_vars = na_vars, na_percentage = na_percentage)+ adhy <- adhy %>% |
||||
| 126 | -+ | |||||
| 232 | +3x |
- }+ dplyr::arrange( |
||||
| 127 | -+ | |||||
| 233 | +3x |
-
+ STUDYID, |
||||
| 128 | -4x | +234 | +3x |
- adpc <- adpc %>%+ USUBJID, |
||
| 129 | -4x | +235 | +3x |
- rename(+ PARAMCD, |
||
| 130 | -4x | +236 | +3x |
- AVALCAT1 = AVALC,+ AVISITN, |
||
| 131 | -4x | +237 | +3x |
- NFRLT = NRELTM1,+ ADTM, |
||
| 132 | -4x | +238 | +3x |
- AFRLT = ARELTM1,+ SRCSEQ |
||
| 133 | -4x | +|||||
| 239 | +
- NRRLT = NRELTM2,+ ) |
|||||
| 134 | -4x | +|||||
| 240 | +
- ARRLT = ARELTM2+ |
|||||
| 135 | +241 |
- ) %>%+ # apply metadata |
||||
| 136 | -4x | +242 | +3x |
- mutate(ANL02FL = "Y")+ adhy <- apply_metadata(adhy, "metadata/ADHY.yml") |
||
| 137 | +243 | |||||
| 138 | -4x | +244 | +3x |
- adpc <- apply_metadata(adpc, "metadata/ADPC.yml")+ return(adhy) |
||
| 139 | +245 |
}@@ -27157,7 +27198,7 @@ random.cdisc.data coverage - 98.86% | 146 | 3x |
- adsub <- var_relabel(+ adsub <- rcd_var_relabel( |
|
| 1 |
- #' Vital Signs Analysis Dataset (ADVS)+ #' Subject-Level Analysis Dataset (ADSL) |
|||
| 5 |
- #' Function for generating a random Vital Signs 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 subject per parameter per analysis visit per analysis date.+ #' 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`, `PARAMCD`, `BASETYPE`, `AVISITN`, `ATPTN`, `DTYPE`, `ADTM`, `VSSEQ`, `ASPID`+ #' trial even if no other analysis data sets are submitted. |
|||
| 12 |
- #' @inheritParams argument_convention+ #' @details One record per subject. |
|||
| 13 |
- #' @template param_cached+ #' |
|||
| 14 |
- #' @templateVar data advs+ #' Keys: `STUDYID`, `USUBJID` |
|||
| 16 |
- #' @return `data.frame`+ #' @inheritParams argument_convention |
|||
| 17 |
- #' @export+ #' @param N (`numeric`)\cr Number of patients. |
|||
| 18 |
- #'+ #' @param study_duration (`numeric`)\cr Duration of study in years. |
|||
| 19 |
- #' @author npaszty+ #' @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 |
- #' advs <- radvs(adsl, visit_format = "WEEK", n_assessments = 7L, seed = 2)+ #' |
|||
| 25 |
- #' advs+ #' @return `data.frame` |
|||
| 26 |
- #'+ #' @export |
|||
| 27 |
- #' advs <- radvs(adsl, visit_format = "CYCLE", n_assessments = 3L, seed = 2)+ # |
|||
| 28 |
- #' advs+ #' @examples |
|||
| 29 |
- radvs <- function(adsl,+ #' adsl <- radsl(N = 10, study_duration = 2, seed = 1) |
|||
| 30 |
- param = c(+ #' adsl |
|||
| 31 |
- "Diastolic Blood Pressure",+ #' |
|||
| 32 |
- "Pulse Rate",+ #' adsl <- radsl( |
|||
| 33 |
- "Respiratory Rate",+ #' N = 10, seed = 1, |
|||
| 34 |
- "Systolic Blood Pressure",+ #' na_percentage = 0.1, |
|||
| 35 |
- "Temperature", "Weight"+ #' na_vars = list( |
|||
| 36 |
- ),+ #' DTHDT = c(seed = 1234, percentage = 0.1), |
|||
| 37 |
- paramcd = c("DIABP", "PULSE", "RESP", "SYSBP", "TEMP", "WEIGHT"),
+ #' LSTALVDT = c(seed = 1234, percentage = 0.1) |
|||
| 38 |
- paramu = c("Pa", "beats/min", "breaths/min", "Pa", "C", "Kg"),
+ #' ) |
|||
| 39 |
- visit_format = "WEEK",+ #' ) |
|||
| 40 |
- n_assessments = 5L,+ #' adsl |
|||
| 41 |
- n_days = 5L,+ #' |
|||
| 42 |
- seed = NULL,+ #' adsl <- radsl(N = 10, seed = 1, na_percentage = .1) |
|||
| 43 |
- na_percentage = 0,+ #' adsl |
|||
| 44 |
- na_vars = list(+ radsl <- function(N = 400, # nolint |
|||
| 45 |
- CHG2 = c(1235, 0.1), PCHG2 = c(1235, 0.1), CHG = c(1234, 0.1), PCHG = c(1234, 0.1),+ study_duration = 2, |
|||
| 46 |
- AVAL = c(123, 0.1), AVALU = c(123, 0.1)+ seed = NULL, |
|||
| 47 |
- ),+ with_trt02 = TRUE, |
|||
| 48 |
- cached = FALSE) {
+ na_percentage = 0, |
|||
| 49 | -4x | +
- checkmate::assert_flag(cached)+ na_vars = list( |
||
| 50 | -4x | +
- if (cached) {
+ "AGE" = NA, "SEX" = NA, "RACE" = NA, "STRATA1" = NA, "STRATA2" = NA, |
||
| 51 | -1x | +
- return(get_cached_data("cadvs"))
+ "BMRKR1" = c(seed = 1234, percentage = 0.1), "BMRKR2" = c(1234, 0.1), "BEP01FL" = NA |
||
| 52 |
- }+ ), |
|||
| 53 |
-
+ ae_withdrawal_prob = 0.05, |
|||
| 54 | -3x | +
- checkmate::assert_data_frame(adsl)+ cached = FALSE) {
|
||
| 55 | -3x | +28x |
- checkmate::assert_character(param, min.len = 1, any.missing = FALSE)+ checkmate::assert_flag(cached) |
|
| 56 | -3x | +28x |
- checkmate::assert_character(paramcd, min.len = 1, any.missing = FALSE)+ if (cached) {
|
|
| 57 | -3x | +2x |
- checkmate::assert_character(paramu, min.len = 1, any.missing = FALSE)+ return(get_cached_data("cadsl"))
|
|
| 58 | -3x | +
- checkmate::assert_string(visit_format)+ } |
||
| 59 | -3x | +
- checkmate::assert_integer(n_assessments, len = 1, any.missing = FALSE)+ |
||
| 60 | -3x | +26x |
- checkmate::assert_integer(n_days, len = 1, any.missing = FALSE)+ checkmate::assert_number(N) |
|
| 61 | -3x | +26x |
checkmate::assert_number(seed, null.ok = TRUE) |
|
| 62 | -3x | +26x |
- checkmate::assert_number(na_percentage, lower = 0, upper = 1)+ checkmate::assert_number(na_percentage, lower = 0, upper = 1, na.ok = TRUE) |
|
| 63 | -3x | +26x |
- checkmate::assert_true(na_percentage < 1)+ checkmate::assert_number(study_duration, lower = 1) |
|
| 64 | -+ | 26x |
-
+ checkmate::assert_number(na_percentage, lower = 0, upper = 1) |
|
| 65 | -+ | 26x |
- # validate and initialize param vectors+ checkmate::assert_true(na_percentage < 1) |
|
| 66 | -3x | +
- param_init_list <- relvar_init(param, paramcd)+ |
||
| 67 | -3x | +26x |
- unit_init_list <- relvar_init(param, paramu)+ if (!is.null(seed)) {
|
|
| 68 | -+ | 26x |
-
+ set.seed(seed) |
|
| 69 | -3x | +
- if (!is.null(seed)) {
+ } |
||
| 70 | -3x | +
- set.seed(seed)+ |
||
| 71 | -+ | 26x |
- }+ study_duration_secs <- lubridate::seconds(lubridate::years(study_duration)) |
|
| 72 | -3x | +26x |
- study_duration_secs <- lubridate::seconds(attr(adsl, "study_duration_secs"))+ sys_dtm <- lubridate::fast_strptime("20/2/2019 11:16:16.683", "%d/%m/%Y %H:%M:%OS")
|
|
| 73 | -+ | 26x |
-
+ discons <- max(1, floor((N * .3))) |
|
| 74 | -3x | +26x |
- advs <- expand.grid(+ country_site_prob <- c(.5, .121, .077, .077, .075, .052, .046, .025, .014, .003) |
|
| 75 | -3x | +
- STUDYID = unique(adsl$STUDYID),+ |
||
| 76 | -3x | +26x |
- USUBJID = adsl$USUBJID,+ adsl <- tibble::tibble( |
|
| 77 | -3x | +26x |
- PARAM = as.factor(param_init_list$relvar1),+ STUDYID = rep("AB12345", N),
|
|
| 78 | -3x | +26x |
- AVISIT = visit_schedule(visit_format = visit_format, n_assessments = n_assessments),+ COUNTRY = sample_fct( |
|
| 79 | -3x | +26x |
- stringsAsFactors = FALSE+ c("CHN", "USA", "BRA", "PAK", "NGA", "RUS", "JPN", "GBR", "CAN", "CHE"),
|
|
| 80 | -+ | 26x |
- )+ N, |
|
| 81 | -+ | 26x |
-
+ prob = country_site_prob |
|
| 82 | -3x | +
- advs <- dplyr::mutate(+ ), |
||
| 83 | -3x | +26x |
- advs,+ SITEID = sample_fct(1:20, N, prob = rep(country_site_prob, times = 2)), |
|
| 84 | -3x | +26x |
- AVISITN = dplyr::case_when(+ SUBJID = paste("id", seq_len(N), sep = "-"),
|
|
| 85 | -3x | +26x |
- AVISIT == "SCREENING" ~ -1,+ AGE = sapply(stats::rchisq(N, df = 5, ncp = 10), max, 0) + 20, |
|
| 86 | -3x | +26x |
- AVISIT == "BASELINE" ~ 0,+ AGEU = "YEARS", |
|
| 87 | -3x | +26x |
- (grepl("^WEEK", AVISIT) | grepl("^CYCLE", AVISIT)) ~ as.numeric(AVISIT) - 2,
+ SEX = c("F", "M") %>% sample_fct(N, prob = c(.52, .48)),
|
|
| 88 | -3x | +26x |
- TRUE ~ NA_real_+ ARMCD = c("ARM A", "ARM B", "ARM C") %>% sample_fct(N),
|
|
| 89 | -+ | 26x |
- )+ RACE = c( |
|
| 90 | -+ | 26x |
- )+ "ASIAN", "BLACK OR AFRICAN AMERICAN", "WHITE", "AMERICAN INDIAN OR ALASKA NATIVE", |
|
| 91 | -+ | 26x |
-
+ "MULTIPLE", "NATIVE HAWAIIAN OR OTHER PACIFIC ISLANDER", "OTHER", "UNKNOWN" |
|
| 92 | -3x | +
- advs$VSCAT <- "VITAL SIGNS"+ ) %>% |
||
| 93 | -+ | 26x |
-
+ sample_fct(N, prob = c(.55, .23, .16, .05, .004, .003, .002, .002)), |
|
| 94 | -+ | 26x |
- # assign related variable values: PARAMxPARAMCD are related+ TRTSDTM = sys_dtm + sample(seq(0, study_duration_secs), size = N, replace = TRUE), |
|
| 95 | -3x | +26x |
- advs <- advs %>% rel_var(+ RANDDT = lubridate::date(TRTSDTM - lubridate::days(floor(stats::runif(N, min = 0, max = 5)))), |
|
| 96 | -3x | +26x |
- var_name = "PARAMCD",+ TRTEDTM = TRTSDTM + study_duration_secs, |
|
| 97 | -3x | +26x |
- related_var = "PARAM",+ STRATA1 = c("A", "B", "C") %>% sample_fct(N),
|
|
| 98 | -3x | +26x |
- var_values = param_init_list$relvar2+ STRATA2 = c("S1", "S2") %>% sample_fct(N),
|
|
| 99 | -+ | 26x |
- )+ BMRKR1 = stats::rchisq(N, 6), |
|
| 100 | -+ | 26x |
-
+ BMRKR2 = sample_fct(c("LOW", "MEDIUM", "HIGH"), N),
|
|
| 101 | -+ | 26x |
- # assign related variable values: PARAMxAVALU are related+ BMEASIFL = sample_fct(c("Y", "N"), N),
|
|
| 102 | -3x | +26x |
- advs <- advs %>% rel_var(+ BEP01FL = sample_fct(c("Y", "N"), N),
|
|
| 103 | -3x | +26x |
- var_name = "AVALU",+ AEWITHFL = sample_fct(c("Y", "N"), N, prob = c(ae_withdrawal_prob, 1 - ae_withdrawal_prob))
|
|
| 104 | -3x | +
- related_var = "PARAM",+ ) %>% |
||
| 105 | -3x | +26x |
- var_values = unit_init_list$relvar2+ dplyr::mutate(ARM = dplyr::recode( |
|
| 106 | -+ | 26x |
- )+ ARMCD, |
|
| 107 | -+ | 26x |
-
+ "ARM A" = "A: Drug X", "ARM B" = "B: Placebo", "ARM C" = "C: Combination" |
|
| 108 | -3x | +
- advs <- advs %>%+ )) %>% |
||
| 109 | -3x | +26x |
- dplyr::mutate(VSTESTCD = PARAMCD) %>%+ dplyr::mutate(ACTARM = ARM) %>% |
|
| 110 | -3x | +26x |
- dplyr::mutate(VSTEST = PARAM)+ dplyr::mutate(ACTARMCD = ARMCD) %>% |
|
| 111 | -+ | 26x |
-
+ dplyr::mutate(TRT01P = ARM) %>% |
|
| 112 | -3x | +26x |
- advs <- advs %>% dplyr::mutate(AVAL = dplyr::case_when(+ dplyr::mutate(TRT01A = ACTARM) %>% |
|
| 113 | -3x | +26x |
- PARAMCD == paramcd[1] ~ stats::rnorm(nrow(advs), mean = 100, sd = 20),+ dplyr::mutate(ITTFL = factor("Y")) %>%
|
|
| 114 | -3x | +26x |
- PARAMCD == paramcd[2] ~ stats::rnorm(nrow(advs), mean = 80, sd = 15),+ dplyr::mutate(SAFFL = factor("Y")) %>%
|
|
| 115 | -3x | +26x |
- PARAMCD == paramcd[3] ~ stats::rnorm(nrow(advs), mean = 16, sd = 5),+ dplyr::arrange(TRTSDTM) |
|
| 116 | -3x | +
- PARAMCD == paramcd[4] ~ stats::rnorm(nrow(advs), mean = 150, sd = 30),+ |
||
| 117 | -3x | +26x |
- PARAMCD == paramcd[5] ~ stats::rnorm(nrow(advs), mean = 36.65, sd = 1),+ adds <- adsl[sample(nrow(adsl), discons), ] %>% |
|
| 118 | -3x | +26x |
- PARAMCD == paramcd[6] ~ stats::rnorm(nrow(advs), mean = 70, sd = 20)+ dplyr::mutate(TRTEDTM_discon = sample( |
|
| 119 | -+ | 26x |
- ))+ seq(from = max(TRTSDTM), to = sys_dtm + study_duration_secs, by = 1), |
|
| 120 | -+ | 26x |
-
+ size = discons, |
|
| 121 | -+ | 26x |
- # order to prepare for change from screening and baseline values+ replace = TRUE |
|
| 122 | -3x | +
- advs <- advs[order(advs$STUDYID, advs$USUBJID, advs$PARAMCD, advs$AVISITN), ]+ )) %>% |
||
| 123 | -+ | 26x |
-
+ dplyr::select(SUBJID, TRTSDTM, TRTEDTM_discon) %>% |
|
| 124 | -3x | +26x |
- advs <- Reduce(rbind, lapply(split(advs, advs$USUBJID), function(x) {
+ dplyr::arrange(TRTSDTM) |
|
| 125 | -30x | +
- x$STUDYID <- adsl$STUDYID[which(adsl$USUBJID == x$USUBJID[1])]+ |
||
| 126 | -30x | +26x |
- x$ABLFL2 <- ifelse(x$AVISIT == "SCREENING", "Y", "")+ adsl <- dplyr::left_join(adsl, adds, by = c("SUBJID", "TRTSDTM")) %>%
|
|
| 127 | -30x | +26x |
- x$ABLFL <- ifelse(+ dplyr::mutate(TRTEDTM = dplyr::case_when( |
|
| 128 | -30x | +26x |
- toupper(visit_format) == "WEEK" & x$AVISIT == "BASELINE",+ !is.na(TRTEDTM_discon) ~ TRTEDTM_discon, |
|
| 129 | -30x | +26x |
- "Y",+ TRTSDTM >= quantile(TRTSDTM)[2] & TRTSDTM <= quantile(TRTSDTM)[3] ~ lubridate::as_datetime(NA), |
|
| 130 | -30x | +26x |
- ifelse(+ TRUE ~ TRTEDTM |
|
| 131 | -30x | +
- toupper(visit_format) == "CYCLE" & x$AVISIT == "CYCLE 1 DAY 1",+ )) %>% |
||
| 132 | -30x | +26x |
- "Y",+ dplyr::select(-"TRTEDTM_discon") |
|
| 133 |
- ""+ |
|||
| 134 |
- )+ # add period 2 if needed |
|||
| 135 | -+ | 26x |
- )+ if (with_trt02) {
|
|
| 136 | -30x | +26x |
- x+ with_trt02 <- lubridate::seconds(lubridate::years(1)) |
|
| 137 | -+ | 26x |
- }))+ adsl <- adsl %>% |
|
| 138 | -+ | 26x |
-
+ dplyr::mutate(TRT02P = sample(ARM)) %>% |
|
| 139 | -3x | +26x |
- advs$BASE2 <- retain(advs, advs$AVAL, advs$ABLFL2 == "Y")+ dplyr::mutate(TRT02A = sample(ACTARM)) %>% |
|
| 140 | -3x | +26x |
- advs$BASE <- ifelse(advs$ABLFL2 != "Y", retain(advs, advs$AVAL, advs$ABLFL == "Y"), NA)+ dplyr::mutate( |
|
| 141 | -+ | 26x |
-
+ TRT01SDTM = TRTSDTM, |
|
| 142 | -3x | +26x |
- advs <- advs %>%+ AP01SDTM = TRT01SDTM, |
|
| 143 | -3x | +26x |
- dplyr::mutate(CHG2 = AVAL - BASE2) %>%+ TRT01EDTM = TRTEDTM, |
|
| 144 | -3x | +26x |
- dplyr::mutate(PCHG2 = 100 * (CHG2 / BASE2)) %>%+ AP01EDTM = TRT01EDTM, |
|
| 145 | -3x | +26x |
- dplyr::mutate(CHG = AVAL - BASE) %>%+ TRT02SDTM = TRTEDTM, |
|
| 146 | -3x | +26x |
- dplyr::mutate(PCHG = 100 * (CHG / BASE)) %>%+ AP02SDTM = TRT02SDTM, |
|
| 147 | -3x | +26x |
- dplyr::mutate(ANRLO = dplyr::case_when(+ TRT02EDTM = TRT01EDTM + with_trt02, |
|
| 148 | -3x | +26x |
- PARAMCD == "DIABP" ~ 80,+ AP02EDTM = TRT02EDTM, |
|
| 149 | -3x | +26x |
- PARAMCD == "PULSE" ~ 60,+ TRTEDTM = TRT02EDTM |
|
| 150 | -3x | +
- PARAMCD == "RESP" ~ 12,+ ) |
||
| 151 | -3x | +
- PARAMCD == "SYSBP" ~ 120,+ } |
||
| 152 | -3x | +
- PARAMCD == "TEMP" ~ 36.1,+ |
||
| 153 | -3x | +26x |
- PARAMCD == "WEIGHT" ~ 40+ adsl <- adsl %>% |
|
| 154 | -+ | 26x |
- )) %>%+ dplyr::mutate(EOSDT = lubridate::date(TRTEDTM)) %>% |
|
| 155 | -3x | +26x |
- dplyr::mutate(ANRHI = dplyr::case_when(+ dplyr::mutate(EOSDY = ceiling(difftime(TRTEDTM, TRTSDTM))) %>% |
|
| 156 | -3x | +26x |
- PARAMCD == "DIABP" ~ 120,+ dplyr::mutate(EOSSTT = dplyr::case_when( |
|
| 157 | -3x | +26x |
- PARAMCD == "PULSE" ~ 100,+ EOSDY == max(EOSDY, na.rm = TRUE) ~ "COMPLETED", |
|
| 158 | -3x | +26x |
- PARAMCD == "RESP" ~ 20,+ EOSDY < max(EOSDY, na.rm = TRUE) ~ "DISCONTINUED", |
|
| 159 | -3x | +26x |
- PARAMCD == "SYSBP" ~ 180,+ is.na(TRTEDTM) ~ "ONGOING" |
|
| 160 | -3x | +
- PARAMCD == "TEMP" ~ 37.2,+ )) %>% |
||
| 161 | -3x | +26x |
- PARAMCD == "WEIGHT" ~ 100+ dplyr::mutate(EOTSTT = EOSSTT) |
|
| 162 |
- )) %>%+ |
|||
| 163 | -3x | +
- dplyr::mutate(ANRIND = factor(dplyr::case_when(+ # disposition related variables |
||
| 164 | -3x | +
- AVAL < ANRLO ~ "LOW",+ # using probability of 1 for the "DEATH" level to ensure at least one death record exists |
||
| 165 | -3x | +26x |
- AVAL > ANRHI ~ "HIGH",+ l_dcsreas <- list( |
|
| 166 | -3x | +26x |
- TRUE ~ "NORMAL"+ choices = c( |
|
| 167 | -+ | 26x |
- ))) %>%+ "ADVERSE EVENT", "DEATH", "LACK OF EFFICACY", "PHYSICIAN DECISION", |
|
| 168 | -3x | +26x |
- dplyr::mutate(VSSTRESC = dplyr::case_when(+ "PROTOCOL VIOLATION", "WITHDRAWAL BY PARENT/GUARDIAN", "WITHDRAWAL BY SUBJECT" |
|
| 169 | -3x | +
- PARAMCD == "DIABP" ~ "<80",+ ), |
||
| 170 | -3x | +26x |
- PARAMCD == "PULSE" ~ "<60",+ prob = c(.2, 1, .1, .1, .2, .1, .1) |
|
| 171 | -3x | +
- PARAMCD == "RESP" ~ ">20",+ ) |
||
| 172 | -3x | +26x |
- PARAMCD == "SYSBP" ~ ">180",+ l_dthcat_other <- list( |
|
| 173 | -3x | +26x |
- PARAMCD == "TEMP" ~ "<36.1",+ choices = c( |
|
| 174 | -3x | +26x |
- PARAMCD == "WEIGHT" ~ "<40"+ "Post-study reporting of death", "LOST TO FOLLOW UP", "MISSING", "SUICIDE", "UNKNOWN" |
|
| 175 |
- )) %>%+ ), |
|||
| 176 | -3x | +26x |
- dplyr::rowwise() %>%+ prob = c(.1, .3, .3, .2, .1) |
|
| 177 | -3x | +
- dplyr::mutate(LOQFL = factor(+ ) |
||
| 178 | -3x | +
- ifelse(eval(parse(text = paste(AVAL, VSSTRESC))), "Y", "N")+ |
||
| 179 | -+ | 26x |
- )) %>%+ adsl <- adsl %>% |
|
| 180 | -3x | +26x |
- dplyr::ungroup() %>%+ dplyr::mutate( |
|
| 181 | -3x | +26x |
- dplyr::mutate(BASETYPE = "LAST") %>%+ DCSREAS = ifelse( |
|
| 182 | -3x | +26x |
- dplyr::group_by(USUBJID, PARAMCD, BASETYPE) %>%+ EOSSTT == "DISCONTINUED", |
|
| 183 | -3x | +26x |
- dplyr::mutate(BNRIND = ANRIND[ABLFL == "Y"]) %>%+ sample(x = l_dcsreas$choices, size = N, replace = TRUE, prob = l_dcsreas$prob), |
|
| 184 | -3x | +26x |
- dplyr::ungroup() %>%+ as.character(NA) |
|
| 185 | -3x | +
- dplyr::mutate(ATPTN = 1) %>%+ ) |
||
| 186 | -3x | +
- dplyr::mutate(DTYPE = NA) %>%+ ) %>% |
||
| 187 | -3x | +26x |
- var_relabel(+ dplyr::mutate(DTHFL = dplyr::case_when( |
|
| 188 | -3x | +26x |
- USUBJID = attr(adsl$USUBJID, "label"),+ DCSREAS == "DEATH" ~ "Y", |
|
| 189 | -3x | +26x |
- STUDYID = attr(adsl$STUDYID, "label")+ TRUE ~ "N" |
|
| 190 |
- )+ )) %>% |
|||
| 191 | -+ | 26x |
-
+ dplyr::mutate( |
|
| 192 | -3x | +26x |
- advs <- var_relabel(+ DTHCAT = ifelse( |
|
| 193 | -3x | +26x |
- advs,+ DCSREAS == "DEATH", |
|
| 194 | -3x | +26x |
- STUDYID = "Study Identifier",+ sample(x = c("ADVERSE EVENT", "PROGRESSIVE DISEASE", "OTHER"), size = N, replace = TRUE),
|
|
| 195 | -3x | +26x |
- USUBJID = "Unique Subject Identifier"+ as.character(NA) |
|
| 196 |
- )+ ) |
|||
| 197 |
-
+ ) %>% |
|||
| 198 | -+ | 26x |
- # merge ADSL to be able to add LB date and study day variables+ dplyr::mutate(DTHCAUS = dplyr::case_when( |
|
| 199 | -3x | +26x |
- advs <- dplyr::inner_join(+ DTHCAT == "ADVERSE EVENT" ~ "ADVERSE EVENT", |
|
| 200 | -3x | +26x |
- advs,+ DTHCAT == "PROGRESSIVE DISEASE" ~ "DISEASE PROGRESSION", |
|
| 201 | -3x | +26x |
- adsl,+ DTHCAT == "OTHER" ~ sample(x = l_dthcat_other$choices, size = N, replace = TRUE, prob = l_dthcat_other$prob), |
|
| 202 | -3x | +26x |
- by = c("STUDYID", "USUBJID")
+ TRUE ~ as.character(NA) |
|
| 203 |
- ) %>%+ )) %>% |
|||
| 204 | -3x | +26x |
- dplyr::rowwise() %>%+ dplyr::mutate(ADTHAUT = dplyr::case_when( |
|
| 205 | -3x | +26x |
- dplyr::mutate(TRTENDT = lubridate::date(dplyr::case_when(+ DTHCAUS %in% c("ADVERSE EVENT", "DISEASE PROGRESSION") ~ "Yes",
|
|
| 206 | -3x | +26x |
- is.na(TRTEDTM) ~ lubridate::floor_date(lubridate::date(TRTSDTM) + study_duration_secs, unit = "day"),+ DTHCAUS %in% c("UNKNOWN", "SUICIDE", "Post-study reporting of death") ~ sample(
|
|
| 207 | -3x | +26x |
- TRUE ~ TRTEDTM+ x = c("Yes", "No"), size = N, replace = TRUE, prob = c(0.25, 0.75)
|
|
| 208 |
- ))) %>%+ ), |
|||
| 209 | -3x | +26x |
- dplyr::ungroup()+ TRUE ~ as.character(NA) |
|
| 210 |
-
+ )) %>% |
|||
| 211 | -3x | +
- advs <- advs %>%+ # adding some random number of days post last treatment date so that death days from last trt admin |
||
| 212 | -3x | +
- dplyr::group_by(USUBJID) %>%+ # supports the LDDTHGR1 derivation below |
||
| 213 | -3x | +26x |
- dplyr::arrange(USUBJID, AVISITN) %>%+ dplyr::mutate(DTHDT = dplyr::case_when( |
|
| 214 | -3x | +26x |
- dplyr::mutate(ADTM = rep(+ DCSREAS == "DEATH" ~ lubridate::date(TRTEDTM + lubridate::days(sample(0:50, size = N, replace = TRUE))), |
|
| 215 | -3x | +26x |
- sort(sample(+ TRUE ~ NA |
|
| 216 | -3x | +
- seq(lubridate::as_datetime(TRTSDTM[1]), lubridate::as_datetime(TRTENDT[1]), by = "day"),+ )) %>% |
||
| 217 | -3x | +26x |
- size = nlevels(AVISIT)+ dplyr::mutate(LDDTHELD = difftime(DTHDT, lubridate::date(TRTEDTM), units = "days")) %>% |
|
| 218 | -+ | 26x |
- )),+ dplyr::mutate(LDDTHGR1 = dplyr::case_when( |
|
| 219 | -3x | +26x |
- each = n() / nlevels(AVISIT)+ LDDTHELD <= 30 ~ "<=30", |
|
| 220 | -+ | 26x |
- )) %>%+ LDDTHELD > 30 ~ ">30", |
|
| 221 | -3x | +26x |
- dplyr::ungroup() %>%+ TRUE ~ as.character(NA) |
|
| 222 | -3x | +
- dplyr::mutate(ADY = ceiling(difftime(ADTM, TRTSDTM, units = "days"))) %>%+ )) %>% |
||
| 223 | -3x | +26x |
- dplyr::select(-TRTENDT) %>%+ dplyr::mutate(LSTALVDT = dplyr::case_when( |
|
| 224 | -3x | +26x |
- dplyr::arrange(STUDYID, USUBJID, ADTM)+ DCSREAS == "DEATH" ~ DTHDT, |
|
| 225 | -+ | 26x |
-
+ TRUE ~ lubridate::date(TRTEDTM) + lubridate::days(floor(stats::runif(N, min = 10, max = 30))) |
|
| 226 | -3x | +
- advs <- advs %>% dplyr::mutate(ONTRTFL = factor(dplyr::case_when(+ )) |
||
| 227 | -3x | +
- !AVISIT %in% c("SCREENING", "BASELINE") ~ "Y",
+
|
||
| 228 | -3x | +
- TRUE ~ ""+ # add random ETHNIC (Ethnicity) |
||
| 229 | -+ | 26x |
- )))+ adsl <- adsl %>% |
|
| 230 | -+ | 26x |
-
+ dplyr::mutate(ETHNIC = sample( |
|
| 231 | -3x | +26x |
- advs <- advs %>%+ x = c("HISPANIC OR LATINO", "NOT HISPANIC OR LATINO", "NOT REPORTED", "UNKNOWN"),
|
|
| 232 | -3x | +26x |
- dplyr::mutate(ASPID = sample(seq_len(dplyr::n()))) %>%+ size = N, replace = TRUE, prob = c(.1, .8, .06, .04) |
|
| 233 | -3x | +
- dplyr::group_by(USUBJID) %>%+ )) |
||
| 234 | -3x | +
- dplyr::mutate(VSSEQ = seq_len(dplyr::n())) %>%+ |
||
| 235 | -3x | +
- dplyr::mutate(ASEQ = VSSEQ) %>%+ # associate DTHADY (Relative Day of Death) with Death date |
||
| 236 | -3x | +
- dplyr::ungroup() %>%+ # Date of Death [adsl.DTHDT] - date part of Date of First Exposure to Treatment [adsl.TRTSDTM] |
||
| 237 | -3x | +
- dplyr::arrange(+ |
||
| 238 | -3x | +26x |
- STUDYID,+ adsl <- adsl %>% |
|
| 239 | -3x | +26x |
- USUBJID,+ dplyr::mutate(DTHADY = difftime(DTHDT, TRTSDTM, units = "days")) |
|
| 240 | -3x | +
- PARAMCD,+ |
||
| 241 | -3x | +
- BASETYPE,+ |
||
| 242 | -3x | +
- AVISITN,+ # associate sites with countries and regions |
||
| 243 | -3x | +26x |
- ATPTN,+ adsl <- adsl %>% |
|
| 244 | -3x | +26x |
- DTYPE,+ dplyr::mutate(SITEID = paste0(COUNTRY, "-", SITEID)) %>% |
|
| 245 | -3x | +26x |
- ADTM,+ dplyr::mutate(REGION1 = dplyr::case_when( |
|
| 246 | -3x | +26x |
- VSSEQ,+ COUNTRY %in% c("NGA") ~ "Africa",
|
|
| 247 | -3x | +26x |
- ASPID+ COUNTRY %in% c("CHN", "JPN", "PAK") ~ "Asia",
|
|
| 248 | +26x | +
+ COUNTRY %in% c("RUS") ~ "Eurasia",
+ |
+ ||
| 249 | +26x | +
+ COUNTRY %in% c("GBR") ~ "Europe",
+ |
+ ||
| 250 | +26x | +
+ COUNTRY %in% c("CAN", "USA") ~ "North America",
+ |
+ ||
| 251 | +26x | +
+ COUNTRY %in% c("BRA") ~ "South America",
+ |
+ ||
| 252 | +26x | +
+ TRUE ~ as.character(NA)+ |
+ ||
| 253 |
- )+ )) %>%+ |
+ |||
| 254 | +26x | +
+ dplyr::mutate(INVID = paste("INV ID", SITEID)) %>%
+ |
+ ||
| 255 | +26x | +
+ dplyr::mutate(INVNAM = paste("Dr.", SITEID, "Doe")) %>%
+ |
+ ||
| 256 | +26x | +
+ dplyr::mutate(USUBJID = paste(STUDYID, SITEID, SUBJID, sep = "-")) |
||
| 249 | +257 | ++ | + + | +|
| 258 | ||||
| 250 | -3x | +259 | +26x |
if (length(na_vars) > 0 && na_percentage > 0) {
|
| 251 | +260 | ! |
- advs <- mutate_na(ds = advs, na_vars = na_vars, na_percentage = na_percentage)+ adsl <- mutate_na(ds = adsl, na_vars = na_vars, na_percentage = na_percentage) |
|
| 252 | +261 |
} |
||
| 253 | +262 | |||
| 254 | +263 |
# apply metadata |
||
| 255 | -3x | +264 | +26x |
- advs <- apply_metadata(advs, "metadata/ADVS.yml")+ adsl <- apply_metadata(adsl, "metadata/ADSL.yml", FALSE) |
| 256 | +265 | |||
| 257 | -3x | +266 | +26x |
- return(advs)+ attr(adsl, "study_duration_secs") <- as.numeric(study_duration_secs)+ |
+
| 267 | +26x | +
+ return(adsl) |
||
| 258 | +268 |
}@@ -29647,14 +29758,14 @@ random.cdisc.data coverage - 98.86% |
| 1 |
- #' Hy's Law Analysis Dataset (ADHY)+ #' Vital Signs Analysis Dataset (ADVS) |
||
| 5 |
- #' Function for generating a random Hy's Law Analysis Dataset for a given+ #' Function for generating a random Vital Signs Analysis Dataset for a given |
||
| 10 |
- #' Keys: `STUDYID`, `USUBJID`, `PARAMCD`, `AVISITN`, `ADTM`, `SRCSEQ`+ #' Keys: `STUDYID`, `USUBJID`, `PARAMCD`, `BASETYPE`, `AVISITN`, `ATPTN`, `DTYPE`, `ADTM`, `VSSEQ`, `ASPID` |
||
| 11 |
- #+ #' |
||
| 14 |
- #' @templateVar data adhy+ #' @templateVar data advs |
||
| 19 |
- #' @author wojciakw+ #' @author npaszty |
||
| 24 |
- #' adhy <- radhy(adsl, seed = 2)+ #' advs <- radvs(adsl, visit_format = "WEEK", n_assessments = 7L, seed = 2) |
||
| 25 |
- #' adhy+ #' advs |
||
| 26 |
- radhy <- function(adsl,+ #' |
||
| 27 |
- param = c(+ #' advs <- radvs(adsl, visit_format = "CYCLE", n_assessments = 3L, seed = 2) |
||
| 28 |
- "TBILI <= 2 times ULN and ALT value category",+ #' advs |
||
| 29 |
- "TBILI > 2 times ULN and AST value category",+ radvs <- function(adsl, |
||
| 30 |
- "TBILI > 2 times ULN and ALT value category",+ param = c( |
||
| 31 |
- "TBILI <= 2 times ULN and AST value category",+ "Diastolic Blood Pressure", |
||
| 32 |
- "TBILI > 2 times ULN and ALKPH <= 2 times ULN and ALT value category",+ "Pulse Rate", |
||
| 33 |
- "TBILI > 2 times ULN and ALKPH <= 2 times ULN and AST value category",+ "Respiratory Rate", |
||
| 34 |
- "TBILI > 2 times ULN and ALKPH <= 5 times ULN and ALT value category",+ "Systolic Blood Pressure", |
||
| 35 |
- "TBILI > 2 times ULN and ALKPH <= 5 times ULN and AST value category",+ "Temperature", "Weight" |
||
| 36 |
- "TBILI <= 2 times ULN and two consecutive elevations of ALT in relation to ULN",+ ), |
||
| 37 |
- "TBILI > 2 times ULN and two consecutive elevations of AST in relation to ULN",+ paramcd = c("DIABP", "PULSE", "RESP", "SYSBP", "TEMP", "WEIGHT"),
|
||
| 38 |
- "TBILI <= 2 times ULN and two consecutive elevations of AST in relation to ULN",+ paramu = c("Pa", "beats/min", "breaths/min", "Pa", "C", "Kg"),
|
||
| 39 |
- "TBILI > 2 times ULN and two consecutive elevations of ALT in relation to ULN",+ visit_format = "WEEK", |
||
| 40 |
- "TBILI > 2 times ULN and two consecutive elevations of ALT in relation to Baseline",+ n_assessments = 5L, |
||
| 41 |
- "TBILI <= 2 times ULN and two consecutive elevations of ALT in relation to Baseline",+ n_days = 5L, |
||
| 42 |
- "TBILI > 2 times ULN and two consecutive elevations of AST in relation to Baseline",+ seed = NULL, |
||
| 43 |
- "TBILI <= 2 times ULN and two consecutive elevations of AST in relation to Baseline",+ na_percentage = 0, |
||
| 44 |
- "ALT > 3 times ULN by Period",+ na_vars = list( |
||
| 45 |
- "AST > 3 times ULN by Period",+ CHG2 = c(1235, 0.1), PCHG2 = c(1235, 0.1), CHG = c(1234, 0.1), PCHG = c(1234, 0.1), |
||
| 46 |
- "ALT or AST > 3 times ULN by Period",+ AVAL = c(123, 0.1), AVALU = c(123, 0.1) |
||
| 47 |
- "ALT > 3 times Baseline by Period",+ ), |
||
| 48 |
- "AST > 3 times Baseline by Period",+ cached = FALSE) {
|
||
| 49 | -+ | 4x |
- "ALT or AST > 3 times Baseline by Period"+ checkmate::assert_flag(cached) |
| 50 | -+ | 4x |
- ),+ if (cached) {
|
| 51 | -+ | 1x |
- paramcd = c(+ return(get_cached_data("cadvs"))
|
| 52 |
- "BLAL",+ } |
||
| 53 |
- "BGAS",+ |
||
| 54 | -+ | 3x |
- "BGAL",+ checkmate::assert_data_frame(adsl) |
| 55 | -+ | 3x |
- "BLAS",+ checkmate::assert_character(param, min.len = 1, any.missing = FALSE) |
| 56 | -+ | 3x |
- "BA2AL",+ checkmate::assert_character(paramcd, min.len = 1, any.missing = FALSE) |
| 57 | -+ | 3x |
- "BA2AS",+ checkmate::assert_character(paramu, min.len = 1, any.missing = FALSE) |
| 58 | -+ | 3x |
- "BA5AL",+ checkmate::assert_string(visit_format) |
| 59 | -+ | 3x |
- "BA5AS",+ checkmate::assert_integer(n_assessments, len = 1, any.missing = FALSE) |
| 60 | -+ | 3x |
- "BL2AL2CU",+ checkmate::assert_integer(n_days, len = 1, any.missing = FALSE) |
| 61 | -+ | 3x |
- "BG2AS2CU",+ checkmate::assert_number(seed, null.ok = TRUE) |
| 62 | -+ | 3x |
- "BL2AS2CU",+ checkmate::assert_number(na_percentage, lower = 0, upper = 1) |
| 63 | -+ | 3x |
- "BG2AL2CU",+ checkmate::assert_true(na_percentage < 1) |
| 64 |
- "BG2AL2CB",+ |
||
| 65 |
- "BL2AL2CB",+ # validate and initialize param vectors |
||
| 66 | -+ | 3x |
- "BG2AS2CB",+ param_init_list <- relvar_init(param, paramcd) |
| 67 | -+ | 3x |
- "BL2AS2CB",+ unit_init_list <- relvar_init(param, paramu) |
| 68 |
- "ALTPULN",+ |
||
| 69 | -+ | 3x |
- "ASTPULN",+ if (!is.null(seed)) {
|
| 70 | -+ | 3x |
- "ALTASTPU",+ set.seed(seed) |
| 71 |
- "ALTPBASE",+ } |
||
| 72 | -+ | 3x |
- "ASTPBASE",+ study_duration_secs <- lubridate::seconds(attr(adsl, "study_duration_secs")) |
| 73 |
- "ALTASTPB"+ |
||
| 74 | -+ | 3x |
- ),+ advs <- expand.grid( |
| 75 | -+ | 3x |
- seed = NULL,+ STUDYID = unique(adsl$STUDYID), |
| 76 | -+ | 3x |
- cached = FALSE) {
+ USUBJID = adsl$USUBJID, |
| 77 | -4x | +3x |
- checkmate::assert_flag(cached)+ PARAM = as.factor(param_init_list$relvar1), |
| 78 | -+ | 3x |
-
+ AVISIT = visit_schedule(visit_format = visit_format, n_assessments = n_assessments), |
| 79 | -4x | +3x |
- if (cached) {
+ stringsAsFactors = FALSE |
| 80 | -1x | +
- return(get_cached_data("cadhy"))
+ ) |
|
| 81 |
- }+ |
||
| 82 | -+ | 3x |
-
+ advs <- dplyr::mutate( |
| 83 | 3x |
- checkmate::assert_data_frame(adsl)+ advs, |
|
| 84 | 3x |
- checkmate::assert_character(param, min.len = 1, any.missing = FALSE)+ AVISITN = dplyr::case_when( |
|
| 85 | 3x |
- checkmate::assert_character(paramcd, min.len = 1, any.missing = FALSE)+ AVISIT == "SCREENING" ~ -1, |
|
| 86 | 3x |
- checkmate::assert_number(seed, null.ok = TRUE)+ AVISIT == "BASELINE" ~ 0, |
|
| 87 | -+ | 3x |
-
+ (grepl("^WEEK", AVISIT) | grepl("^CYCLE", AVISIT)) ~ as.numeric(AVISIT) - 2,
|
| 88 | -+ | 3x |
- # validate and initialize related variables+ TRUE ~ NA_real_ |
| 89 | -3x | +
- param_init_list <- relvar_init(param, paramcd)+ ) |
|
| 90 |
-
+ ) |
||
| 91 | -3x | +
- if (!is.null(seed)) {
+
|
|
| 92 | 3x |
- set.seed(seed)+ advs$VSCAT <- "VITAL SIGNS" |
|
| 93 |
- }+ |
||
| 94 | -3x | +
- study_duration_secs <- lubridate::seconds(attr(adsl, "study_duration_secs"))+ # assign related variable values: PARAMxPARAMCD are related |
|
| 95 | -+ | 3x |
-
+ advs <- advs %>% rel_var( |
| 96 | -+ | 3x |
- # create all combinations of unique values in STUDYID, USUBJID, PARAM, AVISIT+ var_name = "PARAMCD", |
| 97 | 3x |
- adhy <- expand.grid(+ related_var = "PARAM", |
|
| 98 | 3x |
- STUDYID = unique(adsl$STUDYID),+ var_values = param_init_list$relvar2 |
|
| 99 | -3x | +
- USUBJID = adsl$USUBJID,+ ) |
|
| 100 | -3x | +
- PARAM = as.factor(param_init_list$relvar1),+ |
|
| 101 | -3x | +
- AVISIT = as.factor(c("BASELINE", "POST-BASELINE")),
+ # assign related variable values: PARAMxAVALU are related |
|
| 102 | 3x |
- APERIODC = as.factor(c("PERIOD 1", "PERIOD 2")),
+ advs <- advs %>% rel_var( |
|
| 103 | 3x |
- stringsAsFactors = FALSE+ var_name = "AVALU", |
|
| 104 | -+ | 3x |
- )+ related_var = "PARAM", |
| 105 | -+ | 3x |
-
+ var_values = unit_init_list$relvar2 |
| 106 |
- # 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 | -+ | 3x |
-
+ advs <- advs %>% |
| 109 | -+ | 3x |
- # define TBILI ALT/AST params, period dependent parameters and the parameters that will be assigned values "Y" or "N"+ dplyr::mutate(VSTESTCD = PARAMCD) %>% |
| 110 | 3x |
- paramcd_tbilialtast <- c("BLAL", "BGAS", "BGAL", "BLAS", "BA2AL", "BA2AS", "BA5AL", "BA5AS")
+ dplyr::mutate(VSTEST = PARAM) |
|
| 111 | -3x | +
- paramcd_by_period <- c("ALTPULN", "ASTPULN", "ALTASTPU", "ALTPBASE", "ASTPBASE", "ALTASTPB")
+
|
|
| 112 | 3x |
- paramcd_yn <- c(+ advs <- advs %>% dplyr::mutate(AVAL = dplyr::case_when( |
|
| 113 | 3x |
- "BL2AL2CU", "BG2AS2CU", "BL2AS2CU", "BG2AL2CU", "BG2AL2CB", "BL2AL2CB", "BG2AS2CB", "BL2AS2CB",+ PARAMCD == paramcd[1] ~ stats::rnorm(nrow(advs), mean = 100, sd = 20), |
|
| 114 | 3x |
- paramcd_by_period+ PARAMCD == paramcd[2] ~ stats::rnorm(nrow(advs), mean = 80, sd = 15), |
|
| 115 | -+ | 3x |
- )+ PARAMCD == paramcd[3] ~ stats::rnorm(nrow(advs), mean = 16, sd = 5), |
| 116 | -+ | 3x |
-
+ PARAMCD == paramcd[4] ~ stats::rnorm(nrow(advs), mean = 150, sd = 30), |
| 117 | -+ | 3x |
- # add other variables to adhy+ PARAMCD == paramcd[5] ~ stats::rnorm(nrow(advs), mean = 36.65, sd = 1), |
| 118 | 3x |
- adhy <- adhy %>%+ PARAMCD == paramcd[6] ~ stats::rnorm(nrow(advs), mean = 70, sd = 20) |
|
| 119 | -3x | +
- rel_var(+ )) |
|
| 120 | -3x | +
- var_name = "PARAMCD",+ |
|
| 121 | -3x | +
- related_var = "PARAM",+ # order to prepare for change from screening and baseline values |
|
| 122 | 3x |
- var_values = param_init_list$relvar2+ advs <- advs[order(advs$STUDYID, advs$USUBJID, advs$PARAMCD, advs$AVISITN), ] |
|
| 123 |
- ) %>%+ |
||
| 124 | 3x |
- dplyr::mutate(+ advs <- Reduce(rbind, lapply(split(advs, advs$USUBJID), function(x) {
|
|
| 125 | -3x | +30x |
- AVALC = dplyr::case_when(+ x$STUDYID <- adsl$STUDYID[which(adsl$USUBJID == x$USUBJID[1])] |
| 126 | -3x | +30x |
- PARAMCD %in% paramcd_tbilialtast ~ sample(+ x$ABLFL2 <- ifelse(x$AVISIT == "SCREENING", "Y", "") |
| 127 | -3x | +30x |
- x = c(">3-5ULN", ">5-10ULN", ">10-20ULN", ">20ULN", "Criteria not met"), size = dplyr::n(), replace = TRUE
+ x$ABLFL <- ifelse( |
| 128 | -+ | 30x |
- ),+ toupper(visit_format) == "WEEK" & x$AVISIT == "BASELINE", |
| 129 | -3x | +30x |
- PARAMCD %in% paramcd_yn ~ sample(+ "Y", |
| 130 | -3x | +30x |
- x = c("Y", "N"), prob = c(0.1, 0.9), size = dplyr::n(), replace = TRUE
+ ifelse( |
| 131 | -+ | 30x |
- )+ toupper(visit_format) == "CYCLE" & x$AVISIT == "CYCLE 1 DAY 1", |
| 132 | -+ | 30x |
- ),+ "Y", |
| 133 | -3x | +
- AVAL = dplyr::case_when(+ "" |
|
| 134 | -3x | +
- AVALC == ">3-5ULN" ~ 1,+ ) |
|
| 135 | -3x | +
- AVALC == ">5-10ULN" ~ 2,+ ) |
|
| 136 | -3x | +30x |
- AVALC == ">10-20ULN" ~ 3,+ x |
| 137 | -3x | +
- AVALC == ">20ULN" ~ 4,+ })) |
|
| 138 | -3x | +
- AVALC == "Y" ~ 1,+ |
|
| 139 | 3x |
- AVALC == "N" ~ 0,+ advs$BASE2 <- retain(advs, advs$AVAL, advs$ABLFL2 == "Y") |
|
| 140 | 3x |
- AVALC == "Criteria not met" ~ 0+ advs$BASE <- ifelse(advs$ABLFL2 != "Y", retain(advs, advs$AVAL, advs$ABLFL == "Y"), NA) |
|
| 141 |
- ),+ |
||
| 142 | 3x |
- AVISITN = dplyr::case_when(+ advs <- advs %>% |
|
| 143 | 3x |
- AVISIT == "BASELINE" ~ 0L,+ dplyr::mutate(CHG2 = AVAL - BASE2) %>% |
|
| 144 | 3x |
- AVISIT == "POST-BASELINE" ~ 9995L,+ dplyr::mutate(PCHG2 = 100 * (CHG2 / BASE2)) %>% |
|
| 145 | 3x |
- TRUE ~ NA_integer_+ dplyr::mutate(CHG = AVAL - BASE) %>% |
|
| 146 | -+ | 3x |
- ),+ dplyr::mutate(PCHG = 100 * (CHG / BASE)) %>% |
| 147 | 3x |
- APERIOD = dplyr::case_when(+ dplyr::mutate(ANRLO = dplyr::case_when( |
|
| 148 | 3x |
- APERIODC == "PERIOD 1" ~ 1L,+ PARAMCD == "DIABP" ~ 80, |
|
| 149 | 3x |
- APERIODC == "PERIOD 2" ~ 2L,+ PARAMCD == "PULSE" ~ 60, |
|
| 150 | 3x |
- TRUE ~ NA_integer_+ PARAMCD == "RESP" ~ 12, |
|
| 151 | -+ | 3x |
- ),+ PARAMCD == "SYSBP" ~ 120, |
| 152 | 3x |
- ABLFL = dplyr::if_else(AVISIT == "BASELINE", "Y", NA_character_),+ PARAMCD == "TEMP" ~ 36.1, |
|
| 153 | 3x |
- ONTRTFL = dplyr::if_else(AVISIT == "POST-BASELINE", "Y", NA_character_),+ PARAMCD == "WEIGHT" ~ 40 |
|
| 154 | -3x | +
- ANL01FL = "Y",+ )) %>% |
|
| 155 | 3x |
- SRCSEQ = NA_integer_+ dplyr::mutate(ANRHI = dplyr::case_when( |
|
| 156 | -+ | 3x |
- )+ PARAMCD == "DIABP" ~ 120, |
| 157 | -+ | 3x |
-
+ PARAMCD == "PULSE" ~ 100, |
| 158 | -+ | 3x |
- # remove records for parameters with period 2 and not in paramcd_by_period+ PARAMCD == "RESP" ~ 20, |
| 159 | 3x |
- adhy <- dplyr::filter(adhy, PARAMCD %in% paramcd_by_period | APERIODC == "PERIOD 1")+ PARAMCD == "SYSBP" ~ 180, |
|
| 160 | -+ | 3x |
-
+ PARAMCD == "TEMP" ~ 37.2, |
| 161 | -+ | 3x |
- # add baseline variables+ PARAMCD == "WEIGHT" ~ 100 |
| 162 | -3x | +
- adhy <- adhy %>%+ )) %>% |
|
| 163 | 3x |
- dplyr::group_by(USUBJID, PARAMCD) %>%+ dplyr::mutate(ANRIND = factor(dplyr::case_when( |
|
| 164 | 3x |
- dplyr::mutate(+ AVAL < ANRLO ~ "LOW", |
|
| 165 | 3x |
- BASEC = AVALC[AVISIT == "BASELINE"],+ AVAL > ANRHI ~ "HIGH", |
|
| 166 | 3x |
- BASE = AVAL[AVISIT == "BASELINE"]+ TRUE ~ "NORMAL" |
|
| 167 |
- ) %>%+ ))) %>% |
||
| 168 | 3x |
- dplyr::ungroup()+ dplyr::mutate(VSSTRESC = dplyr::case_when( |
|
| 169 | -+ | 3x |
-
+ PARAMCD == "DIABP" ~ "<80", |
| 170 | 3x |
- adhy <- adhy %>%+ PARAMCD == "PULSE" ~ "<60", |
|
| 171 | 3x |
- var_relabel(+ PARAMCD == "RESP" ~ ">20", |
|
| 172 | 3x |
- STUDYID = attr(adsl$STUDYID, "label"),+ PARAMCD == "SYSBP" ~ ">180", |
|
| 173 | 3x |
- USUBJID = attr(adsl$USUBJID, "label")+ PARAMCD == "TEMP" ~ "<36.1", |
|
| 174 | -+ | 3x |
- )+ PARAMCD == "WEIGHT" ~ "<40" |
| 175 |
-
+ )) %>% |
||
| 176 | -+ | 3x |
- # merge ADSL to be able to add analysis datetime and analysis relative day variables+ dplyr::rowwise() %>% |
| 177 | 3x |
- adhy <- dplyr::inner_join(adhy, adsl, by = c("STUDYID", "USUBJID"))
+ dplyr::mutate(LOQFL = factor( |
|
| 178 | -+ | 3x |
-
+ ifelse(eval(parse(text = paste(AVAL, VSSTRESC))), "Y", "N") |
| 179 |
- # define a simple helper function to create ADY variable+ )) %>% |
||
| 180 | 3x |
- add_ady <- function(x, avisit) {
+ dplyr::ungroup() %>% |
|
| 181 | -6x | +3x |
- if (avisit == "BASELINE") {
+ dplyr::mutate(BASETYPE = "LAST") %>% |
| 182 | 3x |
- dplyr::mutate(+ dplyr::group_by(USUBJID, PARAMCD, BASETYPE) %>% |
|
| 183 | 3x |
- x,+ dplyr::mutate(BNRIND = ANRIND[ABLFL == "Y"]) %>% |
|
| 184 | 3x |
- ADY = sample(x = -(1:14), size = dplyr::n(), replace = TRUE)+ dplyr::ungroup() %>% |
|
| 185 | -+ | 3x |
- )+ dplyr::mutate(ATPTN = 1) %>% |
| 186 | 3x |
- } else if (avisit == "POST-BASELINE") {
+ dplyr::mutate(DTYPE = NA) %>% |
|
| 187 | 3x |
- dplyr::rowwise(x) %>%+ rcd_var_relabel( |
|
| 188 | 3x |
- dplyr::mutate(ADY = as.integer(sample(+ USUBJID = attr(adsl$USUBJID, "label"), |
|
| 189 | 3x |
- dplyr::if_else(+ STUDYID = attr(adsl$STUDYID, "label") |
|
| 190 | -3x | +
- !is.na(TRTEDTM),+ ) |
|
| 191 | -3x | +
- as.numeric(difftime(TRTEDTM, TRTSDTM, units = "days")),+ |
|
| 192 | 3x |
- as.numeric(study_duration_secs, "days")+ advs <- rcd_var_relabel( |
|
| 193 | -+ | 3x |
- ),+ advs, |
| 194 | 3x |
- size = 1,+ STUDYID = "Study Identifier", |
|
| 195 | 3x |
- replace = TRUE+ USUBJID = "Unique Subject Identifier" |
|
| 196 |
- )))+ ) |
||
| 197 |
- } else {
+
|
||
| 198 | -! | +
- dplyr::mutate(x, ADY = NA_integer_)+ # merge ADSL to be able to add LB date and study day variables |
|
| 199 | -+ | 3x |
- }+ advs <- dplyr::inner_join( |
| 200 | -+ | 3x |
- }+ advs, |
| 201 | -+ | 3x |
-
+ adsl, |
| 202 | -+ | 3x |
- # add ADY and ADTM variables+ by = c("STUDYID", "USUBJID")
|
| 203 | -3x | +
- adhy <- adhy %>%+ ) %>% |
|
| 204 | 3x |
- dplyr::group_by(AVISIT, .add = FALSE) %>%+ dplyr::rowwise() %>% |
|
| 205 | 3x |
- dplyr::group_modify(~ add_ady(.x, .y$AVISIT)) %>%+ dplyr::mutate(TRTENDT = lubridate::date(dplyr::case_when( |
|
| 206 | 3x |
- dplyr::ungroup() %>%+ is.na(TRTEDTM) ~ lubridate::floor_date(lubridate::date(TRTSDTM) + study_duration_secs, unit = "day"), |
|
| 207 | 3x |
- dplyr::mutate(ADTM = TRTSDTM + lubridate::days(ADY))+ TRUE ~ TRTEDTM |
|
| 208 |
-
+ ))) %>% |
||
| 209 | -+ | 3x |
- # order columns and arrange rows; column order follows ADaM_1.1 specification+ dplyr::ungroup() |
| 210 | -3x | +
- adhy <-+ |
|
| 211 | 3x |
- adhy[, c(+ advs <- advs %>% |
|
| 212 | 3x |
- colnames(adsl),+ dplyr::group_by(USUBJID) %>% |
|
| 213 | 3x |
- "PARAM",+ dplyr::arrange(USUBJID, AVISITN) %>% |
|
| 214 | 3x |
- "PARAMCD",+ dplyr::mutate(ADTM = rep( |
|
| 215 | 3x |
- "AVAL",+ sort(sample( |
|
| 216 | 3x |
- "AVALC",+ seq(lubridate::as_datetime(TRTSDTM[1]), lubridate::as_datetime(TRTENDT[1]), by = "day"), |
|
| 217 | 3x |
- "BASE",+ size = nlevels(AVISIT) |
|
| 218 | -3x | +
- "BASEC",+ )), |
|
| 219 | 3x |
- "ABLFL",+ each = n() / nlevels(AVISIT) |
|
| 220 | -3x | +
- "ADTM",+ )) %>% |
|
| 221 | 3x |
- "ADY",+ dplyr::ungroup() %>% |
|
| 222 | 3x |
- "AVISIT",+ dplyr::mutate(ADY = ceiling(difftime(ADTM, TRTSDTM, units = "days"))) %>% |
|
| 223 | 3x |
- "AVISITN",+ dplyr::select(-TRTENDT) %>% |
|
| 224 | 3x |
- "APERIOD",+ dplyr::arrange(STUDYID, USUBJID, ADTM) |
|
| 225 | -3x | +
- "APERIODC",+ |
|
| 226 | 3x |
- "ONTRTFL",+ advs <- advs %>% dplyr::mutate(ONTRTFL = factor(dplyr::case_when( |
|
| 227 | 3x |
- "SRCSEQ",+ !AVISIT %in% c("SCREENING", "BASELINE") ~ "Y",
|
|
| 228 | 3x |
- "ANL01FL"+ TRUE ~ "" |
|
| 229 |
- )]+ ))) |
||
| 231 | 3x |
- adhy <- adhy %>%+ advs <- advs %>% |
|
| 232 | 3x |
- dplyr::arrange(+ dplyr::mutate(ASPID = sample(seq_len(dplyr::n()))) %>% |
|
| 233 | 3x |
- STUDYID,+ dplyr::group_by(USUBJID) %>% |
|
| 234 | 3x |
- USUBJID,+ dplyr::mutate(VSSEQ = seq_len(dplyr::n())) %>% |
|
| 235 | 3x |
- PARAMCD,+ dplyr::mutate(ASEQ = VSSEQ) %>% |
|
| 236 | 3x |
- AVISITN,+ dplyr::ungroup() %>% |
|
| 237 | 3x |
- ADTM,+ dplyr::arrange( |
|
| 238 | 3x |
- SRCSEQ+ STUDYID, |
|
| 239 | +3x | +
+ USUBJID,+ |
+ |
| 240 | +3x | +
+ PARAMCD,+ |
+ |
| 241 | +3x | +
+ BASETYPE,+ |
+ |
| 242 | +3x | +
+ AVISITN,+ |
+ |
| 243 | +3x | +
+ ATPTN,+ |
+ |
| 244 | +3x | +
+ DTYPE,+ |
+ |
| 245 | +3x | +
+ ADTM,+ |
+ |
| 246 | +3x | +
+ VSSEQ,+ |
+ |
| 247 | +3x | +
+ ASPID+ |
+ |
| 248 |
) |
||
| 240 | +249 | ++ | + + | +
| 250 | +3x | +
+ if (length(na_vars) > 0 && na_percentage > 0) {
+ |
+ |
| 251 | +! | +
+ advs <- mutate_na(ds = advs, na_vars = na_vars, na_percentage = na_percentage)+ |
+ |
| 252 | ++ |
+ }+ |
+ |
| 253 | |||
| 241 | +254 |
# apply metadata |
|
| 242 | +255 | 3x |
- adhy <- apply_metadata(adhy, "metadata/ADHY.yml")+ advs <- apply_metadata(advs, "metadata/ADVS.yml") |
| 243 | +256 | ||
| 244 | +257 | 3x |
- return(adhy)+ return(advs) |
| 245 | +258 |
}@@ -31368,14 +31570,14 @@ random.cdisc.data coverage - 98.86% |
| 1 |
- #' Tumor Response Analysis Dataset (ADTR)+ #' Time-to-Event Analysis Dataset (ADTTE) |
|||
| 5 |
- #' Function for generating a random Tumor Response Analysis Dataset for a given+ #' Function for generating a random Time-to-Event Analysis Dataset for a given |
|||
| 8 |
- #' @details One record per subject per parameter per analysis visit per analysis date.+ #' @details |
|||
| 10 |
- #' Keys: `STUDYID`, `USUBJID`, `PARAMCD`, `BASETYPE`, `AVISITN`, `DTYPE`+ #' Keys: `STUDYID`, `USUBJID`, `PARAMCD` |
|||
| 13 |
- #' @param ... Additional arguments to be passed to `radrs`.+ #' @inheritParams radaette |
|||
| 15 |
- #' @templateVar data adtr+ #' @templateVar data adtte |
|||
| 20 |
- #' @author tomlinsj, npaszty, Xuefeng Hou, dipietrc+ #' @examples |
|||
| 21 |
- #'+ #' adsl <- radsl(N = 10, seed = 1, study_duration = 2) |
|||
| 22 |
- #' @examples+ #' |
|||
| 23 |
- #' adsl <- radsl(N = 10, seed = 1, study_duration = 2)+ #' adtte <- radtte(adsl, seed = 2) |
|||
| 24 |
- #'+ #' adtte |
|||
| 25 |
- #' adtr <- radtr(adsl, seed = 2)+ radtte <- function(adsl, |
|||
| 26 |
- #' adtr+ event_descr = NULL, |
|||
| 27 |
- radtr <- function(adsl,+ censor_descr = NULL, |
|||
| 28 |
- param = c("Sum of Longest Diameter by Investigator"),
+ lookup = NULL, |
|||
| 29 |
- paramcd = c("SLDINV"),
+ seed = NULL, |
|||
| 30 |
- seed = NULL,+ na_percentage = 0, |
|||
| 31 |
- cached = FALSE,+ na_vars = list(CNSR = c(NA, 0.1), AVAL = c(1234, 0.1), AVALU = c(1234, 0.1)), |
|||
| 32 |
- ...) {
+ cached = FALSE) {
|
|||
| 35 | 1x |
- return(get_cached_data("cadtr"))
+ return(get_cached_data("cadtte"))
|
||
| 37 | -3x | +
- checkmate::assert_data_frame(adsl)+ |
||
| 38 | 3x |
- checkmate::assert_character(param, min.len = 1, any.missing = FALSE)+ checkmate::assert_data_frame(adsl) |
||
| 39 | 3x |
- checkmate::assert_character(paramcd, min.len = 1, any.missing = FALSE)+ checkmate::assert_character(censor_descr, null.ok = TRUE, min.len = 1, any.missing = FALSE) |
||
| 40 | 3x |
- checkmate::assert_number(seed, null.ok = TRUE)+ checkmate::assert_character(event_descr, null.ok = TRUE, min.len = 1, any.missing = FALSE) |
||
| 41 | 3x |
- stopifnot(length(param) == length(paramcd))+ checkmate::assert_number(seed, null.ok = TRUE) |
||
| 42 | -+ | 3x |
- # validate and initialize related variables+ checkmate::assert_number(na_percentage, lower = 0, upper = 1) |
|
| 43 | -+ | 3x |
-
+ checkmate::assert_true(na_percentage < 1) |
|
| 44 | -3x | +
- if (!is.null(seed)) {
+
|
||
| 45 | 3x |
- set.seed(seed)+ if (!is.null(seed)) {
|
||
| 46 | -+ | 3x |
- }+ set.seed(seed) |
|
| 47 |
-
+ } |
|||
| 48 | -+ | 3x |
- # Make times consistent with ADRS at ADY and ADTM.+ study_duration_secs <- lubridate::seconds(attr(adsl, "study_duration_secs")) |
|
| 49 | -3x | +
- adrs <- radrs(adsl, seed = seed, ...) %>%+ |
||
| 50 | 3x |
- dplyr::filter(PARAMCD == "OVRINV") %>%+ checkmate::assert_data_frame(lookup, null.ok = TRUE) |
||
| 51 | 3x |
- dplyr::select(+ lookup_tte <- if (!is.null(lookup)) {
|
||
| 52 | -3x | +! |
- "STUDYID",+ lookup |
|
| 53 | -3x | +
- "USUBJID",+ } else {
|
||
| 54 | 3x |
- "AVISIT",+ tibble::tribble( |
||
| 55 | 3x |
- "AVISITN",+ ~ARM, ~PARAMCD, ~PARAM, ~LAMBDA, ~CNSR_P, |
||
| 56 | 3x |
- "ADTM",+ "ARM A", "EFS", "Event Free Survival", log(2) / 365, 0.4, |
||
| 57 | 3x |
- "ADY"+ "ARM B", "EFS", "Event Free Survival", log(2) / 305, 0.3, |
||
| 58 | -+ | 3x |
- )+ "ARM C", "EFS", "Event Free Survival", log(2) / 243, 0.2, |
|
| 59 | -+ | 3x |
-
+ "ARM A", "CRSD", "Duration of Confirmed Response", log(2) / 305, 0.4, |
|
| 60 | 3x |
- adtr <- Map(function(parcd, par) {
+ "ARM B", "CRSD", "Duration of Confirmed Response", log(2) / 243, 0.3, |
||
| 61 | 3x |
- df <- adrs+ "ARM C", "CRSD", "Duration of Confirmed Response", log(2) / 182, 0.2, |
||
| 62 | 3x |
- df$AVAL <- stats::rnorm(nrow(df), mean = 150, sd = 30)+ "ARM A", "PFS", "Progression Free Survival", log(2) / 365, 0.4, |
||
| 63 | 3x |
- df$PARAMCD <- parcd+ "ARM B", "PFS", "Progression Free Survival", log(2) / 305, 0.3, |
||
| 64 | 3x |
- df$PARAM <- par+ "ARM C", "PFS", "Progression Free Survival", log(2) / 243, 0.2, |
||
| 65 | 3x |
- df+ "ARM A", "OS", "Overall Survival", log(2) / 610, 0.4, |
||
| 66 | 3x |
- }, paramcd, param) %>%+ "ARM B", "OS", "Overall Survival", log(2) / 490, 0.3, |
||
| 67 | 3x |
- Reduce(rbind, .)+ "ARM C", "OS", "Overall Survival", log(2) / 365, 0.2, |
||
| 68 |
-
+ ) |
|||
| 69 | -3x | +
- adtr_base <- adtr %>%+ } |
||
| 70 | -3x | +
- dplyr::filter(AVISITN == 0) %>%+ |
||
| 71 | 3x |
- dplyr::group_by(USUBJID, PARAMCD) %>%+ evntdescr_sel <- if (!is.null(event_descr)) {
|
||
| 72 | -3x | +! |
- dplyr::mutate(BASE = AVAL) %>%+ event_descr |
|
| 73 | -3x | +
- dplyr::select("STUDYID", "USUBJID", "BASE", "PARAMCD")
+ } else {
|
||
| 74 | -+ | 3x |
-
+ c( |
|
| 75 | 3x |
- adtr_postbase <- adtr %>%+ "Death", |
||
| 76 | 3x |
- dplyr::filter(AVISITN > 0) %>%+ "Disease Progression", |
||
| 77 | 3x |
- dplyr::filter(!is.na(AVAL)) %>%+ "Last Tumor Assessment", |
||
| 78 | 3x |
- dplyr::group_by(USUBJID, PARAMCD) %>%+ "Adverse Event", |
||
| 79 | 3x |
- dplyr::filter(AVAL == min(AVAL)) %>%+ "Alive" |
||
| 80 | -3x | +
- dplyr::slice(1) %>%+ ) |
||
| 81 | -3x | +
- dplyr::mutate(AVISIT = "POST-BASELINE MINIMUM") %>%+ } |
||
| 82 | -3x | +
- dplyr::mutate(DTYPE = "MINIMUM") %>%+ |
||
| 83 | 3x |
- dplyr::ungroup()+ cnsdtdscr_sel <- if (!is.null(censor_descr)) {
|
||
| 84 | -+ | ! |
-
+ censor_descr |
|
| 85 | -3x | +
- adtr_lastobs <- adtr %>%+ } else {
|
||
| 86 | 3x |
- dplyr::filter(AVISITN > 0) %>%+ c( |
||
| 87 | 3x |
- dplyr::filter(!is.na(AVAL)) %>%+ "Preferred Term", |
||
| 88 | 3x |
- dplyr::group_by(USUBJID, PARAMCD) %>%+ "Clinical Cut Off", |
||
| 89 | 3x |
- dplyr::filter(ADTM == max(ADTM, na.rm = TRUE)) %>%+ "Completion or Discontinuation", |
||
| 90 | 3x |
- dplyr::slice(1) %>%+ "End of AE Reporting Period" |
||
| 91 | -3x | +
- dplyr::mutate(LAST_VISIT = AVISIT) %>%+ ) |
||
| 92 | -3x | +
- dplyr::ungroup() %>%+ } |
||
| 93 | -3x | +
- dplyr::select(+ |
||
| 94 | 3x |
- "STUDYID",+ adtte <- split(adsl, adsl$USUBJID) %>% |
||
| 95 | 3x |
- "USUBJID",+ lapply(FUN = function(pinfo) {
|
||
| 96 | -3x | +30x |
- "PARAMCD",+ lookup_tte %>% |
|
| 97 | -3x | +30x |
- "LAST_VISIT"+ dplyr::filter(ARM == as.character(pinfo$ACTARMCD)) %>% |
|
| 98 | -+ | 30x |
- )+ dplyr::rowwise() %>% |
|
| 99 | -+ | 30x |
-
+ dplyr::mutate( |
|
| 100 | -3x | +30x |
- adtr <- rbind(adtr %>% dplyr::mutate(DTYPE = ""), adtr_postbase)+ STUDYID = pinfo$STUDYID, |
|
| 101 | -+ | 30x |
-
+ SITEID = pinfo$SITEID, |
|
| 102 | -3x | +30x |
- adtr <- merge(adtr, adtr_base, by = c("STUDYID", "USUBJID", "PARAMCD")) %>%
+ USUBJID = pinfo$USUBJID, |
|
| 103 | -3x | -
- dplyr::mutate(- |
- ||
| 104 | -3x | -
- ABLFL = dplyr::case_when(AVISIT == "BASELINE" ~ "Y", TRUE ~ ""),- |
- ||
| 105 | -3x | -
- AVAL = dplyr::case_when(AVISIT == "BASELINE" ~ NA_real_, TRUE ~ AVAL),- |
- ||
| 106 | -3x | -
- CHG = dplyr::case_when(AVISITN > 0 ~ AVAL - BASE, TRUE ~ NA_real_),- |
- ||
| 107 | -3x | -
- PCHG = dplyr::case_when(AVISITN > 0 ~ CHG / BASE * 100, TRUE ~ NA_real_),- |
- ||
| 108 | -3x | -
- AVALC = as.character(AVAL),- |
- ||
| 109 | -3x | -
- AVALU = "mm"- |
- ||
| 110 | -- |
- )- |
- ||
| 111 | -- | - - | -||
| 112 | -- |
- # ensure PCHG does not exceed 200%, nor go below -100% (double in size, or complete remission of tumor).- |
- ||
| 113 | -3x | -
- adtr <- adtr %>%- |
- ||
| 114 | -3x | -
- dplyr::mutate(- |
- ||
| 115 | -3x | -
- PCHG_DUM = PCHG,- |
- ||
| 116 | -3x | -
- PCHG = dplyr::case_when(- |
- ||
| 117 | -3x | -
- PCHG_DUM > 200 ~ 200,- |
- ||
| 118 | -3x | -
- PCHG_DUM < -100 ~ -100,- |
- ||
| 119 | -3x | -
- TRUE ~ PCHG- |
- ||
| 120 | -- |
- ),- |
- ||
| 121 | -3x | -
- AVAL = dplyr::case_when(- |
- ||
| 122 | -3x | -
- PCHG_DUM > 200 ~ 3 * BASE,- |
- ||
| 123 | -3x | -
- PCHG_DUM < -100 ~ 0,- |
- ||
| 124 | -3x | -
- TRUE ~ AVAL- |
- ||
| 125 | -- |
- ),- |
- ||
| 126 | -3x | -
- CHG = dplyr::case_when(- |
- ||
| 127 | -3x | -
- PCHG_DUM > 200 ~ 2 * BASE,- |
- ||
| 128 | -3x | -
- PCHG_DUM < -100 ~ -BASE,- |
- ||
| 129 | -3x | -
- TRUE ~ CHG- |
- ||
| 130 | -+ | 30x |
- )+ AVALU = "DAYS" |
|
| 131 | +104 |
- ) %>%+ ) %>% |
||
| 132 | -3x | +105 | +30x |
- dplyr::select(-"PCHG_DUM")+ dplyr::select(-"LAMBDA", -"CNSR_P") |
| 133 | +106 | - - | -||
| 134 | -3x | -
- adtr <- merge(adsl, adtr, by = c("STUDYID", "USUBJID")) %>%
+ }) %>% |
||
| 135 | +107 | 3x |
- dplyr::group_by(USUBJID, PARAMCD) %>%+ Reduce(rbind, .) %>% |
|
| 136 | +108 | 3x |
- dplyr::mutate(+ rcd_var_relabel( |
|
| 137 | +109 | 3x |
- ONTRTFL = factor(dplyr::case_when(+ STUDYID = "Study Identifier", |
|
| 138 | +110 | 3x |
- !AVISIT %in% c("SCREENING", "BASELINE", "FOLLOW UP") ~ "Y",
+ USUBJID = "Unique Subject Identifier" # ) |
|
| 139 | -3x | +|||
| 111 | +
- TRUE ~ ""+ ) |
|||
| 140 | +112 |
- )),+ |
||
| 141 | -3x | +|||
| 113 | +
- ANL01FL = dplyr::case_when(+ # Loop through each patient and randomly assign a value for EVNTDESC |
|||
| 142 | +114 | 3x |
- DTYPE == "" & AVISITN > 0 ~ "Y",+ adtte_split <- split(adtte, adtte$USUBJID) |
|
| 143 | -3x | +|||
| 115 | +
- TRUE ~ ""+ |
|||
| 144 | +116 |
- ),+ # Add EVNTDESC column |
||
| 145 | +117 | 3x |
- ANL03FL = dplyr::case_when(+ adtte_lst <- lapply(adtte_split, function(split_df) {
|
|
| 146 | -3x | +|||
| 118 | +
- DTYPE == "MINIMUM" ~ "Y",+ # First create an empty EVNTDESC variable to populate |
|||
| 147 | -3x | +119 | +30x |
- ABLFL == "Y" ~ "Y",+ split_df$EVNTDESC <- NA |
| 148 | -3x | +120 | +30x |
- TRUE ~ ""+ for (i in 1:nrow(split_df)) { # nolint
|
| 149 | +121 |
- )+ # If this is the first row then create a random value from evntdescr_sel for EVNTDESC |
||
| 150 | -+ | |||
| 122 | +120x |
- )+ if (i == 1) {
|
||
| 151 | -3x | +123 | +30x |
- adtr <- merge(adtr, adtr_lastobs, by = c("STUDYID", "USUBJID", "PARAMCD")) %>%
+ split_df$EVNTDESC[i] <- sample(evntdescr_sel[c(1:4)], 1, prob = c(0.1, 0.3, 0.4, 0.2)) |
| 152 | -3x | +124 | +90x |
- dplyr::mutate(+ } else if (i != 1 & i != nrow(split_df)) {
|
| 153 | -3x | +|||
| 125 | +
- ANL02FL = dplyr::case_when(+ # First check to see if "Death" has been entered in as a previous value |
|||
| 154 | -3x | +|||
| 126 | +
- as.character(AVISIT) == as.character(LAST_VISIT) ~ "Y",+ # If so we need to make the rest of the EVNTDESC values "Death" to make sense |
|||
| 155 | -3x | +|||
| 127 | +
- ABLFL == "Y" ~ "Y",+ # The patient cannot die and then come back to life |
|||
| 156 | -3x | +128 | +60x |
- TRUE ~ ""+ if (any(grepl("Death", split_df$EVNTDESC))) { # If previous value has "Death" the following need to be "Death"
|
| 157 | -+ | |||
| 129 | +21x |
- )+ split_df$EVNTDESC[i] <- "Death" |
||
| 158 | -+ | |||
| 130 | +3x |
- ) %>%+ } else { # If there are no "Death" values randomly select another value
|
||
| 159 | -3x | +131 | +39x |
- dplyr::select(-"LAST_VISIT")+ split_df$EVNTDESC[i] <- sample(evntdescr_sel[c(1:4)], 1) |
| 160 | +132 |
- # Adding variables that are in ADTR osprey but not RCD.+ } |
||
| 161 | +133 | 3x |
- adtr <- adtr %>%+ } else { # This is for processing OS as this can only be "Death" or "Alive"
|
|
| 162 | -3x | +134 | +30x |
- dplyr::mutate(+ if (any(grepl("Death", split_df$EVNTDESC))) { # If previous value has "Death" the following need to be "Death"
|
| 163 | -3x | +135 | +21x |
- DCSREAS_GRP = ifelse(DCSREAS == "ADVERSE EVENT", "Safety", "Non-Safety"),+ split_df$EVNTDESC[i] <- "Death" |
| 164 | +136 | 3x |
- TRTDURD = ifelse(+ } else { # If there are no "Death" values randomly select another value
|
|
| 165 | -3x | +137 | +9x |
- is.na(TRTSDTM) | is.na(TRTEDTM),+ split_df$EVNTDESC[i] <- "Alive" |
| 166 | -3x | +|||
| 138 | +
- NA,+ } |
|||
| 167 | -3x | +|||
| 139 | +
- TRTEDTM - (TRTSDTM + lubridate::days(1))+ } |
|||
| 168 | +140 |
- ),+ } |
||
| 169 | -3x | +141 | +30x |
- AGEGR1 = ifelse(AGE < 65, "<65", ">=65")+ split_df |
| 170 | +142 |
- )+ }) |
||
| 171 | +143 | |||
| 172 | +144 |
- # apply metadata+ # Add CNSR column |
||
| 173 | +145 | 3x |
- adtr <- apply_metadata(adtr, "metadata/ADTR.yml")+ adtte_lst <- lapply(adtte_lst, function(split_df) {
|
|
| 174 | -3x | +|||
| 146 | +
- return(adtr)+ # First create an empty CNSR variable to populate |
|||
| 175 | -+ | |||
| 147 | +30x |
- }+ split_df$CNSR <- NA |
| 1 | -+ | |||
| 148 | +30x |
- #' Protocol Deviations Analysis Dataset (ADDV)+ for (i in 1:nrow(split_df)) { # nolint
|
||
| 2 | +149 |
- #'+ # If this is the first row then create a random value from evntdescr_sel for EVNTDESC |
||
| 3 | -+ | |||
| 150 | +120x |
- #' @description `r lifecycle::badge("stable")`
+ if (split_df$EVNTDESC[i] == "Death" | split_df$EVNTDESC[i] == "Disease Progression") {
|
||
| 4 | -+ | |||
| 151 | +81x |
- #'+ split_df$CNSR[i] <- 0 |
||
| 5 | +152 |
- #' Function for generating random Protocol Deviations Analysis Dataset for a given+ } else {
|
||
| 6 | -+ | |||
| 153 | +39x |
- #' Subject-Level Analysis Dataset.+ split_df$CNSR[i] <- 1 |
||
| 7 | +154 |
- #'+ } |
||
| 8 | +155 |
- #' @details One record per each record in the corresponding SDTM domain.+ } |
||
| 9 | -+ | |||
| 156 | +30x |
- #'+ split_df |
||
| 10 | +157 |
- #' Keys: `STUDYID`, `USUBJID`, `ASTDT`, `DVTERM`, `DVSEQ`+ }) |
||
| 11 | +158 |
- #'+ |
||
| 12 | +159 |
- #' @inheritParams argument_convention+ # Add AVAL column |
||
| 13 | -+ | |||
| 160 | +3x |
- #' @param max_n_dv (`integer`)\cr Maximum number of deviations per patient. Defaults to 3.+ adtte_lst <- lapply(adtte_lst, function(split_df) {
|
||
| 14 | +161 |
- #' @param p_dv (`proportion`)\cr Probability of a patient having protocol deviations.+ # First create an empty CNSR variable to populate |
||
| 15 | -+ | |||
| 162 | +30x |
- #' @template param_cached+ split_df$AVAL <- NA |
||
| 16 | -+ | |||
| 163 | +30x |
- #' @templateVar data addv+ for (i in 1:nrow(split_df)) { # nolint
|
||
| 17 | -+ | |||
| 164 | +120x |
- #'+ if (i == 1) {
|
||
| 18 | -+ | |||
| 165 | +30x |
- #' @return `data.frame`+ split_df$AVAL[i] <- stats::runif(1, 15, 100) |
||
| 19 | -+ | |||
| 166 | +90x |
- #' @export+ } else if (i != 1 & any(grepl("Death", split_df[1:i - 1, "EVNTDESC"]))) {
|
||
| 20 | +167 |
- #'+ # Check if there are any death values before the current row |
||
| 21 | +168 |
- #' @examples+ # Set the AVAL to the value of the row that has the "Death" value |
||
| 22 | +169 |
- #' adsl <- radsl(N = 10, seed = 1, study_duration = 2)+ # as the patient cannot live longer than this value |
||
| 23 | -+ | |||
| 170 | +42x |
- #'+ death_position <- match("Death", split_df[1:i - 1, "EVNTDESC"][[1]])
|
||
| 24 | -+ | |||
| 171 | +42x |
- #' addv <- raddv(adsl, seed = 2)+ split_df$AVAL[i] <- split_df$AVAL[death_position] |
||
| 25 | -+ | |||
| 172 | +48x |
- #' addv+ } else if (i == 2) {
|
||
| 26 | -+ | |||
| 173 | +24x |
- raddv <- function(adsl,+ split_df$AVAL[i] <- stats::runif(1, 100, 200) |
||
| 27 | -+ | |||
| 174 | +24x |
- max_n_dv = 3L,+ } else if (i == 3) {
|
||
| 28 | -+ | |||
| 175 | +15x |
- p_dv = 0.15,+ split_df$AVAL[i] <- stats::runif(1, 200, 300) |
||
| 29 | -+ | |||
| 176 | +9x |
- lookup = NULL,+ } else if (i == 4) {
|
||
| 30 | -+ | |||
| 177 | +9x |
- seed = NULL,+ split_df$AVAL[i] <- stats::runif(1, 300, 500) |
||
| 31 | +178 |
- na_percentage = 0,+ } |
||
| 32 | +179 |
- na_vars = list(+ } |
||
| 33 | -+ | |||
| 180 | +30x |
- "ASTDT" = c(seed = 1234, percentage = 0.1),+ split_df |
||
| 34 | +181 |
- "DVCAT" = c(seed = 1234, percentage = 0.1)+ }) |
||
| 35 | +182 |
- ),+ |
||
| 36 | +183 |
- cached = FALSE) {
+ # Add CNSDTDSC column |
||
| 37 | -4x | +184 | +3x |
- checkmate::assert_flag(cached)+ adtte_lst <- lapply(adtte_lst, function(split_df) {
|
| 38 | -4x | +|||
| 185 | +
- if (cached) {
+ # First create an empty CNSDTDSC variable to populate |
|||
| 39 | -1x | -
- return(get_cached_data("caddv"))
- |
- ||
| 40 | -+ | 186 | +30x |
- }+ split_df$CNSDTDSC <- NA |
| 41 | -+ | |||
| 187 | +30x |
-
+ for (i in 1:nrow(split_df)) { # nolint
|
||
| 42 | -3x | +188 | +120x |
- checkmate::assert_data_frame(adsl)+ if (split_df$CNSR[i] == 1 & split_df$EVNTDESC[i] == "Last Tumor Assessment") {
|
| 43 | -3x | +189 | +27x |
- checkmate::assert_integer(max_n_dv, len = 1, lower = 1, any.missing = FALSE)+ split_df$CNSDTDSC[i] <- "Completion or Discontinuation" |
| 44 | -3x | +190 | +93x |
- checkmate::assert_number(p_dv, lower = .Machine$double.xmin, upper = 1)+ } else if (split_df$CNSR[i] == 1 & split_df$EVNTDESC[i] == "Adverse Event") {
|
| 45 | +191 | 3x |
- checkmate::assert_number(seed, null.ok = TRUE)+ split_df$CNSDTDSC[i] <- "Preferred Term" |
|
| 46 | -3x | +192 | +90x |
- checkmate::assert_number(na_percentage, lower = 0, upper = 1)+ } else if (split_df$CNSR[i] == 1 & split_df$EVNTDESC[i] == "Alive") {
|
| 47 | -3x | +193 | +9x |
- checkmate::assert_true(na_percentage < 1)+ split_df$CNSDTDSC[i] <- "Alive During Study" |
| 48 | +194 |
-
+ } else {
|
||
| 49 | -3x | +195 | +81x |
- if (!is.null(seed)) set.seed(seed)+ split_df$CNSDTDSC[i] <- "" |
| 50 | -3x | +|||
| 196 | +
- study_duration_secs <- lubridate::seconds(attr(adsl, "study_duration_secs"))+ } |
|||
| 51 | +197 |
-
+ } |
||
| 52 | -3x | +198 | +30x |
- checkmate::assert_data_frame(lookup, null.ok = TRUE)+ split_df |
| 53 | -3x | +|||
| 199 | +
- lookup_dv <- if (!is.null(lookup)) {
+ }) |
|||
| 54 | -! | +|||
| 200 | +
- lookup+ |
|||
| 55 | +201 |
- } else {
+ # Take the split df and combine them back together |
||
| 56 | +202 | 3x |
- tibble::tribble(+ adtte <- do.call("rbind", adtte_lst)
|
|
| 57 | +203 | 3x |
- ~DOMAIN, ~DVCAT, ~DVDECOD, ~DVTERM, ~DVREAS, ~DVEPRELI,+ rownames(adtte) <- NULL |
|
| 58 | -3x | +|||
| 204 | +
- "DV", "MAJOR", "EXCLUSION CRITERIA", "Received prior prohibited therapy or medication", "", "N",+ |
|||
| 59 | +205 | 3x |
- "DV", "MAJOR", "EXCLUSION CRITERIA", "Active or untreated or other excluded cns metastases", "", "N",+ adtte <- rcd_var_relabel( |
|
| 60 | +206 | 3x |
- "DV", "MAJOR", "EXCLUSION CRITERIA", "History of other malignancies within the last 5 years", "", "N",+ adtte, |
|
| 61 | +207 | 3x |
- "DV", "MAJOR", "EXCLUSION CRITERIA", "Uncontrolled concurrent condition", "", "N",+ STUDYID = "Study Identifier", |
|
| 62 | +208 | 3x |
- "DV", "MAJOR", "EXCLUSION CRITERIA", "Other exclusion criteria", "", "N",+ USUBJID = "Unique Subject Identifier" |
|
| 63 | -3x | +|||
| 209 | +
- "DV", "MAJOR", "EXCLUSION CRITERIA", "Pregnancy criteria", "", "N",+ ) |
|||
| 64 | -3x | +|||
| 210 | +
- "DV", "MAJOR", "INCLUSION CRITERIA", "Does not meet prior therapy requirements", "", "N",+ |
|||
| 65 | -3x | +|||
| 211 | +
- "DV", "MAJOR", "INCLUSION CRITERIA", "Inclusion lab values outside allowed limits", "", "N",+ # merge ADSL to be able to add TTE date and study day variables |
|||
| 66 | +212 | 3x |
- "DV", "MAJOR", "INCLUSION CRITERIA", "No signed ICF at study entry", "", "N",+ adtte <- dplyr::inner_join( |
|
| 67 | +213 | 3x |
- "DV", "MAJOR", "INCLUSION CRITERIA", "Inclusion-related test not done/out of window", "", "N",+ dplyr::select(adtte, -"SITEID", -"ARM"), |
|
| 68 | +214 | 3x |
- "DV", "MAJOR", "INCLUSION CRITERIA", "Ineligible cancer type or current cancer stage", "", "N",+ adsl, |
|
| 69 | +215 | 3x |
- "DV", "MAJOR", "MEDICATION", "Dose missed or significantly out of window",+ by = c("STUDYID", "USUBJID")
|
|
| 70 | -3x | +|||
| 216 | +
- "Site action due to epidemic/pandemic", "Y",+ ) %>% |
|||
| 71 | +217 | 3x |
- "DV", "MAJOR", "MEDICATION", "Received incorrect study medication", "", "N",+ dplyr::rowwise() %>% |
|
| 72 | +218 | 3x |
- "DV", "MAJOR", "MEDICATION", "Received prohibited concomitant medication", "", "N",+ dplyr::mutate(TRTENDT = lubridate::date(dplyr::case_when( |
|
| 73 | +219 | 3x |
- "DV", "MAJOR", "MEDICATION", "Discontinued study drug for unspecified reason", "", "N",+ is.na(TRTEDTM) ~ lubridate::floor_date(lubridate::date(TRTSDTM) + study_duration_secs, unit = "day"), |
|
| 74 | +220 | 3x |
- "DV", "MAJOR", "MEDICATION", "Significant deviation from planned dose",+ TRUE ~ TRTEDTM |
|
| 75 | -3x | +|||
| 221 | +
- "Site action due to epidemic/pandemic", "Y",+ ))) %>% |
|||
| 76 | +222 | 3x |
- "DV", "MAJOR", "PROCEDURAL", "Missed assessment affecting safety/study outcomes", "", "N",+ dplyr::mutate(ADTM = sample( |
|
| 77 | +223 | 3x |
- "DV", "MAJOR", "PROCEDURAL", "Eligibility-related test not done/out of window", "", "N",+ seq(lubridate::as_datetime(TRTSDTM), lubridate::as_datetime(TRTENDT), by = "day"), |
|
| 78 | +224 | 3x |
- "DV", "MAJOR", "PROCEDURAL", "Failure to sign updated ICF within two visits",+ size = 1 |
|
| 79 | -3x | +|||
| 225 | +
- "Site action due to epidemic/pandemic", "Y",+ )) %>% |
|||
| 80 | +226 | 3x |
- "DV", "MAJOR", "PROCEDURAL", "Omission of complete lab panel required by protocol", "", "N",+ dplyr::mutate(ADY = ceiling(difftime(ADTM, TRTSDTM, units = "days"))) %>% |
|
| 81 | +227 | 3x |
- "DV", "MAJOR", "PROCEDURAL", "Omission of screening tumor assessment", "", "N",+ dplyr::select(-TRTENDT) %>% |
|
| 82 | +228 | 3x |
- "DV", "MAJOR", "PROCEDURAL", "Missed 2 or more efficacy assessments",+ dplyr::ungroup() %>% |
|
| 83 | +229 | 3x |
- "Site action due to epidemic/pandemic", "Y"- |
- |
| 84 | -- |
- )- |
- ||
| 85 | -- |
- }+ dplyr::arrange(STUDYID, USUBJID, ADTM) |
||
| 86 | +230 | |||
| 87 | -+ | |||
| 231 | +3x |
-
+ adtte <- adtte %>% |
||
| 88 | +232 | 3x |
- addv <- Map(+ dplyr::group_by(USUBJID) %>% |
|
| 89 | +233 | 3x |
- function(id, sid) {
+ dplyr::mutate(TTESEQ = seq_len(dplyr::n())) %>% |
|
| 90 | -30x | +234 | +3x |
- n_dv <- stats::rbinom(1, 1, p_dv) * sample(c(1, seq_len(max_n_dv)), 1)+ dplyr::mutate(ASEQ = TTESEQ) %>% |
| 91 | -30x | +235 | +3x |
- i <- sample(seq_len(nrow(lookup_dv)), n_dv, TRUE)+ dplyr::mutate(PARAM = as.factor(PARAM)) %>% |
| 92 | -30x | +236 | +3x |
- dplyr::mutate(+ dplyr::mutate(PARAMCD = as.factor(PARAMCD)) %>% |
| 93 | -30x | +237 | +3x |
- lookup_dv[i, ],+ dplyr::ungroup() %>% |
| 94 | -30x | +238 | +3x |
- USUBJID = id,+ dplyr::arrange( |
| 95 | -30x | +239 | +3x |
- STUDYID = sid+ STUDYID, |
| 96 | -+ | |||
| 240 | +3x |
- )+ USUBJID, |
||
| 97 | -+ | |||
| 241 | +3x |
- },+ PARAMCD, |
||
| 98 | +242 | 3x |
- adsl$USUBJID,+ ADTM, |
|
| 99 | +243 | 3x |
- adsl$STUDYID+ TTESEQ |
|
| 100 | +244 |
- ) %>%+ ) |
||
| 101 | -3x | +|||
| 245 | +
- Reduce(rbind, .) %>%+ |
|||
| 102 | +246 | 3x |
- dplyr::mutate(DVSCAT = DVCAT)+ mod_before_adtte <- adtte |
|
| 103 | +247 | |||
| 104 | -3x | +|||
| 248 | +
- addv <- var_relabel(+ # adding adverse event counts and log follow-up time |
|||
| 105 | +249 | 3x |
- addv,+ adtte <- dplyr::bind_rows( |
|
| 106 | +250 | 3x |
- STUDYID = "Study Identifier",+ adtte, |
|
| 107 | +251 | 3x |
- USUBJID = "Unique Subject Identifier"+ data.frame( |
|
| 108 | -+ | |||
| 252 | +3x |
- )+ adtte %>% |
||
| 109 | -+ | |||
| 253 | +3x |
-
+ dplyr::group_by(USUBJID) %>% |
||
| 110 | -+ | |||
| 254 | +3x |
- # merge ADSL to be able to add deviation date and study day variables+ dplyr::slice_head(n = 1) %>% |
||
| 111 | +255 | 3x |
- addv <- dplyr::inner_join(addv, adsl, by = c("STUDYID", "USUBJID")) %>%
+ dplyr::mutate( |
|
| 112 | +256 | 3x |
- dplyr::rowwise() %>%+ PARAMCD = "TNE", |
|
| 113 | +257 | 3x |
- dplyr::mutate(TRTENDT = lubridate::date(dplyr::case_when(+ PARAM = "Total Number of Exacerbations", |
|
| 114 | +258 | 3x |
- is.na(TRTEDTM) ~ lubridate::floor_date(lubridate::date(TRTSDTM) + study_duration_secs, unit = "day"),+ AVAL = stats::rpois(1, 3), |
|
| 115 | +259 | 3x |
- TRUE ~ TRTEDTM+ AVALU = "COUNT", |
|
| 116 | -+ | |||
| 260 | +3x |
- ))) %>%+ lgTMATRSK = log(stats::rexp(1, rate = 3)), |
||
| 117 | +261 | 3x |
- dplyr::mutate(ASTDTM = sample(+ dplyr::across( |
|
| 118 | +262 | 3x |
- seq(lubridate::as_datetime(TRTSDTM), lubridate::as_datetime(TRTENDT), by = "day"),+ c("ASEQ", "TTESEQ", "ADY", "ADTM", "EVNTDESC"),
|
|
| 119 | +263 | 3x |
- size = 1+ ~NA |
|
| 120 | +264 |
- )) %>%+ ) |
||
| 121 | -3x | +|||
| 265 | +
- dplyr::mutate(ASTDT = lubridate::date(ASTDTM)) %>%+ ) |
|||
| 122 | -3x | +|||
| 266 | +
- dplyr::mutate(ASTDY = ceiling(difftime(ASTDTM, TRTSDTM, units = "days"))) %>%+ ) |
|||
| 123 | -3x | +|||
| 267 | +
- dplyr::select(-TRTENDT, -ASTDTM) %>%+ ) %>% |
|||
| 124 | +268 | 3x |
- dplyr::ungroup() %>%+ dplyr::arrange( |
|
| 125 | +269 | 3x |
- dplyr::arrange(STUDYID, USUBJID, ASTDT, DVTERM)- |
- |
| 126 | -- |
-
+ STUDYID, |
||
| 127 | +270 | 3x |
- addv <- addv %>%+ USUBJID, |
|
| 128 | +271 | 3x |
- dplyr::group_by(USUBJID) %>%+ PARAMCD, |
|
| 129 | +272 | 3x |
- dplyr::mutate(DVSEQ = seq_len(dplyr::n())) %>%+ ADTM, |
|
| 130 | +273 | 3x |
- dplyr::ungroup() %>%+ TTESEQ |
|
| 131 | -3x | +|||
| 274 | +
- dplyr::arrange(STUDYID, USUBJID, ASTDT, DVTERM, DVSEQ)+ ) |
|||
| 132 | +275 | |||
| 133 | -3x | -
- addv <- addv %>%- |
- ||
| 134 | +276 | 3x |
- dplyr::mutate(AEPRELFL = ifelse(DVEPRELI == "Y", DVEPRELI, ""))+ mod_after_adtte <- adtte |
|
| 135 | +277 | |||
| 136 | +278 | 3x |
if (length(na_vars) > 0 && na_percentage > 0) {
|
|
| 137 | +279 | ! |
- addv <- mutate_na(ds = addv, na_vars = na_vars, na_percentage = na_percentage)+ adtte <- mutate_na(ds = adtte, na_vars = na_vars, na_percentage = na_percentage) |
|
| 138 | +280 |
} |
||
| 139 | +281 | |||
| 140 | +282 |
# apply metadata |
||
| 141 | +283 | 3x |
- addv <- apply_metadata(addv, "metadata/ADDV.yml")+ adtte <- apply_metadata(adtte, "metadata/ADTTE.yml") |
|
| 142 | +284 | |||
| 143 | +285 | 3x |
- return(addv)+ return(adtte) |
|
| 144 | +286 |
}@@ -33613,14 +33578,14 @@ random.cdisc.data coverage - 98.86% |
| 1 |
- #' Time-to-Event Analysis Dataset (ADTTE)+ #' Protocol Deviations Analysis Dataset (ADDV) |
||
| 5 |
- #' Function for generating a random Time-to-Event Analysis Dataset for a given+ #' Function for generating random Protocol Deviations Analysis Dataset for a given |
||
| 8 |
- #' @details+ #' @details One record per each record in the corresponding SDTM domain. |
||
| 10 |
- #' Keys: `STUDYID`, `USUBJID`, `PARAMCD`+ #' Keys: `STUDYID`, `USUBJID`, `ASTDT`, `DVTERM`, `DVSEQ` |
||
| 13 |
- #' @inheritParams radaette+ #' @param max_n_dv (`integer`)\cr Maximum number of deviations per patient. Defaults to 3. |
||
| 14 |
- #' @template param_cached+ #' @param p_dv (`proportion`)\cr Probability of a patient having protocol deviations. |
||
| 15 |
- #' @templateVar data adtte+ #' @template param_cached |
||
| 16 |
- #'+ #' @templateVar data addv |
||
| 17 |
- #' @return `data.frame`+ #' |
||
| 18 |
- #' @export+ #' @return `data.frame` |
||
| 19 |
- #'+ #' @export |
||
| 20 |
- #' @examples+ #' |
||
| 21 |
- #' adsl <- radsl(N = 10, seed = 1, study_duration = 2)+ #' @examples |
||
| 22 |
- #'+ #' adsl <- radsl(N = 10, seed = 1, study_duration = 2) |
||
| 23 |
- #' adtte <- radtte(adsl, seed = 2)+ #' |
||
| 24 |
- #' adtte+ #' addv <- raddv(adsl, seed = 2) |
||
| 25 |
- radtte <- function(adsl,+ #' addv |
||
| 26 |
- event_descr = NULL,+ raddv <- function(adsl, |
||
| 27 |
- censor_descr = NULL,+ max_n_dv = 3L, |
||
| 28 |
- lookup = NULL,+ p_dv = 0.15, |
||
| 29 |
- seed = NULL,+ lookup = NULL, |
||
| 30 |
- na_percentage = 0,+ seed = NULL, |
||
| 31 |
- na_vars = list(CNSR = c(NA, 0.1), AVAL = c(1234, 0.1), AVALU = c(1234, 0.1)),+ na_percentage = 0, |
||
| 32 |
- cached = FALSE) {
+ na_vars = list( |
||
| 33 | ++ |
+ "ASTDT" = c(seed = 1234, percentage = 0.1),+ |
+ |
| 34 | ++ |
+ "DVCAT" = c(seed = 1234, percentage = 0.1)+ |
+ |
| 35 | ++ |
+ ),+ |
+ |
| 36 | ++ |
+ cached = FALSE) {
+ |
+ |
| 37 | 4x |
checkmate::assert_flag(cached) |
|
| 34 | +38 | 4x |
if (cached) {
|
| 35 | +39 | 1x |
- return(get_cached_data("cadtte"))
+ return(get_cached_data("caddv"))
|
| 36 | +40 |
} |
|
| 37 | +41 | ||
| 38 | +42 | 3x |
checkmate::assert_data_frame(adsl) |
| 39 | +43 | 3x |
- checkmate::assert_character(censor_descr, null.ok = TRUE, min.len = 1, any.missing = FALSE)+ checkmate::assert_integer(max_n_dv, len = 1, lower = 1, any.missing = FALSE) |
| 40 | +44 | 3x |
- checkmate::assert_character(event_descr, null.ok = TRUE, min.len = 1, any.missing = FALSE)+ checkmate::assert_number(p_dv, lower = .Machine$double.xmin, upper = 1) |
| 41 | +45 | 3x |
checkmate::assert_number(seed, null.ok = TRUE) |
| 42 | +46 | 3x |
checkmate::assert_number(na_percentage, lower = 0, upper = 1) |
| 43 | +47 | 3x |
checkmate::assert_true(na_percentage < 1) |
| 44 | +48 | ||
| 45 | -3x | -
- if (!is.null(seed)) {
- |
- |
| 46 | +49 | 3x |
- set.seed(seed)- |
-
| 47 | -- |
- }+ if (!is.null(seed)) set.seed(seed) |
|
| 48 | +50 | 3x |
study_duration_secs <- lubridate::seconds(attr(adsl, "study_duration_secs")) |
| 49 | +51 | ||
| 50 | +52 | 3x |
checkmate::assert_data_frame(lookup, null.ok = TRUE) |
| 51 | +53 | 3x |
- lookup_tte <- if (!is.null(lookup)) {
+ lookup_dv <- if (!is.null(lookup)) {
|
| 52 | +54 | ! |
lookup |
| 53 | +55 |
} else {
|
|
| 54 | -3x | -
- tibble::tribble(- |
- |
| 55 | -3x | -
- ~ARM, ~PARAMCD, ~PARAM, ~LAMBDA, ~CNSR_P,- |
- |
| 56 | 3x |
- "ARM A", "EFS", "Event Free Survival", log(2) / 365, 0.4,+ tibble::tribble( |
|
| 57 | 3x |
- "ARM B", "EFS", "Event Free Survival", log(2) / 305, 0.3,+ ~DOMAIN, ~DVCAT, ~DVDECOD, ~DVTERM, ~DVREAS, ~DVEPRELI, |
|
| 58 | 3x |
- "ARM C", "EFS", "Event Free Survival", log(2) / 243, 0.2,+ "DV", "MAJOR", "EXCLUSION CRITERIA", "Received prior prohibited therapy or medication", "", "N", |
|
| 59 | 3x |
- "ARM A", "CRSD", "Duration of Confirmed Response", log(2) / 305, 0.4,+ "DV", "MAJOR", "EXCLUSION CRITERIA", "Active or untreated or other excluded cns metastases", "", "N", |
|
| 60 | 3x |
- "ARM B", "CRSD", "Duration of Confirmed Response", log(2) / 243, 0.3,+ "DV", "MAJOR", "EXCLUSION CRITERIA", "History of other malignancies within the last 5 years", "", "N", |
|
| 61 | 3x |
- "ARM C", "CRSD", "Duration of Confirmed Response", log(2) / 182, 0.2,+ "DV", "MAJOR", "EXCLUSION CRITERIA", "Uncontrolled concurrent condition", "", "N", |
|
| 62 | 3x |
- "ARM A", "PFS", "Progression Free Survival", log(2) / 365, 0.4,+ "DV", "MAJOR", "EXCLUSION CRITERIA", "Other exclusion criteria", "", "N", |
|
| 63 | 3x |
- "ARM B", "PFS", "Progression Free Survival", log(2) / 305, 0.3,+ "DV", "MAJOR", "EXCLUSION CRITERIA", "Pregnancy criteria", "", "N", |
|
| 64 | 3x |
- "ARM C", "PFS", "Progression Free Survival", log(2) / 243, 0.2,+ "DV", "MAJOR", "INCLUSION CRITERIA", "Does not meet prior therapy requirements", "", "N", |
|
| 65 | 3x |
- "ARM A", "OS", "Overall Survival", log(2) / 610, 0.4,+ "DV", "MAJOR", "INCLUSION CRITERIA", "Inclusion lab values outside allowed limits", "", "N", |
|
| 66 | 3x |
- "ARM B", "OS", "Overall Survival", log(2) / 490, 0.3,+ "DV", "MAJOR", "INCLUSION CRITERIA", "No signed ICF at study entry", "", "N", |
|
| 67 | 3x |
- "ARM C", "OS", "Overall Survival", log(2) / 365, 0.2,+ "DV", "MAJOR", "INCLUSION CRITERIA", "Inclusion-related test not done/out of window", "", "N", |
|
| 68 | -+ | 3x |
- )+ "DV", "MAJOR", "INCLUSION CRITERIA", "Ineligible cancer type or current cancer stage", "", "N", |
| 69 | -+ | 3x |
- }+ "DV", "MAJOR", "MEDICATION", "Dose missed or significantly out of window", |
| 70 | -+ | 3x |
-
+ "Site action due to epidemic/pandemic", "Y", |
| 71 | 3x |
- evntdescr_sel <- if (!is.null(event_descr)) {
+ "DV", "MAJOR", "MEDICATION", "Received incorrect study medication", "", "N", |
|
| 72 | -! | +3x |
- event_descr+ "DV", "MAJOR", "MEDICATION", "Received prohibited concomitant medication", "", "N", |
| 73 | -+ | 3x |
- } else {
+ "DV", "MAJOR", "MEDICATION", "Discontinued study drug for unspecified reason", "", "N", |
| 74 | 3x |
- c(+ "DV", "MAJOR", "MEDICATION", "Significant deviation from planned dose", |
|
| 75 | 3x |
- "Death",+ "Site action due to epidemic/pandemic", "Y", |
|
| 76 | 3x |
- "Disease Progression",+ "DV", "MAJOR", "PROCEDURAL", "Missed assessment affecting safety/study outcomes", "", "N", |
|
| 77 | 3x |
- "Last Tumor Assessment",+ "DV", "MAJOR", "PROCEDURAL", "Eligibility-related test not done/out of window", "", "N", |
|
| 78 | 3x |
- "Adverse Event",+ "DV", "MAJOR", "PROCEDURAL", "Failure to sign updated ICF within two visits", |
|
| 79 | 3x |
- "Alive"+ "Site action due to epidemic/pandemic", "Y", |
|
| 80 | -+ | 3x |
- )+ "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 |
- cnsdtdscr_sel <- if (!is.null(censor_descr)) {
+ "Site action due to epidemic/pandemic", "Y" |
|
| 84 | -! | +
- censor_descr+ ) |
|
| 85 |
- } else {
+ } |
||
| 86 | -3x | +
- c(+ |
|
| 87 | -3x | +
- "Preferred Term",+ |
|
| 88 | 3x |
- "Clinical Cut Off",+ addv <- Map( |
|
| 89 | 3x |
- "Completion or Discontinuation",+ function(id, sid) {
|
|
| 90 | -3x | +30x |
- "End of AE Reporting Period"+ n_dv <- stats::rbinom(1, 1, p_dv) * sample(c(1, seq_len(max_n_dv)), 1) |
| 91 | -+ | 30x |
- )+ i <- sample(seq_len(nrow(lookup_dv)), n_dv, TRUE) |
| 92 | -+ | 30x |
- }+ dplyr::mutate( |
| 93 | -+ | 30x |
-
+ lookup_dv[i, ], |
| 94 | -3x | +30x |
- adtte <- split(adsl, adsl$USUBJID) %>%+ USUBJID = id, |
| 95 | -3x | +30x |
- lapply(FUN = function(pinfo) {
+ STUDYID = sid |
| 96 | -30x | +
- lookup_tte %>%+ ) |
|
| 97 | -30x | +
- dplyr::filter(ARM == as.character(pinfo$ACTARMCD)) %>%+ }, |
|
| 98 | -30x | +3x |
- dplyr::rowwise() %>%+ adsl$USUBJID, |
| 99 | -30x | +3x |
- dplyr::mutate(+ adsl$STUDYID |
| 100 | -30x | +
- STUDYID = pinfo$STUDYID,+ ) %>% |
|
| 101 | -30x | +3x |
- SITEID = pinfo$SITEID,+ Reduce(rbind, .) %>% |
| 102 | -30x | +3x |
- USUBJID = pinfo$USUBJID,+ dplyr::mutate(DVSCAT = DVCAT) |
| 103 | -30x | +
- AVALU = "DAYS"+ |
|
| 104 | -+ | 3x |
- ) %>%+ addv <- rcd_var_relabel( |
| 105 | -30x | +3x |
- dplyr::select(-"LAMBDA", -"CNSR_P")+ addv, |
| 106 | -+ | 3x |
- }) %>%+ STUDYID = "Study Identifier", |
| 107 | 3x |
- Reduce(rbind, .) %>%+ USUBJID = "Unique Subject Identifier" |
|
| 108 | -3x | +
- var_relabel(+ ) |
|
| 109 | -3x | +
- STUDYID = "Study Identifier",+ |
|
| 110 | -3x | +
- USUBJID = "Unique Subject Identifier" # )+ # merge ADSL to be able to add deviation date and study day variables |
|
| 111 | -+ | 3x |
- )+ addv <- dplyr::inner_join(addv, adsl, by = c("STUDYID", "USUBJID")) %>%
|
| 112 | -+ | 3x |
-
+ dplyr::rowwise() %>% |
| 113 | -+ | 3x |
- # Loop through each patient and randomly assign a value for EVNTDESC+ dplyr::mutate(TRTENDT = lubridate::date(dplyr::case_when( |
| 114 | 3x |
- adtte_split <- split(adtte, adtte$USUBJID)+ is.na(TRTEDTM) ~ lubridate::floor_date(lubridate::date(TRTSDTM) + study_duration_secs, unit = "day"), |
|
| 115 | -+ | 3x |
-
+ TRUE ~ TRTEDTM |
| 116 |
- # Add EVNTDESC column+ ))) %>% |
||
| 117 | 3x |
- adtte_lst <- lapply(adtte_split, function(split_df) {
+ dplyr::mutate(ASTDTM = sample( |
|
| 118 | -+ | 3x |
- # First create an empty EVNTDESC variable to populate+ seq(lubridate::as_datetime(TRTSDTM), lubridate::as_datetime(TRTENDT), by = "day"), |
| 119 | -30x | +3x |
- split_df$EVNTDESC <- NA+ size = 1 |
| 120 | -30x | +
- for (i in 1:nrow(split_df)) { # nolint
+ )) %>% |
|
| 121 | -+ | 3x |
- # If this is the first row then create a random value from evntdescr_sel for EVNTDESC+ dplyr::mutate(ASTDT = lubridate::date(ASTDTM)) %>% |
| 122 | -120x | +3x |
- if (i == 1) {
+ dplyr::mutate(ASTDY = ceiling(difftime(ASTDTM, TRTSDTM, units = "days"))) %>% |
| 123 | -30x | +3x |
- split_df$EVNTDESC[i] <- sample(evntdescr_sel[c(1:4)], 1, prob = c(0.1, 0.3, 0.4, 0.2))+ dplyr::select(-TRTENDT, -ASTDTM) %>% |
| 124 | -90x | +3x |
- } else if (i != 1 & i != nrow(split_df)) {
+ dplyr::ungroup() %>% |
| 125 | -+ | 3x |
- # First check to see if "Death" has been entered in as a previous value+ dplyr::arrange(STUDYID, USUBJID, ASTDT, DVTERM) |
| 126 |
- # If so we need to make the rest of the EVNTDESC values "Death" to make sense+ |
||
| 127 | -+ | 3x |
- # The patient cannot die and then come back to life+ addv <- addv %>% |
| 128 | -60x | +3x |
- if (any(grepl("Death", split_df$EVNTDESC))) { # If previous value has "Death" the following need to be "Death"
+ dplyr::group_by(USUBJID) %>% |
| 129 | -21x | +3x |
- split_df$EVNTDESC[i] <- "Death"+ dplyr::mutate(DVSEQ = seq_len(dplyr::n())) %>% |
| 130 | 3x |
- } else { # If there are no "Death" values randomly select another value
+ dplyr::ungroup() %>% |
|
| 131 | -39x | +3x |
- split_df$EVNTDESC[i] <- sample(evntdescr_sel[c(1:4)], 1)+ dplyr::arrange(STUDYID, USUBJID, ASTDT, DVTERM, DVSEQ) |
| 132 |
- }+ |
||
| 133 | 3x |
- } else { # This is for processing OS as this can only be "Death" or "Alive"
+ addv <- addv %>% |
|
| 134 | -30x | +3x |
- if (any(grepl("Death", split_df$EVNTDESC))) { # If previous value has "Death" the following need to be "Death"
+ dplyr::mutate(AEPRELFL = ifelse(DVEPRELI == "Y", DVEPRELI, "")) |
| 135 | -21x | +
- split_df$EVNTDESC[i] <- "Death"+ |
|
| 136 | 3x |
- } else { # If there are no "Death" values randomly select another value
+ if (length(na_vars) > 0 && na_percentage > 0) {
|
|
| 137 | -9x | +! |
- split_df$EVNTDESC[i] <- "Alive"+ addv <- mutate_na(ds = addv, na_vars = na_vars, na_percentage = na_percentage) |
| 138 |
- }+ } |
||
| 139 |
- }+ |
||
| 140 |
- }+ # apply metadata |
||
| 141 | -30x | +3x |
- split_df+ addv <- apply_metadata(addv, "metadata/ADDV.yml") |
| 142 |
- })+ |
||
| 143 | -+ | 3x |
-
+ return(addv) |
| 144 |
- # Add CNSR column- |
- ||
| 145 | -3x | -
- adtte_lst <- lapply(adtte_lst, function(split_df) {
+ } |
| 146 | +1 |
- # First create an empty CNSR variable to populate- |
- ||
| 147 | -30x | -
- split_df$CNSR <- NA- |
- ||
| 148 | -30x | -
- for (i in 1:nrow(split_df)) { # nolint
+ #' Pharmacokinetics Analysis Dataset (ADPC) |
||
| 149 | +2 |
- # If this is the first row then create a random value from evntdescr_sel for EVNTDESC- |
- ||
| 150 | -120x | -
- if (split_df$EVNTDESC[i] == "Death" | split_df$EVNTDESC[i] == "Disease Progression") {
+ #' |
||
| 151 | -81x | +|||
| 3 | +
- split_df$CNSR[i] <- 0+ #' @description `r lifecycle::badge("stable")`
|
|||
| 152 | +4 |
- } else {
+ #' |
||
| 153 | -39x | +|||
| 5 | +
- split_df$CNSR[i] <- 1+ #' Function for generating a random Pharmacokinetics Analysis Dataset for a given |
|||
| 154 | +6 |
- }+ #' Subject-Level Analysis Dataset. |
||
| 155 | +7 |
- }+ #' |
||
| 156 | -30x | +|||
| 8 | +
- split_df+ #' @details One record per study, subject, parameter, and time point. |
|||
| 157 | +9 |
- })+ #' |
||
| 158 | +10 |
-
+ #' @inheritParams argument_convention |
||
| 159 | +11 |
- # Add AVAL column+ #' @param avalu (`character`)\cr Analysis value units. |
||
| 160 | -3x | +|||
| 12 | +
- adtte_lst <- lapply(adtte_lst, function(split_df) {
+ #' @param constants (`character vector`)\cr Constant parameters to be used in formulas for creating analysis values. |
|||
| 161 | +13 |
- # First create an empty CNSR variable to populate+ #' @param duration (`numeric`)\cr Duration in number of days. |
||
| 162 | -30x | +|||
| 14 | +
- split_df$AVAL <- NA+ #' @template param_cached |
|||
| 163 | -30x | +|||
| 15 | +
- for (i in 1:nrow(split_df)) { # nolint
+ #' @templateVar data adpc |
|||
| 164 | -120x | +|||
| 16 | +
- if (i == 1) {
+ #' |
|||
| 165 | -30x | +|||
| 17 | +
- split_df$AVAL[i] <- stats::runif(1, 15, 100)+ #' @return `data.frame` |
|||
| 166 | -90x | +|||
| 18 | +
- } else if (i != 1 & any(grepl("Death", split_df[1:i - 1, "EVNTDESC"]))) {
+ #' @export |
|||
| 167 | +19 |
- # Check if there are any death values before the current row+ #' |
||
| 168 | +20 |
- # Set the AVAL to the value of the row that has the "Death" value+ #' @examples |
||
| 169 | +21 |
- # as the patient cannot live longer than this value+ #' adsl <- radsl(N = 10, seed = 1, study_duration = 2) |
||
| 170 | -42x | +|||
| 22 | +
- death_position <- match("Death", split_df[1:i - 1, "EVNTDESC"][[1]])
+ #' |
|||
| 171 | -42x | +|||
| 23 | +
- split_df$AVAL[i] <- split_df$AVAL[death_position]+ #' adpc <- radpc(adsl, seed = 2) |
|||
| 172 | -48x | +|||
| 24 | +
- } else if (i == 2) {
+ #' adpc |
|||
| 173 | -24x | +|||
| 25 | +
- split_df$AVAL[i] <- stats::runif(1, 100, 200)+ #' |
|||
| 174 | -24x | +|||
| 26 | +
- } else if (i == 3) {
+ #' adpc <- radpc(adsl, seed = 2, duration = 3) |
|||
| 175 | -15x | +|||
| 27 | +
- split_df$AVAL[i] <- stats::runif(1, 200, 300)+ #' adpc |
|||
| 176 | -9x | +|||
| 28 | +
- } else if (i == 4) {
+ radpc <- function(adsl, |
|||
| 177 | -9x | +|||
| 29 | +
- split_df$AVAL[i] <- stats::runif(1, 300, 500)+ avalu = "ug/mL", |
|||
| 178 | +30 |
- }+ constants = c(D = 100, ka = 0.8, ke = 1), |
||
| 179 | +31 |
- }+ duration = 2, |
||
| 180 | -30x | +|||
| 32 | +
- split_df+ seed = NULL, |
|||
| 181 | +33 |
- })+ na_percentage = 0, |
||
| 182 | +34 |
-
+ na_vars = list( |
||
| 183 | +35 |
- # Add CNSDTDSC column+ AVAL = c(NA, 0.1) |
||
| 184 | -3x | +|||
| 36 | +
- adtte_lst <- lapply(adtte_lst, function(split_df) {
+ ), |
|||
| 185 | +37 |
- # First create an empty CNSDTDSC variable to populate+ cached = FALSE) {
|
||
| 186 | -30x | +38 | +5x |
- split_df$CNSDTDSC <- NA+ checkmate::assert_flag(cached) |
| 187 | -30x | +39 | +5x |
- for (i in 1:nrow(split_df)) { # nolint
+ if (cached) {
|
| 188 | -120x | +40 | +1x |
- if (split_df$CNSR[i] == 1 & split_df$EVNTDESC[i] == "Last Tumor Assessment") {
+ return(get_cached_data("cadpc"))
|
| 189 | -27x | +|||
| 41 | +
- split_df$CNSDTDSC[i] <- "Completion or Discontinuation"+ } |
|||
| 190 | -93x | +|||
| 42 | +
- } else if (split_df$CNSR[i] == 1 & split_df$EVNTDESC[i] == "Adverse Event") {
+
|
|||
| 191 | -3x | +43 | +4x |
- split_df$CNSDTDSC[i] <- "Preferred Term"+ checkmate::assert_data_frame(adsl) |
| 192 | -90x | +44 | +4x |
- } else if (split_df$CNSR[i] == 1 & split_df$EVNTDESC[i] == "Alive") {
+ checkmate::assert_character(avalu, len = 1, any.missing = FALSE) |
| 193 | -9x | -
- split_df$CNSDTDSC[i] <- "Alive During Study"- |
- ||
| 194 | -+ | 45 | +4x |
- } else {
+ checkmate::assert_subset(names(constants), c("D", "ka", "ke"))
|
| 195 | -81x | +46 | +4x |
- split_df$CNSDTDSC[i] <- ""+ checkmate::assert_numeric(x = duration, max.len = 1) |
| 196 | -+ | |||
| 47 | +4x |
- }+ checkmate::assert_number(seed, null.ok = TRUE) |
||
| 197 | -+ | |||
| 48 | +4x |
- }+ checkmate::assert_number(na_percentage, lower = 0, upper = 1) |
||
| 198 | -30x | +49 | +4x |
- split_df+ checkmate::assert_true(na_percentage < 1) |
| 199 | -+ | |||
| 50 | +4x |
- })+ checkmate::assert_list(na_vars) |
||
| 200 | +51 | |||
| 201 | -- |
- # Take the split df and combine them back together- |
- ||
| 202 | -3x | +52 | +4x |
- adtte <- do.call("rbind", adtte_lst)
+ if (!is.null(seed)) {
|
| 203 | -3x | +53 | +4x |
- rownames(adtte) <- NULL+ set.seed(seed) |
| 204 | +54 | - - | -||
| 205 | -3x | -
- adtte <- var_relabel(- |
- ||
| 206 | -3x | -
- adtte,+ } |
||
| 207 | -3x | +|||
| 55 | +
- STUDYID = "Study Identifier",+ |
|||
| 208 | -3x | -
- USUBJID = "Unique Subject Identifier"- |
- ||
| 209 | -+ | 56 | +4x |
- )+ radpc_core <- function(day) {
|
| 210 | -+ | |||
| 57 | +8x |
-
+ adpc_day <- tidyr::expand_grid( |
||
| 211 | -+ | |||
| 58 | +8x |
- # merge ADSL to be able to add TTE date and study day variables+ data.frame( |
||
| 212 | -3x | +59 | +8x |
- adtte <- dplyr::inner_join(+ STUDYID = adsl$STUDYID, |
| 213 | -3x | +60 | +8x |
- dplyr::select(adtte, -"SITEID", -"ARM"),+ USUBJID = adsl$USUBJID, |
| 214 | -3x | +61 | +8x |
- adsl,+ ARMCD = adsl$ARMCD, |
| 215 | -3x | +62 | +8x |
- by = c("STUDYID", "USUBJID")
+ A0 = unname(constants["D"]), |
| 216 | -+ | |||
| 63 | +8x |
- ) %>%+ ka = unname(constants["ka"]) - stats::runif(length(adsl$USUBJID), -0.2, 0.2), |
||
| 217 | -3x | +64 | +8x |
- dplyr::rowwise() %>%+ ke = unname(constants["ke"]) - stats::runif(length(adsl$USUBJID), -0.2, 0.2) |
| 218 | -3x | +|||
| 65 | +
- dplyr::mutate(TRTENDT = lubridate::date(dplyr::case_when(+ ), |
|||
| 219 | -3x | +66 | +8x |
- is.na(TRTEDTM) ~ lubridate::floor_date(lubridate::date(TRTSDTM) + study_duration_secs, unit = "day"),+ PCTPTNUM = if (day == 1) c(0, 0.5, 1, 1.5, 2, 3, 4, 8, 12) else 24 * (day - 1), |
| 220 | -3x | +67 | +8x |
- TRUE ~ TRTEDTM+ PARAM = factor(c("Plasma Drug X", "Urine Drug X", "Plasma Drug Y", "Urine Drug Y"))
|
| 221 | +68 |
- ))) %>%+ ) |
||
| 222 | -3x | +69 | +8x |
- dplyr::mutate(ADTM = sample(+ adpc_day <- adpc_day[!(grepl("Urine", adpc_day$PARAM) & adpc_day$PCTPTNUM %in% c(0.5, 1, 1.5, 2, 3)), ] %>%
|
| 223 | -3x | +70 | +8x |
- seq(lubridate::as_datetime(TRTSDTM), lubridate::as_datetime(TRTENDT), by = "day"),+ dplyr::arrange(USUBJID, PARAM) %>% |
| 224 | -3x | +71 | +8x |
- size = 1+ dplyr::mutate( |
| 225 | -+ | |||
| 72 | +8x |
- )) %>%+ VISITDY = day, |
||
| 226 | -3x | +73 | +8x |
- dplyr::mutate(ADY = ceiling(difftime(ADTM, TRTSDTM, units = "days"))) %>%+ VISIT = ifelse(day <= 7, paste("Day", VISITDY), paste("Week", (VISITDY - 1) / 7)),
|
| 227 | -3x | +74 | +8x |
- dplyr::select(-TRTENDT) %>%+ PCVOLU = ifelse(grepl("Urine", PARAM), "mL", ""),
|
| 228 | -3x | +75 | +8x |
- dplyr::ungroup() %>%+ ASMED = ifelse(grepl("Urine", PARAM), "URINE", "PLASMA"),
|
| 229 | -3x | +76 | +8x |
- dplyr::arrange(STUDYID, USUBJID, ADTM)+ PCTPT = factor(dplyr::case_when( |
| 230 | -+ | |||
| 77 | +8x |
-
+ PCTPTNUM == 0 ~ "Predose", |
||
| 231 | -3x | +78 | +8x |
- adtte <- adtte %>%+ (day == 1 & grepl("Urine", PARAM)) ~
|
| 232 | -3x | +79 | +8x |
- dplyr::group_by(USUBJID) %>%+ paste0(lag(PCTPTNUM), "H - ", PCTPTNUM, "H"), |
| 233 | -3x | +80 | +8x |
- dplyr::mutate(TTESEQ = seq_len(dplyr::n())) %>%+ (day != 1 & grepl("Urine", PARAM)) ~
|
| 234 | -3x | +81 | +8x |
- dplyr::mutate(ASEQ = TTESEQ) %>%+ paste0(as.numeric(PCTPTNUM) - 24, "H - ", PCTPTNUM, "H"), |
| 235 | -3x | +82 | +8x |
- dplyr::mutate(PARAM = as.factor(PARAM)) %>%+ TRUE ~ paste0(PCTPTNUM, "H") |
| 236 | -3x | +|||
| 83 | +
- dplyr::mutate(PARAMCD = as.factor(PARAMCD)) %>%+ )), |
|||
| 237 | -3x | +84 | +8x |
- dplyr::ungroup() %>%+ ARELTM1 = PCTPTNUM, |
| 238 | -3x | +85 | +8x |
- dplyr::arrange(+ NRELTM1 = PCTPTNUM, |
| 239 | -3x | +86 | +8x |
- STUDYID,+ ARELTM2 = ARELTM1 - (24 * (day - 1)), |
| 240 | -3x | +87 | +8x |
- USUBJID,+ NRELTM2 = NRELTM1 - (24 * (day - 1)), |
| 241 | -3x | +88 | +8x |
- PARAMCD,+ A0 = ifelse(PARAM == "Plasma Drug Y", A0, A0 / 2), |
| 242 | -3x | +89 | +8x |
- ADTM,+ AVAL = round( |
| 243 | -3x | +90 | +8x |
- TTESEQ+ (A0 * ka * ( |
| 244 | -+ | |||
| 91 | +8x |
- )+ exp(-ka * ARELTM1) - exp(-ke * ARELTM1) |
||
| 245 | +92 |
-
+ )) |
||
| 246 | -3x | +93 | +8x |
- mod_before_adtte <- adtte+ / (ke - ka), |
| 247 | -+ | |||
| 94 | +8x |
-
+ digits = 3 |
||
| 248 | +95 |
- # adding adverse event counts and log follow-up time+ ) |
||
| 249 | -3x | +|||
| 96 | +
- adtte <- dplyr::bind_rows(+ ) %>% |
|||
| 250 | -3x | +97 | +8x |
- adtte,+ dplyr::mutate( |
| 251 | -3x | +98 | +8x |
- data.frame(+ PCVOL = ifelse( |
| 252 | -3x | +99 | +8x |
- adtte %>%+ ASMED == "URINE", |
| 253 | -3x | +100 | +8x |
- dplyr::group_by(USUBJID) %>%+ round(abs(((PCTPTNUM - 1) %% 24) * A0 * ka * exp(PCTPTNUM %% 1.8 / 10)), 2), |
| 254 | -3x | +101 | +8x |
- dplyr::slice_head(n = 1) %>%+ NA |
| 255 | -3x | +|||
| 102 | +
- dplyr::mutate(+ ), |
|||
| 256 | -3x | +|||
| 103 | +
- PARAMCD = "TNE",+ # PK Equation |
|||
| 257 | -3x | +104 | +8x |
- PARAM = "Total Number of Exacerbations",+ AVALC = ifelse(AVAL == 0, "BLQ", as.character(AVAL)), |
| 258 | -3x | +105 | +8x |
- AVAL = stats::rpois(1, 3),+ AVALU = avalu, |
| 259 | -3x | +106 | +8x |
- AVALU = "COUNT",+ RELTMU = "hr" |
| 260 | -3x | +|||
| 107 | +
- lgTMATRSK = log(stats::rexp(1, rate = 3)),+ ) %>% |
|||
| 261 | -3x | +108 | +8x |
- dplyr::across(+ dplyr::select(-c("A0", "ka", "ke"))
|
| 262 | -3x | +|||
| 109 | +
- c("ASEQ", "TTESEQ", "ADY", "ADTM", "EVNTDESC"),
+
|
|||
| 263 | -3x | +110 | +8x |
- ~NA+ return(adpc_day) |
| 264 | +111 |
- )+ } |
||
| 265 | +112 |
- )+ |
||
| 266 | -+ | |||
| 113 | +4x |
- )+ adpc <- list() |
||
| 267 | +114 |
- ) %>%- |
- ||
| 268 | -3x | -
- dplyr::arrange(+ |
||
| 269 | -3x | +115 | +4x |
- STUDYID,+ for (day in seq(duration)[seq(duration) <= 7 | ((seq(duration) - 1) %% 7 == 0)]) {
|
| 270 | -3x | +116 | +8x |
- USUBJID,+ adpc[[day]] <- radpc_core(day = day) |
| 271 | -3x | +|||
| 117 | +
- PARAMCD,+ } |
|||
| 272 | -3x | +|||
| 118 | +
- ADTM,+ |
|||
| 273 | -3x | +119 | +4x |
- TTESEQ+ adpc <- do.call(rbind, adpc) |
| 274 | +120 |
- )+ |
||
| 275 | -+ | |||
| 121 | +4x |
-
+ adpc <- dplyr::inner_join(adpc, adsl, by = c("STUDYID", "USUBJID", "ARMCD")) %>%
|
||
| 276 | -3x | +122 | +4x |
- mod_after_adtte <- adtte+ dplyr::filter(ACTARM != "B: Placebo", !(ACTARM == "A: Drug X" & PARAM == "Plasma Drug Y")) |
| 277 | +123 | |||
| 278 | -3x | +124 | +4x |
if (length(na_vars) > 0 && na_percentage > 0) {
|
| 279 | +125 | ! |
- adtte <- mutate_na(ds = adtte, na_vars = na_vars, na_percentage = na_percentage)+ adpc <- mutate_na(ds = adpc, na_vars = na_vars, na_percentage = na_percentage) |
|
| 280 | +126 |
} |
||
| 281 | +127 | |||
| 128 | +4x | +
+ adpc <- adpc %>%+ |
+ ||
| 129 | +4x | +
+ rename(+ |
+ ||
| 130 | +4x | +
+ AVALCAT1 = AVALC,+ |
+ ||
| 131 | +4x | +
+ NFRLT = NRELTM1,+ |
+ ||
| 132 | +4x | +
+ AFRLT = ARELTM1,+ |
+ ||
| 133 | +4x | +
+ NRRLT = NRELTM2,+ |
+ ||
| 134 | +4x | +
+ ARRLT = ARELTM2+ |
+ ||
| 282 | +135 |
- # apply metadata+ ) %>% |
||
| 283 | -3x | +136 | +4x |
- adtte <- apply_metadata(adtte, "metadata/ADTTE.yml")+ mutate(ANL02FL = "Y") |
| 284 | +137 | |||
| 285 | -3x | +138 | +4x |
- return(adtte)+ adpc <- apply_metadata(adpc, "metadata/ADPC.yml") |
| 286 | +139 |
}@@ -35621,14 +35571,14 @@ random.cdisc.data coverage - 98.86% |
| 1 |
- #' Subject-Level Analysis Dataset (ADSL)+ #' Questionnaires Analysis Dataset (ADQS) |
|||
| 5 |
- #' The Subject-Level Analysis Dataset (ADSL) is used to provide the variables+ #' Function for generating a random Questionnaires 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 One record per subject per parameter per analysis visit per analysis date. |
|||
| 9 |
- #' metadata are required in a CDISC-based submission of data from a clinical+ #' |
|||
| 10 |
- #' trial even if no other analysis data sets are submitted.+ #' Keys: `STUDYID`, `USUBJID`, `PARAMCD`, `AVISITN` |
|||
| 12 |
- #' @details One record per subject.+ #' @inheritParams argument_convention |
|||
| 13 |
- #'+ #' @template param_cached |
|||
| 14 |
- #' Keys: `STUDYID`, `USUBJID`+ #' @templateVar data adqs |
|||
| 16 |
- #' @inheritParams argument_convention+ #' @return `data.frame` |
|||
| 17 |
- #' @param N (`numeric`)\cr Number of patients.+ #' @export |
|||
| 18 |
- #' @param study_duration (`numeric`)\cr Duration of study in years.+ #' |
|||
| 19 |
- #' @param with_trt02 (`logical`)\cr Should period 2 be added.+ #' @author npaszty |
|||
| 20 |
- #' @param ae_withdrawal_prob (`proportion`)\cr Probability that there is at least one+ #' |
|||
| 21 |
- #' Adverse Event leading to the withdrawal of a study drug.+ #' @examples |
|||
| 22 |
- #' @template param_cached+ #' adsl <- radsl(N = 10, seed = 1, study_duration = 2) |
|||
| 23 |
- #' @templateVar data adsl+ #' |
|||
| 24 |
- #'+ #' adqs <- radqs(adsl, visit_format = "WEEK", n_assessments = 7L, seed = 2) |
|||
| 25 |
- #' @return `data.frame`+ #' adqs |
|||
| 26 |
- #' @export+ #' |
|||
| 27 |
- #+ #' adqs <- radqs(adsl, visit_format = "CYCLE", n_assessments = 3L, seed = 2) |
|||
| 28 |
- #' @examples+ #' adqs |
|||
| 29 |
- #' adsl <- radsl(N = 10, study_duration = 2, seed = 1)+ radqs <- function(adsl, |
|||
| 30 |
- #' adsl+ param = c( |
|||
| 31 |
- #'+ "BFI All Questions", |
|||
| 32 |
- #' adsl <- radsl(+ "Fatigue Interference", |
|||
| 33 |
- #' N = 10, seed = 1,+ "Function/Well-Being (GF1,GF3,GF7)", |
|||
| 34 |
- #' na_percentage = 0.1,+ "Treatment Side Effects (GP2,C5,GP5)", |
|||
| 35 |
- #' na_vars = list(+ "FKSI-19 All Questions" |
|||
| 36 |
- #' DTHDT = c(seed = 1234, percentage = 0.1),+ ), |
|||
| 37 |
- #' LSTALVDT = c(seed = 1234, percentage = 0.1)+ paramcd = c("BFIALL", "FATIGI", "FKSI-FWB", "FKSI-TSE", "FKSIALL"),
|
|||
| 38 |
- #' )+ visit_format = "WEEK", |
|||
| 39 |
- #' )+ n_assessments = 5L, |
|||
| 40 |
- #' adsl+ n_days = 5L, |
|||
| 41 |
- #'+ seed = NULL, |
|||
| 42 |
- #' adsl <- radsl(N = 10, seed = 1, na_percentage = .1)+ na_percentage = 0, |
|||
| 43 |
- #' adsl+ na_vars = list( |
|||
| 44 |
- radsl <- function(N = 400, # nolint+ LOQFL = c(NA, 0.1), ABLFL2 = c(1234, 0.1), ABLFL = c(1235, 0.1), |
|||
| 45 |
- study_duration = 2,+ CHG2 = c(1235, 0.1), PCHG2 = c(1235, 0.1), CHG = c(1234, 0.1), PCHG = c(1234, 0.1) |
|||
| 46 |
- seed = NULL,+ ), |
|||
| 47 |
- with_trt02 = TRUE,+ cached = FALSE) {
|
|||
| 48 | -+ | 4x |
- na_percentage = 0,+ checkmate::assert_flag(cached) |
|
| 49 | -+ | 4x |
- na_vars = list(+ if (cached) {
|
|
| 50 | -+ | 1x |
- "AGE" = NA, "SEX" = NA, "RACE" = NA, "STRATA1" = NA, "STRATA2" = NA,+ return(get_cached_data("cadqs"))
|
|
| 51 |
- "BMRKR1" = c(seed = 1234, percentage = 0.1), "BMRKR2" = c(1234, 0.1), "BEP01FL" = NA+ } |
|||
| 52 |
- ),+ |
|||
| 53 | -+ | 3x |
- ae_withdrawal_prob = 0.05,+ checkmate::assert_data_frame(adsl) |
|
| 54 | -+ | 3x |
- cached = FALSE) {
+ checkmate::assert_character(param, min.len = 1, any.missing = FALSE) |
|
| 55 | -28x | +3x |
- checkmate::assert_flag(cached)+ checkmate::assert_character(paramcd, min.len = 1, any.missing = FALSE) |
|
| 56 | -28x | +3x |
- if (cached) {
+ checkmate::assert_string(visit_format) |
|
| 57 | -2x | +3x |
- return(get_cached_data("cadsl"))
+ checkmate::assert_integer(n_assessments, len = 1, any.missing = FALSE) |
|
| 58 | -+ | 3x |
- }+ checkmate::assert_integer(n_days, len = 1, any.missing = FALSE) |
|
| 59 | -+ | 3x |
-
+ checkmate::assert_number(seed, null.ok = TRUE) |
|
| 60 | -26x | +3x |
- checkmate::assert_number(N)+ checkmate::assert_number(na_percentage, lower = 0, upper = 1) |
|
| 61 | -26x | +3x |
- checkmate::assert_number(seed, null.ok = TRUE)+ checkmate::assert_true(na_percentage < 1) |
|
| 62 | -26x | +
- checkmate::assert_number(na_percentage, lower = 0, upper = 1, na.ok = TRUE)+ |
||
| 63 | -26x | +
- checkmate::assert_number(study_duration, lower = 1)+ # validate and initialize param vectors |
||
| 64 | -26x | -
- checkmate::assert_number(na_percentage, lower = 0, upper = 1)- |
- ||
| 65 | -26x | +3x |
- checkmate::assert_true(na_percentage < 1)+ param_init_list <- relvar_init(param, paramcd) |
|
| 66 | +65 | |||
| 67 | -26x | +66 | +3x |
if (!is.null(seed)) {
|
| 68 | -26x | +67 | +3x |
set.seed(seed) |
| 69 | +68 |
} |
||
| 69 | +3x | +
+ study_duration_secs <- lubridate::seconds(attr(adsl, "study_duration_secs"))+ |
+ ||
| 70 | @@ -36116,380 +36066,380 @@ | |||
| 71 | -26x | +3x |
- study_duration_secs <- lubridate::seconds(lubridate::years(study_duration))+ adqs <- expand.grid( |
|
| 72 | -26x | +3x |
- sys_dtm <- lubridate::fast_strptime("20/2/2019 11:16:16.683", "%d/%m/%Y %H:%M:%OS")
+ STUDYID = unique(adsl$STUDYID), |
|
| 73 | -26x | +3x |
- discons <- max(1, floor((N * .3)))+ USUBJID = adsl$USUBJID, |
|
| 74 | -26x | +3x |
- country_site_prob <- c(.5, .121, .077, .077, .075, .052, .046, .025, .014, .003)+ PARAM = param_init_list$relvar1, |
|
| 75 | -+ | 3x |
-
+ AVISIT = visit_schedule(visit_format = visit_format, n_assessments = n_assessments, n_days = n_days), |
|
| 76 | -26x | +3x |
- adsl <- tibble::tibble(+ stringsAsFactors = FALSE |
|
| 77 | -26x | +
- STUDYID = rep("AB12345", N),
+ ) |
||
| 78 | -26x | +
- COUNTRY = sample_fct(+ |
||
| 79 | -26x | +3x |
- c("CHN", "USA", "BRA", "PAK", "NGA", "RUS", "JPN", "GBR", "CAN", "CHE"),
+ adqs <- dplyr::mutate( |
|
| 80 | -26x | +3x |
- N,+ adqs, |
|
| 81 | -26x | +3x |
- prob = country_site_prob+ AVISITN = dplyr::case_when( |
|
| 82 | -+ | 3x |
- ),+ AVISIT == "SCREENING" ~ -1, |
|
| 83 | -26x | +3x |
- SITEID = sample_fct(1:20, N, prob = rep(country_site_prob, times = 2)),+ AVISIT == "BASELINE" ~ 0, |
|
| 84 | -26x | +3x |
- SUBJID = paste("id", seq_len(N), sep = "-"),
+ (grepl("^WEEK", AVISIT) | grepl("^CYCLE", AVISIT)) ~ as.numeric(AVISIT) - 2,
|
|
| 85 | -26x | +3x |
- AGE = sapply(stats::rchisq(N, df = 5, ncp = 10), max, 0) + 20,+ TRUE ~ NA_real_ |
|
| 86 | -26x | +
- AGEU = "YEARS",+ ) |
||
| 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),
+
|
||
| 89 | -26x | +
- RACE = c(+ # assign related variable values: PARAMxPARAMCD are related |
||
| 90 | -26x | +3x |
- "ASIAN", "BLACK OR AFRICAN AMERICAN", "WHITE", "AMERICAN INDIAN OR ALASKA NATIVE",+ adqs <- adqs %>% rel_var( |
|
| 91 | -26x | +3x |
- "MULTIPLE", "NATIVE HAWAIIAN OR OTHER PACIFIC ISLANDER", "OTHER", "UNKNOWN"+ var_name = "PARAMCD", |
|
| 92 | -+ | 3x |
- ) %>%+ related_var = "PARAM", |
|
| 93 | -26x | +3x |
- sample_fct(N, prob = c(.55, .23, .16, .05, .004, .003, .002, .002)),+ var_values = param_init_list$relvar2 |
|
| 94 | -26x | +
- TRTSDTM = sys_dtm + sample(seq(0, study_duration_secs), size = N, replace = TRUE),+ ) |
||
| 95 | -26x | +
- RANDDT = lubridate::date(TRTSDTM - lubridate::days(floor(stats::runif(N, min = 0, max = 5)))),+ |
||
| 96 | -26x | +3x |
- TRTEDTM = TRTSDTM + study_duration_secs,+ adqs$AVAL <- stats::rnorm(nrow(adqs), mean = 50, sd = 8) + adqs$AVISITN * stats::rnorm(nrow(adqs), mean = 5, sd = 2) |
|
| 97 | -26x | +
- STRATA1 = c("A", "B", "C") %>% sample_fct(N),
+
|
||
| 98 | -26x | +
- STRATA2 = c("S1", "S2") %>% sample_fct(N),
+ # order to prepare for change from screening and baseline values |
||
| 99 | -26x | +3x |
- BMRKR1 = stats::rchisq(N, 6),+ adqs <- adqs[order(adqs$STUDYID, adqs$USUBJID, adqs$PARAMCD, adqs$AVISITN), ] |
|
| 100 | -26x | +
- BMRKR2 = sample_fct(c("LOW", "MEDIUM", "HIGH"), N),
+
|
||
| 101 | -26x | +3x |
- BMEASIFL = sample_fct(c("Y", "N"), N),
+ adqs <- Reduce( |
|
| 102 | -26x | +3x |
- BEP01FL = sample_fct(c("Y", "N"), N),
+ rbind, |
|
| 103 | -26x | +3x |
- AEWITHFL = sample_fct(c("Y", "N"), N, prob = c(ae_withdrawal_prob, 1 - ae_withdrawal_prob))
+ lapply( |
|
| 104 | -+ | 3x |
- ) %>%+ split(adqs, adqs$USUBJID), |
|
| 105 | -26x | +3x |
- dplyr::mutate(ARM = dplyr::recode(+ function(x) {
|
|
| 106 | -26x | +30x |
- ARMCD,+ x$STUDYID <- adsl$STUDYID[which(adsl$USUBJID == x$USUBJID[1])] |
|
| 107 | -26x | +30x |
- "ARM A" = "A: Drug X", "ARM B" = "B: Placebo", "ARM C" = "C: Combination"+ x$ABLFL2 <- ifelse(x$AVISIT == "SCREENING", "Y", "") |
|
| 108 | -+ | 30x |
- )) %>%+ x$ABLFL <- ifelse( |
|
| 109 | -26x | +30x |
- dplyr::mutate(ACTARM = ARM) %>%+ toupper(visit_format) == "WEEK" & x$AVISIT == "BASELINE", |
|
| 110 | -26x | +30x |
- dplyr::mutate(ACTARMCD = ARMCD) %>%+ "Y", |
|
| 111 | -26x | +30x |
- dplyr::mutate(TRT01P = ARM) %>%+ ifelse( |
|
| 112 | -26x | +30x |
- dplyr::mutate(TRT01A = ACTARM) %>%+ toupper(visit_format) == "CYCLE" & x$AVISIT == "CYCLE 1 DAY 1", |
|
| 113 | -26x | +30x |
- dplyr::mutate(ITTFL = factor("Y")) %>%
+ "Y", |
|
| 114 | -26x | +
- dplyr::mutate(SAFFL = factor("Y")) %>%
+ "" |
||
| 115 | -26x | +
- dplyr::arrange(TRTSDTM)+ ) |
||
| 116 |
-
+ ) |
|||
| 117 | -26x | +30x |
- adds <- adsl[sample(nrow(adsl), discons), ] %>%+ x$LOQFL <- ifelse(x$AVAL < 32, "Y", "N") |
|
| 118 | -26x | +30x |
- dplyr::mutate(TRTEDTM_discon = sample(+ x |
|
| 119 | -26x | +
- seq(from = max(TRTSDTM), to = sys_dtm + study_duration_secs, by = 1),+ } |
||
| 120 | -26x | +
- size = discons,+ ) |
||
| 121 | -26x | +
- replace = TRUE+ ) |
||
| 122 |
- )) %>%+ |
|||
| 123 | -26x | +3x |
- dplyr::select(SUBJID, TRTSDTM, TRTEDTM_discon) %>%+ adqs$BASE2 <- retain(adqs, adqs$AVAL, adqs$ABLFL2 == "Y") |
|
| 124 | -26x | +3x |
- dplyr::arrange(TRTSDTM)+ adqs$BASE <- ifelse(adqs$ABLFL2 != "Y", retain(adqs, adqs$AVAL, adqs$ABLFL == "Y"), NA) |
|
| 126 | -26x | +3x |
- adsl <- dplyr::left_join(adsl, adds, by = c("SUBJID", "TRTSDTM")) %>%
+ adqs <- adqs %>% |
|
| 127 | -26x | +3x |
- dplyr::mutate(TRTEDTM = dplyr::case_when(+ dplyr::mutate(CHG2 = AVAL - BASE2) %>% |
|
| 128 | -26x | +3x |
- !is.na(TRTEDTM_discon) ~ TRTEDTM_discon,+ dplyr::mutate(PCHG2 = 100 * (CHG2 / BASE2)) %>% |
|
| 129 | -26x | +3x |
- TRTSDTM >= quantile(TRTSDTM)[2] & TRTSDTM <= quantile(TRTSDTM)[3] ~ lubridate::as_datetime(NA),+ dplyr::mutate(CHG = AVAL - BASE) %>% |
|
| 130 | -26x | +3x |
- TRUE ~ TRTEDTM+ dplyr::mutate(PCHG = 100 * (CHG / BASE)) %>% |
|
| 131 | -+ | 3x |
- )) %>%+ rcd_var_relabel( |
|
| 132 | -26x | +3x |
- dplyr::select(-"TRTEDTM_discon")+ STUDYID = attr(adsl$STUDYID, "label"), |
|
| 133 | -+ | 3x |
-
+ USUBJID = attr(adsl$USUBJID, "label") |
|
| 134 |
- # add period 2 if needed+ ) |
|||
| 135 | -26x | +
- if (with_trt02) {
+
|
||
| 136 | -26x | +3x |
- with_trt02 <- lubridate::seconds(lubridate::years(1))+ adqs <- rcd_var_relabel( |
|
| 137 | -26x | +3x |
- adsl <- adsl %>%+ adqs, |
|
| 138 | -26x | +3x |
- dplyr::mutate(TRT02P = sample(ARM)) %>%+ STUDYID = "Study Identifier", |
|
| 139 | -26x | +3x |
- dplyr::mutate(TRT02A = sample(ACTARM)) %>%+ USUBJID = "Unique Subject Identifier" |
|
| 140 | -26x | +
- dplyr::mutate(+ ) |
||
| 141 | -26x | +
- TRT01SDTM = TRTSDTM,+ |
||
| 142 | -26x | +
- AP01SDTM = TRT01SDTM,+ # merge ADSL to be able to add QS date and study day variables |
||
| 143 | -26x | +3x |
- TRT01EDTM = TRTEDTM,+ adqs <- dplyr::inner_join( |
|
| 144 | -26x | +3x |
- AP01EDTM = TRT01EDTM,+ adqs, |
|
| 145 | -26x | +3x |
- TRT02SDTM = TRTEDTM,+ adsl, |
|
| 146 | -26x | +3x |
- AP02SDTM = TRT02SDTM,+ by = c("STUDYID", "USUBJID")
|
|
| 147 | -26x | +
- TRT02EDTM = TRT01EDTM + with_trt02,+ ) %>% |
||
| 148 | -26x | +3x |
- AP02EDTM = TRT02EDTM,+ dplyr::rowwise() %>% |
|
| 149 | -26x | +3x |
- TRTEDTM = TRT02EDTM+ dplyr::mutate(TRTENDT = lubridate::date(dplyr::case_when( |
|
| 150 | -+ | 3x |
- )+ is.na(TRTEDTM) ~ lubridate::floor_date(lubridate::date(TRTSDTM) + study_duration_secs, unit = "day"), |
|
| 151 | -+ | 3x |
- }+ TRUE ~ TRTEDTM |
|
| 152 |
-
+ ))) %>% |
|||
| 153 | -26x | +3x |
- adsl <- adsl %>%+ ungroup() |
|
| 154 | -26x | +
- dplyr::mutate(EOSDT = lubridate::date(TRTEDTM)) %>%+ |
||
| 155 | -26x | +3x |
- dplyr::mutate(EOSDY = ceiling(difftime(TRTEDTM, TRTSDTM))) %>%+ adqs <- adqs %>% |
|
| 156 | -26x | +3x |
- dplyr::mutate(EOSSTT = dplyr::case_when(+ group_by(USUBJID) %>% |
|
| 157 | -26x | +3x |
- EOSDY == max(EOSDY, na.rm = TRUE) ~ "COMPLETED",+ arrange(USUBJID, AVISITN) %>% |
|
| 158 | -26x | +3x |
- EOSDY < max(EOSDY, na.rm = TRUE) ~ "DISCONTINUED",+ dplyr::mutate(ADTM = rep( |
|
| 159 | -26x | +3x |
- is.na(TRTEDTM) ~ "ONGOING"+ sort(sample( |
|
| 160 | -+ | 3x |
- )) %>%+ seq(lubridate::as_datetime(TRTSDTM[1]), lubridate::as_datetime(TRTENDT[1]), by = "day"), |
|
| 161 | -26x | +3x |
- dplyr::mutate(EOTSTT = EOSSTT)+ size = nlevels(AVISIT) |
|
| 162 |
-
+ )), |
|||
| 163 | -+ | 3x |
- # disposition related variables+ each = n() / nlevels(AVISIT) |
|
| 164 |
- # using probability of 1 for the "DEATH" level to ensure at least one death record exists+ )) %>% |
|||
| 165 | -26x | +3x |
- l_dcsreas <- list(+ dplyr::ungroup() %>% |
|
| 166 | -26x | +3x |
- choices = c(+ dplyr::mutate(ADY = ceiling(difftime(ADTM, TRTSDTM, units = "days"))) %>% |
|
| 167 | -26x | +3x |
- "ADVERSE EVENT", "DEATH", "LACK OF EFFICACY", "PHYSICIAN DECISION",+ dplyr::select(-TRTENDT) %>% |
|
| 168 | -26x | +3x |
- "PROTOCOL VIOLATION", "WITHDRAWAL BY PARENT/GUARDIAN", "WITHDRAWAL BY SUBJECT"+ dplyr::arrange(STUDYID, USUBJID, ADTM) |
|
| 169 |
- ),+ |
|||
| 170 | -26x | +3x |
- prob = c(.2, 1, .1, .1, .2, .1, .1)+ adqs <- adqs %>% |
|
| 171 | -+ | 3x |
- )+ dplyr::group_by(USUBJID) %>% |
|
| 172 | -26x | +3x |
- l_dthcat_other <- list(+ dplyr::mutate(QSSEQ = seq_len(dplyr::n())) %>% |
|
| 173 | -26x | +3x |
- choices = c(+ dplyr::mutate(ASEQ = QSSEQ) %>% |
|
| 174 | -26x | +3x |
- "Post-study reporting of death", "LOST TO FOLLOW UP", "MISSING", "SUICIDE", "UNKNOWN"+ dplyr::ungroup() %>% |
|
| 175 | -+ | 3x |
- ),+ dplyr::arrange( |
|
| 176 | -26x | +3x |
- prob = c(.1, .3, .3, .2, .1)+ STUDYID, |
|
| 177 | -+ | 3x |
- )+ USUBJID, |
|
| 178 | -+ | 3x |
-
+ PARAMCD, |
|
| 179 | -26x | +3x |
- adsl <- adsl %>%+ AVISITN, |
|
| 180 | -26x | +3x |
- dplyr::mutate(+ ADTM, |
|
| 181 | -26x | +3x |
- DCSREAS = ifelse(+ QSSEQ |
|
| 182 | -26x | +
- EOSSTT == "DISCONTINUED",+ ) |
||
| 183 | -26x | +
- sample(x = l_dcsreas$choices, size = N, replace = TRUE, prob = l_dcsreas$prob),+ |
||
| 184 | -26x | +3x |
- as.character(NA)+ if (length(na_vars) > 0 && na_percentage > 0) {
|
|
| 185 | -+ | ! |
- )+ adqs <- mutate_na(ds = adqs, na_vars = na_vars, na_percentage = na_percentage) |
|
| 186 |
- ) %>%+ } |
|||
| 187 | -26x | +
- dplyr::mutate(DTHFL = dplyr::case_when(+ |
||
| 188 | -26x | +
- DCSREAS == "DEATH" ~ "Y",+ # apply metadata |
||
| 189 | -26x | +3x |
- TRUE ~ "N"+ adqs <- apply_metadata(adqs, "metadata/ADQS.yml") |
|
| 190 |
- )) %>%+ |
|||
| 191 | -26x | +3x |
- dplyr::mutate(+ return(adqs) |
|
| 192 | -26x | +
- DTHCAT = ifelse(+ } |
||
| 193 | -26x | +
| 1 | +
- DCSREAS == "DEATH",+ #' Laboratory Data Analysis Dataset (ADLB) |
|||
| 194 | -26x | +|||
| 2 | +
- sample(x = c("ADVERSE EVENT", "PROGRESSIVE DISEASE", "OTHER"), size = N, replace = TRUE),
+ #' |
|||
| 195 | -26x | +|||
| 3 | +
- as.character(NA)+ #' @description `r lifecycle::badge("stable")`
|
|||
| 196 | +4 |
- )+ #' |
||
| 197 | +5 |
- ) %>%+ #' Function for generating a random Laboratory Data Analysis Dataset for a given |
||
| 198 | -26x | +|||
| 6 | +
- dplyr::mutate(DTHCAUS = dplyr::case_when(+ #' Subject-Level Analysis Dataset. |
|||
| 199 | -26x | +|||
| 7 | +
- DTHCAT == "ADVERSE EVENT" ~ "ADVERSE EVENT",+ #' |
|||
| 200 | -26x | +|||
| 8 | +
- DTHCAT == "PROGRESSIVE DISEASE" ~ "DISEASE PROGRESSION",+ #' @details One record per subject per parameter per analysis visit per analysis date. |
|||
| 201 | -26x | +|||
| 9 | +
- DTHCAT == "OTHER" ~ sample(x = l_dthcat_other$choices, size = N, replace = TRUE, prob = l_dthcat_other$prob),+ #' |
|||
| 202 | -26x | +|||
| 10 | +
- TRUE ~ as.character(NA)+ #' Keys: `STUDYID`, `USUBJID`, `PARAMCD`, `BASETYPE`, `AVISITN`, `ATPTN`, `DTYPE`, `ADTM`, `LBSEQ`, `ASPID` |
|||
| 203 | +11 |
- )) %>%+ # |
||
| 204 | -26x | +|||
| 12 | +
- dplyr::mutate(ADTHAUT = dplyr::case_when(+ #' @inheritParams argument_convention |
|||
| 205 | -26x | +|||
| 13 | +
- DTHCAUS %in% c("ADVERSE EVENT", "DISEASE PROGRESSION") ~ "Yes",
+ #' @param lbcat (`character vector`)\cr LB category values. |
|||
| 206 | -26x | +|||
| 14 | +
- DTHCAUS %in% c("UNKNOWN", "SUICIDE", "Post-study reporting of death") ~ sample(
+ #' @param max_n_lbs (`integer`)\cr Maximum number of labs per patient. Defaults to 10. |
|||
| 207 | -26x | +|||
| 15 | +
- x = c("Yes", "No"), size = N, replace = TRUE, prob = c(0.25, 0.75)
+ #' @template param_cached |
|||
| 208 | +16 |
- ),+ #' @templateVar data adlb |
||
| 209 | -26x | +|||
| 17 | ++ |
+ #'+ |
+ ||
| 18 | ++ |
+ #' @return `data.frame`+ |
+ ||
| 19 | +
- TRUE ~ as.character(NA)+ #' @export |
|||
| 210 | +20 |
- )) %>%+ #' |
||
| 211 | +21 |
- # adding some random number of days post last treatment date so that death days from last trt admin+ #' @author tomlinsj, npaszty, Xuefeng Hou |
||
| 212 | +22 |
- # supports the LDDTHGR1 derivation below+ #' |
||
| 213 | -26x | +|||
| 23 | +
- dplyr::mutate(DTHDT = dplyr::case_when(+ #' @examples |
|||
| 214 | -26x | +|||
| 24 | +
- DCSREAS == "DEATH" ~ lubridate::date(TRTEDTM + lubridate::days(sample(0:50, size = N, replace = TRUE))),+ #' adsl <- radsl(N = 10, seed = 1, study_duration = 2) |
|||
| 215 | -26x | +|||
| 25 | +
- TRUE ~ NA+ #' |
|||
| 216 | +26 |
- )) %>%+ #' adlb <- radlb(adsl, visit_format = "WEEK", n_assessments = 7L, seed = 2) |
||
| 217 | -26x | +|||
| 27 | +
- dplyr::mutate(LDDTHELD = difftime(DTHDT, lubridate::date(TRTEDTM), units = "days")) %>%+ #' adlb |
|||
| 218 | -26x | +|||
| 28 | +
- dplyr::mutate(LDDTHGR1 = dplyr::case_when(+ #' |
|||
| 219 | -26x | +|||
| 29 | +
- LDDTHELD <= 30 ~ "<=30",+ #' adlb <- radlb(adsl, visit_format = "CYCLE", n_assessments = 2L, seed = 2) |
|||
| 220 | -26x | +|||
| 30 | +
- LDDTHELD > 30 ~ ">30",+ #' adlb |
|||
| 221 | -26x | +|||
| 31 | +
- TRUE ~ as.character(NA)+ radlb <- function(adsl, |
|||
| 222 | +32 |
- )) %>%+ lbcat = c("CHEMISTRY", "CHEMISTRY", "IMMUNOLOGY"),
|
||
| 223 | -26x | +|||
| 33 | +
- dplyr::mutate(LSTALVDT = dplyr::case_when(+ param = c( |
|||
| 224 | -26x | +|||
| 34 | +
- DCSREAS == "DEATH" ~ DTHDT,+ "Alanine Aminotransferase Measurement", |
|||
| 225 | -26x | +|||
| 35 | +
- TRUE ~ lubridate::date(TRTEDTM) + lubridate::days(floor(stats::runif(N, min = 10, max = 30)))+ "C-Reactive Protein Measurement", |
|||
| 226 | +36 |
- ))+ "Immunoglobulin A Measurement" |
||
| 227 | +37 |
-
+ ), |
||
| 228 | +38 |
- # add random ETHNIC (Ethnicity)+ paramcd = c("ALT", "CRP", "IGA"),
|
||
| 229 | -26x | +|||
| 39 | +
- adsl <- adsl %>%+ paramu = c("U/L", "mg/L", "g/L"),
|
|||
| 230 | -26x | +|||
| 40 | +
- dplyr::mutate(ETHNIC = sample(+ aval_mean = c(18, 9, 2.9), |
|||
| 231 | -26x | +|||
| 41 | +
- x = c("HISPANIC OR LATINO", "NOT HISPANIC OR LATINO", "NOT REPORTED", "UNKNOWN"),
+ visit_format = "WEEK", |
|||
| 232 | -26x | +|||
| 42 | +
- size = N, replace = TRUE, prob = c(.1, .8, .06, .04)+ n_assessments = 5L, |
|||
| 233 | +43 |
- ))+ n_days = 5L, |
||
| 234 | +44 |
-
+ max_n_lbs = 10L, |
||
| 235 | +45 |
- # associate DTHADY (Relative Day of Death) with Death date+ lookup = NULL, |
||
| 236 | +46 |
- # Date of Death [adsl.DTHDT] - date part of Date of First Exposure to Treatment [adsl.TRTSDTM]+ seed = NULL, |
||
| 237 | +47 |
-
+ na_percentage = 0, |
||
| 238 | -26x | +|||
| 48 | +
- adsl <- adsl %>%+ na_vars = list( |
|||
| 239 | -26x | +|||
| 49 | +
- dplyr::mutate(DTHADY = difftime(DTHDT, TRTSDTM, units = "days"))+ LOQFL = c(NA, 0.1), ABLFL2 = c(1234, 0.1), ABLFL = c(1235, 0.1), |
|||
| 240 | +50 |
-
+ BASE2 = c(NA, 0.1), BASE = c(NA, 0.1), |
||
| 241 | +51 |
-
+ CHG2 = c(1235, 0.1), PCHG2 = c(1235, 0.1), CHG = c(1234, 0.1), PCHG = c(1234, 0.1) |
||
| 242 | +52 |
- # associate sites with countries and regions+ ), |
||
| 243 | -26x | +|||
| 53 | +
- adsl <- adsl %>%+ cached = FALSE) {
|
|||
| 244 | -26x | +54 | +4x |
- dplyr::mutate(SITEID = paste0(COUNTRY, "-", SITEID)) %>%+ checkmate::assert_flag(cached) |
| 245 | -26x | +55 | +4x |
- dplyr::mutate(REGION1 = dplyr::case_when(+ if (cached) {
|
| 246 | -26x | +56 | +1x |
- COUNTRY %in% c("NGA") ~ "Africa",
+ return(get_cached_data("cadlb"))
|
| 247 | -26x | +|||
| 57 | +
- COUNTRY %in% c("CHN", "JPN", "PAK") ~ "Asia",
+ } |
|||
| 248 | -26x | +|||
| 58 | +
- COUNTRY %in% c("RUS") ~ "Eurasia",
+
|
|||
| 249 | -26x | +59 | +3x |
- COUNTRY %in% c("GBR") ~ "Europe",
+ checkmate::assert_data_frame(adsl) |
| 250 | -26x | +60 | +3x |
- COUNTRY %in% c("CAN", "USA") ~ "North America",
+ checkmate::assert_character(param, min.len = 1, any.missing = FALSE) |
| 251 | -26x | +61 | +3x |
- COUNTRY %in% c("BRA") ~ "South America",
+ checkmate::assert_character(paramcd, min.len = 1, any.missing = FALSE) |
| 252 | -26x | +62 | +3x |
- TRUE ~ as.character(NA)+ checkmate::assert_character(paramu, min.len = 1, any.missing = FALSE) |
| 253 | -+ | |||
| 63 | +3x |
- )) %>%+ checkmate::assert_character(lbcat, min.len = 1, any.missing = FALSE) |
||
| 254 | -26x | +64 | +3x |
- dplyr::mutate(INVID = paste("INV ID", SITEID)) %>%
+ checkmate::assert_string(visit_format) |
| 255 | -26x | +65 | +3x |
- dplyr::mutate(INVNAM = paste("Dr.", SITEID, "Doe")) %>%
+ checkmate::assert_integer(n_assessments, len = 1, any.missing = FALSE) |
| 256 | -26x | +66 | +3x |
- dplyr::mutate(USUBJID = paste(STUDYID, SITEID, SUBJID, sep = "-"))+ checkmate::assert_integer(n_days, len = 1, any.missing = FALSE) |
| 257 | -+ | |||
| 67 | +3x |
-
+ checkmate::assert_integer(max_n_lbs, len = 1, any.missing = FALSE) |
||
| 258 | -+ | |||
| 68 | +3x |
-
+ checkmate::assert_data_frame(lookup, null.ok = TRUE) |
||
| 259 | -26x | +69 | +3x |
- if (length(na_vars) > 0 && na_percentage > 0) {
+ checkmate::assert_number(seed, null.ok = TRUE) |
| 260 | -! | +|||
| 70 | +3x |
- adsl <- mutate_na(ds = adsl, na_vars = na_vars, na_percentage = na_percentage)+ checkmate::assert_number(na_percentage, lower = 0, upper = 1) |
||
| 261 | -+ | |||
| 71 | +3x |
- }+ checkmate::assert_true(na_percentage < 1) |
||
| 262 | +72 | |||
| 263 | +73 |
- # apply metadata+ # validate and initialize related variables |
||
| 264 | -26x | -
- adsl <- apply_metadata(adsl, "metadata/ADSL.yml", FALSE)- |
- ||
| 265 | -+ | 74 | +3x |
-
+ lbcat_init_list <- relvar_init(param, lbcat) |
| 266 | -26x | +75 | +3x |
- attr(adsl, "study_duration_secs") <- as.numeric(study_duration_secs)+ param_init_list <- relvar_init(param, paramcd) |
| 267 | -26x | +76 | +3x |
- return(adsl)+ unit_init_list <- relvar_init(param, paramu) |
| 268 | +77 |
- }+ |
| 1 | -+ | |||
| 78 | +3x |
- #' Tumor Response Analysis Dataset (ADRS)+ if (!is.null(seed)) {
|
||
| 2 | -+ | |||
| 79 | +3x |
- #'+ set.seed(seed) |
||
| 3 | +80 |
- #' @description `r lifecycle::badge("stable")`
+ } |
||
| 4 | -+ | |||
| 81 | +3x |
- #'+ study_duration_secs <- lubridate::seconds(attr(adsl, "study_duration_secs")) |
||
| 5 | +82 |
- #' Function for generating a random Tumor Response Analysis Dataset for a given+ |
||
| 6 | -+ | |||
| 83 | +3x |
- #' Subject-Level Analysis Dataset.+ adlb <- expand.grid( |
||
| 7 | -+ | |||
| 84 | +3x |
- #'+ STUDYID = unique(adsl$STUDYID), |
||
| 8 | -+ | |||
| 85 | +3x |
- #' @details+ USUBJID = adsl$USUBJID, |
||
| 9 | -+ | |||
| 86 | +3x |
- #' One record per subject per parameter per analysis visit per analysis date.+ PARAM = as.factor(param_init_list$relvar1), |
||
| 10 | -+ | |||
| 87 | +3x |
- #' SDTM variables are populated on new records coming from other single records.+ AVISIT = visit_schedule(visit_format = visit_format, n_assessments = n_assessments, n_days = n_days), |
||
| 11 | -+ | |||
| 88 | +3x |
- #' Otherwise, SDTM variables are left blank.+ stringsAsFactors = FALSE |
||
| 12 | +89 |
- #'+ ) |
||
| 13 | +90 |
- #' Keys: `STUDYID`, `USUBJID`, `PARAMCD`, `AVISITN`, `ADT`, `RSSEQ`+ |
||
| 14 | +91 |
- #'+ # assign AVAL based on different tests |
||
| 15 | -+ | |||
| 92 | +3x |
- #' @inheritParams argument_convention+ adlb <- adlb %>% mutate(AVAL = case_when( |
||
| 16 | -+ | |||
| 93 | +3x |
- #' @param avalc (`character vector`)\cr Analysis value categories.+ PARAM == param[1] ~ abs(stats::rnorm(nrow(adlb), mean = aval_mean[1], sd = 10)), |
||
| 17 | -+ | |||
| 94 | +3x |
- #' @template param_cached+ PARAM == param[2] ~ abs(stats::rnorm(nrow(adlb), mean = aval_mean[2], sd = 1)), |
||
| 18 | -+ | |||
| 95 | +3x |
- #' @templateVar data adrs+ PARAM == param[3] ~ abs(stats::rnorm(nrow(adlb), mean = aval_mean[3], sd = 0.1)) |
||
| 19 | +96 |
- #'+ )) |
||
| 20 | +97 |
- #' @return `data.frame`+ |
||
| 21 | +98 |
- #' @export+ # assign related variable values: PARAMxLBCAT are related |
||
| 22 | -+ | |||
| 99 | +3x |
- #'+ adlb <- adlb %>% rel_var( |
||
| 23 | -+ | |||
| 100 | +3x |
- #' @examples+ var_name = "LBCAT", |
||
| 24 | -+ | |||
| 101 | +3x |
- #' adsl <- radsl(N = 10, seed = 1, study_duration = 2)+ related_var = "PARAM", |
||
| 25 | -+ | |||
| 102 | +3x |
- #'+ var_values = lbcat_init_list$relvar2 |
||
| 26 | +103 |
- #' adrs <- radrs(adsl, seed = 2)+ ) |
||
| 27 | +104 |
- #' adrs+ |
||
| 28 | +105 |
- radrs <- function(adsl,+ # assign related variable values: PARAMxPARAMCD are related |
||
| 29 | -+ | |||
| 106 | +3x |
- avalc = NULL,+ adlb <- adlb %>% rel_var( |
||
| 30 | -+ | |||
| 107 | +3x |
- lookup = NULL,+ var_name = "PARAMCD", |
||
| 31 | -+ | |||
| 108 | +3x |
- seed = NULL,+ related_var = "PARAM", |
||
| 32 | -+ | |||
| 109 | +3x |
- na_percentage = 0,+ var_values = param_init_list$relvar2 |
||
| 33 | +110 |
- na_vars = list(AVISIT = c(NA, 0.1), AVAL = c(1234, 0.1), AVALC = c(1234, 0.1)),+ ) |
||
| 34 | +111 |
- cached = FALSE) {
+
|
||
| 35 | -7x | +112 | +3x |
- checkmate::assert_flag(cached)+ adlb <- adlb %>% |
| 36 | -7x | +113 | +3x |
- if (cached) {
+ dplyr::mutate(LBTESTCD = PARAMCD) %>% |
| 37 | -1x | +114 | +3x |
- return(get_cached_data("cadrs"))
+ dplyr::mutate(LBTEST = PARAM) |
| 38 | +115 |
- }+ |
||
| 39 | -+ | |||
| 116 | +3x |
-
+ adlb <- adlb %>% dplyr::mutate(AVISITN = dplyr::case_when( |
||
| 40 | -6x | +117 | +3x |
- checkmate::assert_data_frame(adsl)+ AVISIT == "SCREENING" ~ -1, |
| 41 | -6x | +118 | +3x |
- checkmate::assert_vector(avalc, null.ok = TRUE)+ AVISIT == "BASELINE" ~ 0, |
| 42 | -6x | +119 | +3x |
- checkmate::assert_number(seed, null.ok = TRUE)+ (grepl("^WEEK", AVISIT) | grepl("^CYCLE", AVISIT)) ~ as.numeric(AVISIT) - 2,
|
| 43 | -6x | +120 | +3x |
- checkmate::assert_number(na_percentage, lower = 0, upper = 1)+ TRUE ~ NA_real_ |
| 44 | -6x | +|||
| 121 | +
- checkmate::assert_true(na_percentage < 1)+ )) |
|||
| 45 | +122 | |||
| 46 | -6x | +123 | +3x |
- param_codes <- if (!is.null(avalc)) {
+ adlb <- adlb %>% rel_var( |
| 47 | -! | +|||
| 124 | +3x |
- avalc+ var_name = "AVALU", |
||
| 48 | -+ | |||
| 125 | +3x |
- } else {
+ related_var = "PARAM", |
||
| 49 | -6x | +126 | +3x |
- stats::setNames(1:5, c("CR", "PR", "SD", "PD", "NE"))
+ var_values = unit_init_list$relvar2 |
| 50 | +127 |
- }+ ) |
||
| 51 | +128 | |||
| 52 | -6x | +129 | +3x |
- checkmate::assert_data_frame(lookup, null.ok = TRUE)+ adlb <- adlb %>% |
| 53 | -6x | +130 | +3x |
- lookup_ars <- if (!is.null(lookup)) {
+ dplyr::mutate(AVISITN = dplyr::case_when( |
| 54 | -! | +|||
| 131 | +3x |
- lookup+ AVISIT == "SCREENING" ~ -1, |
||
| 55 | -+ | |||
| 132 | +3x |
- } else {
+ AVISIT == "BASELINE" ~ 0, |
||
| 56 | -6x | +133 | +3x |
- expand.grid(+ (grepl("^WEEK", AVISIT) | grepl("^CYCLE", AVISIT)) ~ as.numeric(AVISIT) - 2,
|
| 57 | -6x | +134 | +3x |
- ARM = c("A: Drug X", "B: Placebo", "C: Combination"),
+ TRUE ~ NA_real_ |
| 58 | -6x | +|||
| 135 | +
- AVALC = names(param_codes)+ ))+ |
+ |||
| 136 | ++ | + + | +||
| 137 | ++ |
+ # order to prepare for change from screening and baseline values |
||
| 59 | -6x | +138 | +3x |
- ) %>% dplyr::mutate(+ adlb <- adlb[order(adlb$STUDYID, adlb$USUBJID, adlb$PARAMCD, adlb$AVISITN), ]+ |
+
| 139 | ++ | + | ||
| 60 | -6x | +140 | +3x |
- AVAL = param_codes[AVALC],+ adlb <- Reduce(rbind, lapply(split(adlb, adlb$USUBJID), function(x) {
|
| 61 | -6x | +141 | +30x |
- p_scr = c(rep(0, 3), rep(0, 3), c(1, 1, 1), c(0, 0, 0), c(0, 0, 0)),+ x$STUDYID <- adsl$STUDYID[which(adsl$USUBJID == x$USUBJID[1])] |
| 62 | -6x | +142 | +30x |
- p_bsl = c(rep(0, 3), rep(0, 3), c(1, 1, 1), c(0, 0, 0), c(0, 0, 0)),+ x$ABLFL2 <- ifelse(x$AVISIT == "SCREENING", "Y", "") |
| 63 | -6x | +143 | +30x |
- 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)),+ x$ABLFL <- ifelse(toupper(visit_format) == "WEEK" & x$AVISIT == "BASELINE", |
| 64 | -6x | +144 | +30x |
- 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)),+ "Y", |
| 65 | -6x | +145 | +30x |
- p_fu = c(c(.3, .2, .4), c(.2, .1, .3), c(.2, .2, .2), c(.3, .5, 0.1), rep(0, 3))+ ifelse(toupper(visit_format) == "CYCLE" & x$AVISIT == "CYCLE 1 DAY 1", "Y", "") |
| 66 | +146 |
) |
||
| 147 | +30x | +
+ x+ |
+ ||
| 67 | +148 |
- }+ })) |
||
| 68 | +149 | |||
| 69 | -6x | +150 | +3x |
- if (!is.null(seed)) {
+ adlb$BASE2 <- retain(adlb, adlb$AVAL, adlb$ABLFL2 == "Y") |
| 70 | -6x | +151 | +3x |
- set.seed(seed)+ adlb$BASE <- ifelse(adlb$ABLFL2 != "Y", retain(adlb, adlb$AVAL, adlb$ABLFL == "Y"), NA) |
| 71 | +152 |
- }+ |
||
| 72 | -6x | -
- study_duration_secs <- lubridate::seconds(attr(adsl, "study_duration_secs"))- |
- ||
| 73 | -+ | 153 | +3x |
-
+ adlb <- adlb %>% |
| 74 | -6x | +154 | +3x |
- adrs <- split(adsl, adsl$USUBJID) %>%+ dplyr::mutate(CHG2 = AVAL - BASE2) %>% |
| 75 | -6x | +155 | +3x |
- lapply(function(pinfo) {
+ dplyr::mutate(PCHG2 = 100 * (CHG2 / BASE2)) %>% |
| 76 | -60x | +156 | +3x |
- probs <- dplyr::filter(lookup_ars, ARM == as.character(pinfo$ACTARM))+ dplyr::mutate(CHG = AVAL - BASE) %>% |
| 77 | -+ | |||
| 157 | +3x |
-
+ dplyr::mutate(PCHG = 100 * (CHG / BASE)) %>% |
||
| 78 | -+ | |||
| 158 | +3x |
- # screening+ dplyr::mutate(BASETYPE = "LAST") %>% |
||
| 79 | -60x | +159 | +3x |
- rsp_screen <- sample(probs$AVALC, 1, prob = probs$p_scr) %>% as.character()+ dplyr::mutate(ANRLO = dplyr::case_when( |
| 80 | -+ | |||
| 160 | +3x |
-
+ PARAMCD == "ALT" ~ 7, |
||
| 81 | -+ | |||
| 161 | +3x |
- # baseline+ PARAMCD == "CRP" ~ 8, |
||
| 82 | -60x | +162 | +3x |
- rsp_bsl <- sample(probs$AVALC, 1, prob = probs$p_bsl) %>% as.character()+ PARAMCD == "IGA" ~ 0.8 |
| 83 | +163 |
-
+ )) %>% |
||
| 84 | -+ | |||
| 164 | +3x |
- # cycle+ dplyr::mutate(ANRHI = dplyr::case_when( |
||
| 85 | -60x | +165 | +3x |
- rsp_c2d1 <- sample(probs$AVALC, 1, prob = probs$p_cycle) %>% as.character()+ PARAMCD == "ALT" ~ 55, |
| 86 | -60x | +166 | +3x |
- rsp_c4d1 <- sample(probs$AVALC, 1, prob = probs$p_cycle) %>% as.character()+ PARAMCD == "CRP" ~ 10, |
| 87 | -+ | |||
| 167 | +3x |
-
+ PARAMCD == "IGA" ~ 3 |
||
| 88 | +168 |
- # end of induction+ )) %>% |
||
| 89 | -60x | +169 | +3x |
- rsp_eoi <- sample(probs$AVALC, 1, prob = probs$p_eoi) %>% as.character()+ dplyr::mutate(ANRIND = factor(dplyr::case_when( |
| 90 | -+ | |||
| 170 | +3x |
-
+ AVAL < ANRLO ~ "LOW", |
||
| 91 | -+ | |||
| 171 | +3x |
- # follow up+ AVAL > ANRHI ~ "HIGH", |
||
| 92 | -60x | +172 | +3x |
- rsp_fu <- sample(probs$AVALC, 1, prob = probs$p_fu) %>% as.character()+ TRUE ~ "NORMAL" |
| 93 | +173 |
-
+ ))) %>% |
||
| 94 | -60x | +174 | +3x |
- best_rsp <- min(param_codes[c(rsp_screen, rsp_bsl, rsp_eoi, rsp_fu, rsp_c2d1, rsp_c4d1)])+ dplyr::mutate(LBSTRESC = factor(dplyr::case_when( |
| 95 | -60x | +175 | +3x |
- best_rsp_i <- which.min(param_codes[c(rsp_screen, rsp_bsl, rsp_eoi, rsp_fu, rsp_c2d1, rsp_c4d1)])+ PARAMCD == "ALT" ~ "<7", |
| 96 | -+ | |||
| 176 | +3x |
-
+ PARAMCD == "CRP" ~ "<8", |
||
| 97 | -60x | +177 | +3x |
- avisit <- c("SCREENING", "BASELINE", "CYCLE 2 DAY 1", "CYCLE 4 DAY 1", "END OF INDUCTION", "FOLLOW UP")
+ PARAMCD == "IGA" ~ ">3" |
| 98 | +178 |
-
+ ))) %>%+ |
+ ||
| 179 | +3x | +
+ dplyr::rowwise() %>%+ |
+ ||
| 180 | +3x | +
+ dplyr::mutate(LOQFL = factor(+ |
+ ||
| 181 | +3x | +
+ ifelse(eval(parse(text = paste(AVAL, LBSTRESC))), "Y", "N") |
||
| 99 | +182 |
- # meaningful date information+ )) %>% |
||
| 100 | -60x | +183 | +3x |
- trtstdt <- lubridate::date(pinfo$TRTSDTM)+ dplyr::ungroup() %>% |
| 101 | -60x | +184 | +3x |
- trtendt <- lubridate::date(dplyr::if_else(+ dplyr::group_by(USUBJID, PARAMCD, BASETYPE) %>% |
| 102 | -60x | +185 | +3x |
- !is.na(pinfo$TRTEDTM), pinfo$TRTEDTM,+ dplyr::mutate(BNRIND = ANRIND[ABLFL == "Y"]) %>% |
| 103 | -60x | -
- lubridate::floor_date(trtstdt + study_duration_secs, unit = "day")- |
- ||
| 104 | -+ | 186 | +3x |
- ))+ dplyr::ungroup() %>% |
| 105 | -60x | +187 | +3x |
- scr_date <- trtstdt - lubridate::days(100)+ dplyr::mutate(SHIFT1 = factor(ifelse( |
| 106 | -60x | +188 | +3x |
- bs_date <- trtstdt+ AVISITN > 0, |
| 107 | -60x | +189 | +3x |
- flu_date <- sample(seq(lubridate::as_datetime(trtstdt), lubridate::as_datetime(trtendt), by = "day"), size = 1)+ paste( |
| 108 | -60x | +190 | +3x |
- eoi_date <- sample(seq(lubridate::as_datetime(trtstdt), lubridate::as_datetime(trtendt), by = "day"), size = 1)+ retain( |
| 109 | -60x | +191 | +3x |
- c2d1_date <- sample(seq(lubridate::as_datetime(trtstdt), lubridate::as_datetime(trtendt), by = "day"), size = 1)+ adlb, as.character(BNRIND), |
| 110 | -60x | +192 | +3x |
- c4d1_date <- min(lubridate::date(c2d1_date + lubridate::days(60)), trtendt)+ AVISITN == 0 |
| 111 | +193 |
-
+ ), |
||
| 112 | -60x | +194 | +3x |
- tibble::tibble(+ ANRIND, |
| 113 | -60x | +195 | +3x |
- STUDYID = pinfo$STUDYID,+ sep = " to " |
| 114 | -60x | +|||
| 196 | +
- SITEID = pinfo$SITEID,+ ), |
|||
| 115 | -60x | +|||
| 197 | +
- USUBJID = pinfo$USUBJID,+ "" |
|||
| 116 | -60x | +|||
| 198 | +
- PARAMCD = as.factor(c(rep("OVRINV", 6), "BESRSPI", "INVET")),
+ ))) %>% |
|||
| 117 | -60x | +199 | +3x |
- PARAM = as.factor(dplyr::recode(+ dplyr::mutate(ATOXGR = factor(dplyr::case_when( |
| 118 | -60x | +200 | +3x |
- PARAMCD,+ ANRIND == "LOW" ~ sample( |
| 119 | -60x | +201 | +3x |
- OVRINV = "Overall Response by Investigator - by visit",+ c("-1", "-2", "-3", "-4", "-5"),
|
| 120 | -60x | +202 | +3x |
- OVRSPI = "Best Overall Response by Investigator (no confirmation required)",+ nrow(adlb), |
| 121 | -60x | +203 | +3x |
- BESRSPI = "Best Confirmed Overall Response by Investigator",+ replace = TRUE, |
| 122 | -60x | +204 | +3x |
- INVET = "Investigator End Of Induction Response"+ prob = c(0.30, 0.25, 0.20, 0.15, 0) |
| 123 | +205 |
- )),+ ), |
||
| 124 | -60x | +206 | +3x |
- AVALC = c(+ ANRIND == "HIGH" ~ sample( |
| 125 | -60x | +207 | +3x |
- rsp_screen, rsp_bsl, rsp_c2d1, rsp_c4d1, rsp_eoi, rsp_fu,+ c("1", "2", "3", "4", "5"),
|
| 126 | -60x | +208 | +3x |
- names(param_codes)[best_rsp],+ nrow(adlb), |
| 127 | -60x | +209 | +3x |
- rsp_eoi+ replace = TRUE, |
| 128 | -+ | |||
| 210 | +3x |
- ),+ prob = c(0.30, 0.25, 0.20, 0.15, 0) |
||
| 129 | -60x | +|||
| 211 | +
- AVAL = param_codes[AVALC],+ ), |
|||
| 130 | -60x | +212 | +3x |
- AVISIT = factor(c(avisit, avisit[best_rsp_i], avisit[5]), levels = avisit)+ ANRIND == "NORMAL" ~ "0" |
| 131 | +213 |
- ) %>%+ ))) %>% |
||
| 132 | -60x | +214 | +3x |
- merge(+ dplyr::group_by(USUBJID, PARAMCD, BASETYPE) %>% |
| 133 | -60x | +215 | +3x |
- tibble::tibble(+ dplyr::mutate(BTOXGR = ATOXGR[ABLFL == "Y"]) %>% |
| 134 | -60x | +216 | +3x |
- AVISIT = avisit,+ dplyr::ungroup() %>% |
| 135 | -60x | +217 | +3x |
- ADTM = c(scr_date, bs_date, c2d1_date, c4d1_date, eoi_date, flu_date),+ dplyr::mutate(ATPTN = 1) %>% |
| 136 | -60x | +218 | +3x |
- AVISITN = c(-1, 0, 2, 4, 999, 999),+ dplyr::mutate(DTYPE = NA) %>% |
| 137 | -60x | +219 | +3x |
- TRTSDTM = pinfo$TRTSDTM+ dplyr::mutate(BTOXGRL = factor(dplyr::case_when( |
| 138 | -+ | |||
| 220 | +3x |
- ) %>%+ BTOXGR == "0" ~ "0", |
||
| 139 | -60x | +221 | +3x |
- dplyr::mutate(+ BTOXGR == "-1" ~ "1", |
| 140 | -60x | +222 | +3x |
- ADY = ceiling(difftime(ADTM, TRTSDTM, units = "days"))+ BTOXGR == "-2" ~ "2", |
| 141 | -+ | |||
| 223 | +3x |
- ) %>%+ BTOXGR == "-3" ~ "3", |
||
| 142 | -60x | +224 | +3x |
- dplyr::select(-"TRTSDTM"),+ BTOXGR == "-4" ~ "4", |
| 143 | -60x | +225 | +3x |
- by = "AVISIT"+ BTOXGR == "1" ~ "<Missing>", |
| 144 | -+ | |||
| 226 | +3x |
- )+ BTOXGR == "2" ~ "<Missing>", |
||
| 145 | -+ | |||
| 227 | +3x |
- }) %>%+ BTOXGR == "3" ~ "<Missing>", |
||
| 146 | -6x | +228 | +3x |
- Reduce(rbind, .) %>%+ BTOXGR == "4" ~ "<Missing>" |
| 147 | -6x | +|||
| 229 | +
- dplyr::mutate(AVALC = factor(AVALC, levels = names(param_codes))) %>%+ ))) %>% |
|||
| 148 | -6x | +230 | +3x |
- var_relabel(+ dplyr::mutate(BTOXGRH = factor(dplyr::case_when( |
| 149 | -6x | +231 | +3x |
- STUDYID = "Study Identifier",+ BTOXGR == "0" ~ "0", |
| 150 | -6x | +232 | +3x |
- USUBJID = "Unique Subject Identifier"+ BTOXGR == "1" ~ "1", |
| 151 | -+ | |||
| 233 | +3x |
- )+ BTOXGR == "2" ~ "2", |
||
| 152 | -+ | |||
| 234 | +3x |
-
+ BTOXGR == "3" ~ "3", |
||
| 153 | -6x | +235 | +3x |
- adrs <- var_relabel(+ BTOXGR == "4" ~ "4", |
| 154 | -6x | +236 | +3x |
- adrs,+ BTOXGR == "-1" ~ "<Missing>", |
| 155 | -6x | +237 | +3x |
- STUDYID = "Study Identifier",+ BTOXGR == "-2" ~ "<Missing>", |
| 156 | -6x | +238 | +3x |
- USUBJID = "Unique Subject Identifier"+ BTOXGR == "-3" ~ "<Missing>", |
| 157 | -+ | |||
| 239 | +3x |
- )+ BTOXGR == "-4" ~ "<Missing>", |
||
| 158 | +240 |
-
+ ))) %>% |
||
| 159 | -+ | |||
| 241 | +3x |
- # merge ADSL to be able to add RS date and study day variables+ dplyr::mutate(ATOXGRL = factor(dplyr::case_when( |
||
| 160 | -+ | |||
| 242 | +3x |
-
+ ATOXGR == "0" ~ "0", |
||
| 161 | -+ | |||
| 243 | +3x |
-
+ ATOXGR == "-1" ~ "1", |
||
| 162 | -6x | +244 | +3x |
- adrs <- dplyr::inner_join(+ ATOXGR == "-2" ~ "2", |
| 163 | -6x | +245 | +3x |
- dplyr::select(adrs, -"SITEID"),+ ATOXGR == "-3" ~ "3", |
| 164 | -6x | +246 | +3x |
- adsl,+ ATOXGR == "-4" ~ "4", |
| 165 | -6x | +247 | +3x |
- by = c("STUDYID", "USUBJID")
+ ATOXGR == "1" ~ "<Missing>", |
| 166 | -+ | |||
| 248 | +3x |
- )+ ATOXGR == "2" ~ "<Missing>", |
||
| 167 | -+ | |||
| 249 | +3x |
-
+ ATOXGR == "3" ~ "<Missing>", |
||
| 168 | -6x | +250 | +3x |
- adrs <- adrs %>%+ ATOXGR == "4" ~ "<Missing>", |
| 169 | -6x | +|||
| 251 | +
- dplyr::group_by(USUBJID) %>%+ ))) %>% |
|||
| 170 | -6x | +252 | +3x |
- dplyr::mutate(RSSEQ = seq_len(dplyr::n())) %>%+ dplyr::mutate(ATOXGRH = factor(dplyr::case_when( |
| 171 | -6x | +253 | +3x |
- dplyr::mutate(ASEQ = RSSEQ) %>%+ ATOXGR == "0" ~ "0", |
| 172 | -6x | +254 | +3x |
- dplyr::ungroup() %>%+ ATOXGR == "1" ~ "1", |
| 173 | -6x | +255 | +3x |
- dplyr::arrange(+ ATOXGR == "2" ~ "2", |
| 174 | -6x | +256 | +3x |
- STUDYID,+ ATOXGR == "3" ~ "3", |
| 175 | -6x | +257 | +3x |
- USUBJID,+ ATOXGR == "4" ~ "4", |
| 176 | -6x | +258 | +3x |
- PARAMCD,+ ATOXGR == "-1" ~ "<Missing>", |
| 177 | -6x | +259 | +3x |
- AVISITN,+ ATOXGR == "-2" ~ "<Missing>", |
| 178 | -6x | +260 | +3x |
- ADTM,+ ATOXGR == "-3" ~ "<Missing>", |
| 179 | -6x | +261 | +3x |
- RSSEQ+ ATOXGR == "-4" ~ "<Missing>", |
| 180 | +262 |
- )+ ))) %>% |
||
| 181 | -+ | |||
| 263 | +3x |
-
+ rcd_var_relabel( |
||
| 182 | -6x | +264 | +3x |
- if (length(na_vars) > 0 && na_percentage > 0) {
+ STUDYID = attr(adsl$STUDYID, "label"), |
| 183 | -! | +|||
| 265 | +3x |
- adrs <- mutate_na(ds = adrs, na_vars = na_vars, na_percentage = na_percentage)+ USUBJID = attr(adsl$USUBJID, "label") |
||
| 184 | +266 |
- }+ ) |
||
| 185 | +267 | |||
| 186 | +268 |
- # apply metadata- |
- ||
| 187 | -6x | -
- adrs <- apply_metadata(adrs, "metadata/ADRS.yml")+ # High and low descriptions of the different PARAMCD values |
||
| 188 | +269 |
-
+ # This is currently hard coded as the GDSR does not have these descriptions yet |
||
| 189 | -6x | +270 | +3x |
- return(adrs)+ grade_lookup <- tibble::tribble( |
| 190 | -+ | |||
| 271 | +3x |
- }+ ~PARAMCD, ~ATOXDSCL, ~ATOXDSCH, |
| 1 | -+ | |||||
| 272 | +3x |
- #' Pharmacokinetics Parameters Dataset (ADPP)+ "ALB", "Hypoalbuminemia", NA_character_, |
||||
| 2 | -+ | |||||
| 273 | +3x |
- #'+ "ALKPH", NA_character_, "Alkaline phosphatase increased", |
||||
| 3 | -+ | |||||
| 274 | +3x |
- #' @description `r lifecycle::badge("stable")`
+ "ALT", NA_character_, "Alanine aminotransferase increased", |
||||
| 4 | -+ | |||||
| 275 | +3x |
- #'+ "AST", NA_character_, "Aspartate aminotransferase increased", |
||||
| 5 | -+ | |||||
| 276 | +3x |
- #' Function for generating a random Pharmacokinetics Parameters Dataset for a given+ "BILI", NA_character_, "Blood bilirubin increased", |
||||
| 6 | -+ | |||||
| 277 | +3x |
- #' Subject-Level Analysis Dataset.+ "CA", "Hypocalcemia", "Hypercalcemia", |
||||
| 7 | -+ | |||||
| 278 | +3x |
- #'+ "CHOLES", NA_character_, "Cholesterol high", |
||||
| 8 | -+ | |||||
| 279 | +3x |
- #' @details One record per study, subject, parameter category, parameter and visit.+ "CK", NA_character_, "CPK increased", |
||||
| 9 | -+ | |||||
| 280 | +3x |
- #'+ "CREAT", NA_character_, "Creatinine increased", |
||||
| 10 | -+ | |||||
| 281 | +3x |
- #' @inheritParams argument_convention+ "CRP", NA_character_, "C reactive protein increased", |
||||
| 11 | -+ | |||||
| 282 | +3x |
- #' @param ppcat (`character vector`)\cr Categories of parameters.+ "GGT", NA_character_, "GGT increased", |
||||
| 12 | -+ | |||||
| 283 | +3x |
- #' @param ppspec (`character vector`)\cr Specimen material types.+ "GLUC", "Hypoglycemia", "Hyperglycemia", |
||||
| 13 | -+ | |||||
| 284 | +3x |
- #' @template param_cached+ "HGB", "Anemia", "Hemoglobin increased", |
||||
| 14 | -+ | |||||
| 285 | +3x |
- #' @templateVar data adpp+ "IGA", NA_character_, "Immunoglobulin A increased", |
||||
| 15 | -+ | |||||
| 286 | +3x |
- #'+ "POTAS", "Hypokalemia", "Hyperkalemia", |
||||
| 16 | -+ | |||||
| 287 | +3x |
- #' @return `data.frame`+ "LYMPH", "CD4 lymphocytes decreased", NA_character_, |
||||
| 17 | -+ | |||||
| 288 | +3x |
- #' @export+ "PHOS", "Hypophosphatemia", NA_character_, |
||||
| 18 | -+ | |||||
| 289 | +3x |
- #'+ "PLAT", "Platelet count decreased", NA_character_, |
||||
| 19 | -+ | |||||
| 290 | +3x |
- #' @examples+ "SODIUM", "Hyponatremia", "Hypernatremia", |
||||
| 20 | -+ | |||||
| 291 | +3x |
- #' adsl <- radsl(N = 10, seed = 1, study_duration = 2)+ "WBC", "White blood cell decreased", "Leukocytosis", |
||||
| 21 | +292 |
- #'+ ) |
||||
| 22 | +293 |
- #' adpp <- radpp(adsl, seed = 2)+ |
||||
| 23 | +294 |
- #' adpp+ # merge grade_lookup onto adlb |
||||
| 24 | -+ | |||||
| 295 | +3x |
- radpp <- function(adsl,+ adlb <- dplyr::left_join(adlb, grade_lookup, by = "PARAMCD") |
||||
| 25 | +296 |
- ppcat = c("Plasma Drug X", "Plasma Drug Y", "Metabolite Drug X", "Metabolite Drug Y"),
+
|
||||
| 26 | -+ | |||||
| 297 | +3x |
- ppspec = c(+ adlb <- rcd_var_relabel( |
||||
| 27 | -+ | |||||
| 298 | +3x |
- "Plasma", "Plasma", "Plasma", "Matrix of PD", "Matrix of PD",+ adlb, |
||||
| 28 | -+ | |||||
| 299 | +3x |
- "Urine", "Urine", "Urine", "Urine"+ STUDYID = "Study Identifier", |
||||
| 29 | -+ | |||||
| 300 | +3x |
- ),+ USUBJID = "Unique Subject Identifier" |
||||
| 30 | +301 |
- paramcd = c(+ ) |
||||
| 31 | +302 |
- "AUCIFO", "CMAX", "CLO", "RMAX", "TON",+ |
||||
| 32 | +303 |
- "RENALCL", "RENALCLD", "RCAMINT", "RCPCINT"+ # merge ADSL to be able to add LB date and study day variables |
||||
| 33 | -+ | |||||
| 304 | +3x |
- ),+ adlb <- dplyr::inner_join( |
||||
| 34 | -+ | |||||
| 305 | +3x |
- param = c(+ adlb, |
||||
| 35 | -+ | |||||
| 306 | +3x |
- "AUC Infinity Obs", "Max Conc", "Total CL Obs", "Time of Maximum Response",+ adsl, |
||||
| 36 | -+ | |||||
| 307 | +3x |
- "Time to Onset", "Renal CL", "Renal CL Norm by Dose",+ by = c("STUDYID", "USUBJID")
|
||||
| 37 | +308 |
- "Amt Rec from T1 to T2", "Pct Rec from T1 to T2"+ ) %>% |
||||
| 38 | -+ | |||||
| 309 | +3x |
- ),+ dplyr::rowwise() %>% |
||||
| 39 | -+ | |||||
| 310 | +3x |
- paramu = c("day*ug/mL", "ug/mL", "ml/day/kg", "hr", "hr", "L/hr", "L/hr/mg", "mg", "%"),
+ dplyr::mutate(TRTENDT = lubridate::date(dplyr::case_when( |
||||
| 40 | -+ | |||||
| 311 | +3x |
- aval_mean = c(200, 30, 5, 10, 3, 0.05, 0.005, 1.5613, 15.65),+ is.na(TRTEDTM) ~ lubridate::floor_date(lubridate::date(TRTSDTM) + study_duration_secs, unit = "day"), |
||||
| 41 | -+ | |||||
| 312 | +3x |
- visit_format = "CYCLE",+ TRUE ~ TRTEDTM |
||||
| 42 | +313 |
- n_days = 2L,+ ))) %>% |
||||
| 43 | -+ | |||||
| 314 | +3x |
- seed = NULL,+ dplyr::ungroup() |
||||
| 44 | +315 |
- na_percentage = 0,+ |
||||
| 45 | -+ | |||||
| 316 | +3x |
- na_vars = list(+ adlb <- adlb %>% |
||||
| 46 | -+ | |||||
| 317 | +3x |
- AVAL = c(NA, 0.1)+ dplyr::group_by(USUBJID) %>% |
||||
| 47 | -+ | |||||
| 318 | +3x |
- ),+ dplyr::arrange(USUBJID, AVISITN) %>% |
||||
| 48 | -+ | |||||
| 319 | +3x |
- cached = FALSE) {
+ dplyr::mutate(ADTM = rep( |
||||
| 49 | -4x | +320 | +3x |
- checkmate::assert_flag(cached)+ sort(sample( |
||
| 50 | -4x | +321 | +3x |
- if (cached) {
+ seq(lubridate::as_datetime(TRTSDTM[1]), lubridate::as_datetime(TRTENDT[1]), by = "day"), |
||
| 51 | -1x | +322 | +3x |
- return(get_cached_data("cadlb"))
+ size = nlevels(AVISIT) |
||
| 52 | +323 |
- }+ )),+ |
+ ||||
| 324 | +3x | +
+ each = n() / nlevels(AVISIT) |
||||
| 53 | +325 |
-
+ )) %>% |
||||
| 54 | +326 | 3x |
- checkmate::assert_character(ppcat)+ dplyr::ungroup() %>% |
|||
| 55 | +327 | 3x |
- checkmate::assert_character(ppspec)+ dplyr::mutate(ADY = ceiling(difftime(ADTM, TRTSDTM, units = "days"))) %>% |
|||
| 56 | +328 | 3x |
- checkmate::assert_character(paramcd)+ dplyr::select(-TRTENDT) %>% |
|||
| 57 | +329 | 3x |
- checkmate::assert_character(param)+ dplyr::arrange(STUDYID, USUBJID, ADTM)+ |
+ |||
| 330 | ++ | + | ||||
| 58 | +331 | 3x |
- checkmate::assert_character(paramu)+ adlb <- adlb %>% |
|||
| 59 | +332 | 3x |
- checkmate::assert_vector(aval_mean)+ dplyr::mutate(ASPID = sample(seq_len(dplyr::n()))) %>% |
|||
| 60 | +333 | 3x |
- checkmate::assert_string(visit_format)+ dplyr::group_by(USUBJID) %>% |
|||
| 61 | +334 | 3x |
- checkmate::assert_integer(n_days)+ dplyr::mutate(LBSEQ = seq_len(dplyr::n())) %>% |
|||
| 62 | +335 | 3x |
- checkmate::assert_number(seed, null.ok = TRUE)+ dplyr::mutate(ASEQ = LBSEQ) %>% |
|||
| 63 | +336 | 3x |
- checkmate::assert_number(na_percentage, lower = 0, upper = 1)+ dplyr::ungroup() %>% |
|||
| 64 | +337 | 3x |
- checkmate::assert_true(na_percentage < 1)+ dplyr::arrange( |
|||
| 65 | +338 | 3x |
- checkmate::assert_list(na_vars)+ STUDYID, |
|||
| 66 | -+ | |||||
| 339 | +3x |
-
+ USUBJID, |
||||
| 67 | +340 | 3x |
- checkmate::assertTRUE(length(ppspec) == length(paramcd))+ PARAMCD, |
|||
| 68 | +341 | 3x |
- checkmate::assertTRUE(length(ppspec) == length(param))+ BASETYPE, |
|||
| 69 | +342 | 3x |
- checkmate::assertTRUE(length(ppspec) == length(paramu))+ AVISITN, |
|||
| 70 | +343 | 3x |
- checkmate::assertTRUE(length(ppspec) == length(aval_mean))+ ATPTN, |
|||
| 71 | -+ | |||||
| 344 | +3x |
-
+ DTYPE, |
||||
| 72 | +345 | 3x |
- if (!is.null(seed)) {
+ ADTM, |
|||
| 73 | +346 | 3x |
- set.seed(seed)+ LBSEQ, |
|||
| 74 | -+ | |||||
| 347 | +3x |
- }+ ASPID |
||||
| 75 | +348 |
-
+ ) |
||||
| 76 | +349 |
- # validate and initialize related variables+ |
||||
| 77 | +350 | 3x |
- ppspec_init_list <- relvar_init(param, ppspec)+ adlb <- adlb %>% dplyr::mutate(ONTRTFL = factor(dplyr::case_when( |
|||
| 78 | +351 | 3x |
- param_init_list <- relvar_init(param, paramcd)+ !AVISIT %in% c("SCREENING", "BASELINE") ~ "Y",
|
|||
| 79 | +352 | 3x |
- unit_init_list <- relvar_init(param, paramu)+ TRUE ~ "" |
|||
| 80 | +353 |
-
+ ))) |
||||
| 81 | -3x | +|||||
| 354 | +
- adpp <- expand.grid(+ |
|||||
| 82 | +355 | 3x |
- STUDYID = unique(adsl$STUDYID),+ flag_variables <- function(data, |
|||
| 83 | +356 | 3x |
- USUBJID = adsl$USUBJID,+ apply_grouping, |
|||
| 84 | +357 | 3x |
- PPCAT = as.factor(ppcat),+ apply_filter, |
|||
| 85 | +358 | 3x |
- PARAM = as.factor(param_init_list$relvar1),+ apply_mutate) {
|
|||
| 86 | -3x | +359 | +15x |
- AVISIT = visit_schedule(visit_format = visit_format, n_assessments = 1L, n_days = n_days),+ data_compare <- data %>% |
||
| 87 | -3x | +360 | +15x |
- stringsAsFactors = FALSE+ dplyr::mutate(row_check = seq_len(nrow(data))) |
||
| 88 | +361 |
- )+ |
||||
| 89 | -3x | +362 | +15x |
- adpp <- adpp %>%+ data <- data_compare %>% |
||
| 90 | -3x | +|||||
| 363 | +
- dplyr::mutate(AVAL = stats::rnorm(nrow(adpp), mean = 1, sd = 0.2)) %>%+ {
|
|||||
| 91 | -3x | +364 | +15x |
- dplyr::left_join(data.frame(PARAM = param, ADJUST = aval_mean), by = "PARAM") %>%+ if (apply_grouping == TRUE) {
|
||
| 92 | -3x | +365 | +9x |
- dplyr::mutate(AVAL = AVAL * ADJUST) %>%+ dplyr::group_by(., USUBJID, PARAMCD, BASETYPE, AVISIT)+ |
+ ||
| 366 | ++ |
+ } else {
|
||||
| 93 | -3x | +367 | +6x |
- dplyr::select(-"ADJUST")+ dplyr::group_by(., USUBJID, PARAMCD, BASETYPE) |
||
| 94 | +368 |
-
+ } |
||||
| 95 | +369 |
- # assign related variable values: PARAMxPPSPEC are related+ } %>% |
||||
| 96 | -3x | +370 | +15x |
- adpp <- adpp %>% rel_var(+ dplyr::arrange(ADTM, ASPID, LBSEQ) %>% |
||
| 97 | -3x | +|||||
| 371 | +
- var_name = "PPSPEC",+ {
|
|||||
| 98 | -3x | +372 | +15x |
- related_var = "PARAM",+ if (apply_filter == TRUE) {
|
||
| 99 | -3x | +373 | +6x |
- var_values = ppspec_init_list$relvar2+ dplyr::filter( |
||
| 100 | +374 |
- )+ ., |
||||
| 101 | -+ | |||||
| 375 | +6x |
-
+ (AVISIT != "BASELINE" & AVISIT != "SCREENING") &+ |
+ ||||
| 376 | +6x | +
+ (ONTRTFL == "Y" | ADTM <= TRTSDTM) |
||||
| 102 | +377 |
- # assign related variable values: PARAMxPARAMCD are related+ ) %>% |
||||
| 103 | -3x | +378 | +6x |
- adpp <- adpp %>% rel_var(+ dplyr::filter(ATOXGR == max(as.numeric(as.character(ATOXGR)))) |
||
| 104 | -3x | +379 | +9x |
- var_name = "PARAMCD",+ } else if (apply_filter == FALSE) {
|
||
| 105 | -3x | +380 | +6x |
- related_var = "PARAM",+ dplyr::filter(+ |
+ ||
| 381 | ++ |
+ ., |
||||
| 106 | -3x | +382 | +6x |
- var_values = param_init_list$relvar2+ (AVISIT != "BASELINE" & AVISIT != "SCREENING") & |
||
| 107 | -+ | |||||
| 383 | +6x |
- )+ (ONTRTFL == "Y" | ADTM <= TRTSDTM) |
||||
| 108 | +384 |
-
+ ) %>%+ |
+ ||||
| 385 | +6x | +
+ dplyr::filter(ATOXGR == min(as.numeric(as.character(ATOXGR)))) |
||||
| 109 | +386 |
- # assign related variable values: PARAMxAVALU are related+ } else {
|
||||
| 110 | +387 | 3x |
- adpp <- adpp %>% rel_var(+ dplyr::filter(+ |
+ |||
| 388 | ++ |
+ ., |
||||
| 111 | +389 | 3x |
- var_name = "AVALU",+ AVAL == min(AVAL) & |
|||
| 112 | +390 | 3x |
- related_var = "PARAM",+ (AVISIT != "BASELINE" & AVISIT != "SCREENING") & |
|||
| 113 | +391 | 3x |
- var_values = unit_init_list$relvar2+ (ONTRTFL == "Y" | ADTM <= TRTSDTM) |
|||
| 114 | +392 |
- )+ ) |
||||
| 115 | +393 |
-
+ } |
||||
| 116 | +394 |
- # derive AVISITN based AVISIT and AVALC based on AVAL+ } %>% |
||||
| 117 | -3x | +395 | +15x |
- adpp <- adpp %>%+ dplyr::slice(1) %>% |
||
| 118 | -3x | +|||||
| 396 | +
- dplyr::mutate(AVALC = as.character(AVAL)) %>%+ {
|
|||||
| 119 | -3x | +397 | +15x |
- dplyr::mutate(+ if (apply_mutate == TRUE) {
|
||
| 120 | -3x | +398 | +12x |
- AVISITN = dplyr::case_when(+ dplyr::mutate(., new_var = ifelse(is.na(DTYPE), "Y", "")) |
||
| 121 | -3x | +|||||
| 399 | +
- AVISIT == "SCREENING" ~ 0,+ } else {
|
|||||
| 122 | +400 | 3x |
- (grepl("^WEEK", AVISIT) | grepl("^CYCLE", AVISIT)) ~ as.numeric(AVISIT) - 1,
+ dplyr::mutate(., new_var = ifelse(is.na(AVAL) == FALSE & is.na(DTYPE), "Y", "")) |
|||
| 123 | -3x | +|||||
| 401 | +
- TRUE ~ NA_real_+ } |
|||||
| 124 | +402 |
- )+ } %>% |
||||
| 125 | -+ | |||||
| 403 | +15x |
- )+ dplyr::ungroup() |
||||
| 126 | +404 | |||||
| 405 | +15x | +
+ data_compare$new_var <- ifelse(data_compare$row_check %in% data$row_check, "Y", "")+ |
+ ||||
| 127 | +406 |
- # derive REGIMEN variable+ |
||||
| 128 | -3x | +407 | +15x |
- adpp <- adpp %>% dplyr::mutate(REGIMEN = "BID")+ data_compare <- data_compare[, -which(names(data_compare) %in% c("row_check"))]
|
||
| 129 | +408 | |||||
| 409 | +15x | +
+ return(data_compare)+ |
+ ||||
| 130 | +410 |
- # derive PPSTINT and PPENINT based on PARAMCD+ } |
||||
| 131 | -3x | +|||||
| 411 | +
- t1_t2 <- data.frame(+ |
|||||
| 132 | +412 | 3x |
- PARAMCD = c("RCAMINT", "RCAMINT", "RCPCINT", "RCPCINT"),
+ adlb <- flag_variables(adlb, TRUE, "ELSE", FALSE) %>% dplyr::rename(WORS01FL = "new_var") |
|||
| 133 | +413 | 3x |
- PPSTINT = c("P0H", "P0H", "P0H", "P0H"),
+ adlb <- flag_variables(adlb, FALSE, TRUE, TRUE) %>% dplyr::rename(WGRHIFL = "new_var") |
|||
| 134 | +414 | 3x |
- PPENINT = c("P12H", "P24H", "P12H", "P24H")
- |
- |||
| 135 | -- |
- )+ adlb <- flag_variables(adlb, FALSE, FALSE, TRUE) %>% dplyr::rename(WGRLOFL = "new_var") |
||||
| 136 | +415 | 3x |
- adpp <- adpp %>%+ adlb <- flag_variables(adlb, TRUE, TRUE, TRUE) %>% dplyr::rename(WGRHIVFL = "new_var") |
|||
| 137 | +416 | 3x |
- dplyr::left_join(t1_t2, by = c("PARAMCD"), multiple = "all", relationship = "many-to-many")
+ adlb <- flag_variables(adlb, TRUE, FALSE, TRUE) %>% dplyr::rename(WGRLOVFL = "new_var") |
|||
| 138 | +417 | |||||
| 139 | +418 | 3x |
- adpp <- dplyr::inner_join(adpp, adsl, by = c("STUDYID", "USUBJID")) %>%
+ adlb <- adlb %>% dplyr::mutate(ANL01FL = ifelse( |
|||
| 140 | +419 | 3x |
- dplyr::filter(+ (ABLFL == "Y" | (WORS01FL == "Y" & is.na(DTYPE))) & |
|||
| 141 | +420 | 3x |
- ACTARM != "B: Placebo",+ (AVISIT != "SCREENING"), |
|||
| 142 | +421 | 3x |
- !(ACTARM == "A: Drug X" & (PPCAT == "Plasma Drug Y" | PPCAT == "Metabolite Drug Y"))+ "Y", |
|||
| 143 | +422 |
- )+ "" |
||||
| 144 | +423 |
-
+ )) |
||||
| 145 | +424 |
- # derive PKARMCD column for creating more cohorts+ |
||||
| 146 | +425 | 3x |
- adpp <- adpp %>%+ if (length(na_vars) > 0 && na_percentage > 0) {
|
|||
| 147 | -3x | +|||||
| 426 | +! |
- dplyr::mutate(PKARMCD = factor(1 + (seq_len(nrow(adpp)) - 1) %/% (nrow(adpp) / 10), labels = c(+ adlb <- mutate_na(ds = adlb, na_vars = na_vars, na_percentage = na_percentage) |
||||
| 148 | -3x | +|||||
| 427 | +
- "Drug A", "Drug B", "Drug C", "Drug D", "Drug E", "Drug F", "Drug G", "Drug H",+ } |
|||||
| 149 | -3x | +|||||
| 428 | +
- "Drug I", "Drug J"+ |
|||||
| 150 | +429 |
- )))+ # apply metadata |
||||
| 151 | +430 | |||||
| 152 | +431 | 3x |
- if (length(na_vars) > 0 && na_percentage > 0) {
- |
- |||
| 153 | -! | -
- adpp <- mutate_na(ds = adpp, na_vars = na_vars, na_percentage = na_percentage)- |
- ||||
| 154 | -- |
- }+ adlb <- apply_metadata(adlb, "metadata/ADLB.yml") |
||||
| 155 | +432 | |||||
| 156 | -3x | -
- adpp <- apply_metadata(adpp, "metadata/ADPP.yml")- |
- ||||
| 157 | +433 | 3x |
- return(adpp)+ return(adlb) |
|||
| 158 | +434 |
}@@ -40546,7 +40560,7 @@ random.cdisc.data coverage - 98.86% | 85 | 4x |
- adcm <- var_relabel(+ adcm <- rcd_var_relabel( |
|
| 1 |
- #' Questionnaires Analysis Dataset (ADQS)+ #' Tumor Response Analysis Dataset (ADRS) |
|||
| 5 |
- #' Function for generating a random Questionnaires Analysis Dataset for a given+ #' Function for generating a random Tumor Response Analysis Dataset for a given |
|||
| 8 |
- #' @details One record per subject per parameter per analysis visit per analysis date.+ #' @details |
|||
| 9 |
- #'+ #' One record per subject per parameter per analysis visit per analysis date. |
|||
| 10 |
- #' Keys: `STUDYID`, `USUBJID`, `PARAMCD`, `AVISITN`+ #' SDTM variables are populated on new records coming from other single records. |
|||
| 11 |
- #'+ #' Otherwise, SDTM variables are left blank. |
|||
| 12 |
- #' @inheritParams argument_convention+ #' |
|||
| 13 |
- #' @template param_cached+ #' Keys: `STUDYID`, `USUBJID`, `PARAMCD`, `AVISITN`, `ADT`, `RSSEQ` |
|||
| 14 |
- #' @templateVar data adqs+ #' |
|||
| 15 |
- #'+ #' @inheritParams argument_convention |
|||
| 16 |
- #' @return `data.frame`+ #' @param avalc (`character vector`)\cr Analysis value categories. |
|||
| 17 |
- #' @export+ #' @template param_cached |
|||
| 18 |
- #'+ #' @templateVar data adrs |
|||
| 19 |
- #' @author npaszty+ #' |
|||
| 20 |
- #'+ #' @return `data.frame` |
|||
| 21 |
- #' @examples+ #' @export |
|||
| 22 |
- #' adsl <- radsl(N = 10, seed = 1, study_duration = 2)+ #' |
|||
| 23 |
- #'+ #' @examples |
|||
| 24 |
- #' adqs <- radqs(adsl, visit_format = "WEEK", n_assessments = 7L, seed = 2)+ #' adsl <- radsl(N = 10, seed = 1, study_duration = 2) |
|||
| 25 |
- #' adqs+ #' |
|||
| 26 |
- #'+ #' adrs <- radrs(adsl, seed = 2) |
|||
| 27 |
- #' adqs <- radqs(adsl, visit_format = "CYCLE", n_assessments = 3L, seed = 2)+ #' adrs |
|||
| 28 |
- #' adqs+ radrs <- function(adsl, |
|||
| 29 |
- radqs <- function(adsl,+ avalc = NULL, |
|||
| 30 |
- param = c(+ lookup = NULL, |
|||
| 31 |
- "BFI All Questions",+ seed = NULL, |
|||
| 32 |
- "Fatigue Interference",+ na_percentage = 0, |
|||
| 33 |
- "Function/Well-Being (GF1,GF3,GF7)",+ na_vars = list(AVISIT = c(NA, 0.1), AVAL = c(1234, 0.1), AVALC = c(1234, 0.1)), |
|||
| 34 |
- "Treatment Side Effects (GP2,C5,GP5)",+ cached = FALSE) {
|
|||
| 35 | -+ | 7x |
- "FKSI-19 All Questions"+ checkmate::assert_flag(cached) |
|
| 36 | -+ | 7x |
- ),+ if (cached) {
|
|
| 37 | -+ | 1x |
- paramcd = c("BFIALL", "FATIGI", "FKSI-FWB", "FKSI-TSE", "FKSIALL"),
+ return(get_cached_data("cadrs"))
|
|
| 38 |
- visit_format = "WEEK",+ } |
|||
| 39 |
- n_assessments = 5L,+ |
|||
| 40 | -+ | 6x |
- n_days = 5L,+ checkmate::assert_data_frame(adsl) |
|
| 41 | -+ | 6x |
- seed = NULL,+ checkmate::assert_vector(avalc, null.ok = TRUE) |
|
| 42 | -+ | 6x |
- na_percentage = 0,+ checkmate::assert_number(seed, null.ok = TRUE) |
|
| 43 | -+ | 6x |
- na_vars = list(+ checkmate::assert_number(na_percentage, lower = 0, upper = 1) |
|
| 44 | -+ | 6x |
- LOQFL = c(NA, 0.1), ABLFL2 = c(1234, 0.1), ABLFL = c(1235, 0.1),+ checkmate::assert_true(na_percentage < 1) |
|
| 45 |
- CHG2 = c(1235, 0.1), PCHG2 = c(1235, 0.1), CHG = c(1234, 0.1), PCHG = c(1234, 0.1)+ |
|||
| 46 | -+ | 6x |
- ),+ param_codes <- if (!is.null(avalc)) {
|
|
| 47 | -+ | ! |
- cached = FALSE) {
+ avalc |
|
| 48 | -4x | +
- checkmate::assert_flag(cached)+ } else {
|
||
| 49 | -4x | +6x |
- if (cached) {
+ stats::setNames(1:5, c("CR", "PR", "SD", "PD", "NE"))
|
|
| 50 | -1x | +
- return(get_cached_data("cadqs"))
+ } |
||
| 51 |
- }+ |
|||
| 52 | -+ | 6x |
-
+ checkmate::assert_data_frame(lookup, null.ok = TRUE) |
|
| 53 | -3x | +6x |
- checkmate::assert_data_frame(adsl)+ lookup_ars <- if (!is.null(lookup)) {
|
|
| 54 | -3x | +! |
- checkmate::assert_character(param, min.len = 1, any.missing = FALSE)+ lookup |
|
| 55 | -3x | +
- checkmate::assert_character(paramcd, min.len = 1, any.missing = FALSE)+ } else {
|
||
| 56 | -3x | +6x |
- checkmate::assert_string(visit_format)+ expand.grid( |
|
| 57 | -3x | +6x |
- checkmate::assert_integer(n_assessments, len = 1, any.missing = FALSE)+ ARM = c("A: Drug X", "B: Placebo", "C: Combination"),
|
|
| 58 | -3x | +6x |
- checkmate::assert_integer(n_days, len = 1, any.missing = FALSE)+ AVALC = names(param_codes) |
|
| 59 | -3x | +6x |
- checkmate::assert_number(seed, null.ok = TRUE)+ ) %>% dplyr::mutate( |
|
| 60 | -3x | +6x |
- checkmate::assert_number(na_percentage, lower = 0, upper = 1)+ AVAL = param_codes[AVALC], |
|
| 61 | -3x | +6x |
- checkmate::assert_true(na_percentage < 1)+ p_scr = c(rep(0, 3), rep(0, 3), c(1, 1, 1), c(0, 0, 0), c(0, 0, 0)), |
|
| 62 | -+ | 6x |
-
+ p_bsl = c(rep(0, 3), rep(0, 3), c(1, 1, 1), c(0, 0, 0), c(0, 0, 0)), |
|
| 63 | -+ | 6x |
- # validate and initialize param vectors+ 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 | -3x | +6x |
- param_init_list <- relvar_init(param, paramcd)+ 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 | -+ | 6x |
-
+ p_fu = c(c(.3, .2, .4), c(.2, .1, .3), c(.2, .2, .2), c(.3, .5, 0.1), rep(0, 3)) |
|
| 66 | -3x | +
- if (!is.null(seed)) {
+ ) |
||
| 67 | -3x | +
- set.seed(seed)+ } |
||
| 68 |
- }+ |
|||
| 69 | -3x | +6x |
- study_duration_secs <- lubridate::seconds(attr(adsl, "study_duration_secs"))+ if (!is.null(seed)) {
|
|
| 70 | -+ | 6x |
-
+ set.seed(seed) |
|
| 71 | -3x | +
- adqs <- expand.grid(+ } |
||
| 72 | -3x | +6x |
- STUDYID = unique(adsl$STUDYID),+ study_duration_secs <- lubridate::seconds(attr(adsl, "study_duration_secs")) |
|
| 73 | -3x | +
- USUBJID = adsl$USUBJID,+ |
||
| 74 | -3x | +6x |
- PARAM = param_init_list$relvar1,+ adrs <- split(adsl, adsl$USUBJID) %>% |
|
| 75 | -3x | +6x |
- AVISIT = visit_schedule(visit_format = visit_format, n_assessments = n_assessments, n_days = n_days),+ lapply(function(pinfo) {
|
|
| 76 | -3x | +60x |
- stringsAsFactors = FALSE+ probs <- dplyr::filter(lookup_ars, ARM == as.character(pinfo$ACTARM)) |
|
| 77 |
- )+ |
|||
| 78 |
-
+ # screening |
|||
| 79 | -3x | +60x |
- adqs <- dplyr::mutate(+ rsp_screen <- sample(probs$AVALC, 1, prob = probs$p_scr) %>% as.character() |
|
| 80 | -3x | +
- adqs,+ |
||
| 81 | -3x | +
- AVISITN = dplyr::case_when(+ # baseline |
||
| 82 | -3x | +60x |
- AVISIT == "SCREENING" ~ -1,+ rsp_bsl <- sample(probs$AVALC, 1, prob = probs$p_bsl) %>% as.character() |
|
| 83 | -3x | +
- AVISIT == "BASELINE" ~ 0,+ |
||
| 84 | -3x | +
- (grepl("^WEEK", AVISIT) | grepl("^CYCLE", AVISIT)) ~ as.numeric(AVISIT) - 2,
+ # cycle |
||
| 85 | -3x | +60x |
- TRUE ~ NA_real_+ rsp_c2d1 <- sample(probs$AVALC, 1, prob = probs$p_cycle) %>% as.character() |
|
| 86 | -+ | 60x |
- )+ rsp_c4d1 <- sample(probs$AVALC, 1, prob = probs$p_cycle) %>% as.character() |
|
| 87 |
- )+ |
|||
| 88 |
-
+ # end of induction |
|||
| 89 | -+ | 60x |
- # assign related variable values: PARAMxPARAMCD are related+ rsp_eoi <- sample(probs$AVALC, 1, prob = probs$p_eoi) %>% as.character() |
|
| 90 | -3x | +
- adqs <- adqs %>% rel_var(+ |
||
| 91 | -3x | +
- var_name = "PARAMCD",+ # follow up |
||
| 92 | -3x | +60x |
- related_var = "PARAM",+ rsp_fu <- sample(probs$AVALC, 1, prob = probs$p_fu) %>% as.character() |
|
| 93 | -3x | +
- var_values = param_init_list$relvar2+ |
||
| 94 | -+ | 60x |
- )+ best_rsp <- min(param_codes[c(rsp_screen, rsp_bsl, rsp_eoi, rsp_fu, rsp_c2d1, rsp_c4d1)]) |
|
| 95 | -+ | 60x |
-
+ best_rsp_i <- which.min(param_codes[c(rsp_screen, rsp_bsl, rsp_eoi, rsp_fu, rsp_c2d1, rsp_c4d1)]) |
|
| 96 | -3x | +
- adqs$AVAL <- stats::rnorm(nrow(adqs), mean = 50, sd = 8) + adqs$AVISITN * stats::rnorm(nrow(adqs), mean = 5, sd = 2)+ |
||
| 97 | -+ | 60x |
-
+ avisit <- c("SCREENING", "BASELINE", "CYCLE 2 DAY 1", "CYCLE 4 DAY 1", "END OF INDUCTION", "FOLLOW UP")
|
|
| 98 |
- # order to prepare for change from screening and baseline values+ |
|||
| 99 | -3x | +
- adqs <- adqs[order(adqs$STUDYID, adqs$USUBJID, adqs$PARAMCD, adqs$AVISITN), ]+ # meaningful date information |
||
| 100 | -+ | 60x |
-
+ trtstdt <- lubridate::date(pinfo$TRTSDTM) |
|
| 101 | -3x | +60x |
- adqs <- Reduce(+ trtendt <- lubridate::date(dplyr::if_else( |
|
| 102 | -3x | +60x |
- rbind,+ !is.na(pinfo$TRTEDTM), pinfo$TRTEDTM, |
|
| 103 | -3x | +60x |
- lapply(+ lubridate::floor_date(trtstdt + study_duration_secs, unit = "day") |
|
| 104 | -3x | +
- split(adqs, adqs$USUBJID),+ )) |
||
| 105 | -3x | +60x |
- function(x) {
+ scr_date <- trtstdt - lubridate::days(100) |
|
| 106 | -30x | +60x |
- x$STUDYID <- adsl$STUDYID[which(adsl$USUBJID == x$USUBJID[1])]+ bs_date <- trtstdt |
|
| 107 | -30x | +60x |
- x$ABLFL2 <- ifelse(x$AVISIT == "SCREENING", "Y", "")+ flu_date <- sample(seq(lubridate::as_datetime(trtstdt), lubridate::as_datetime(trtendt), by = "day"), size = 1) |
|
| 108 | -30x | +60x |
- x$ABLFL <- ifelse(+ eoi_date <- sample(seq(lubridate::as_datetime(trtstdt), lubridate::as_datetime(trtendt), by = "day"), size = 1) |
|
| 109 | -30x | +60x |
- toupper(visit_format) == "WEEK" & x$AVISIT == "BASELINE",+ c2d1_date <- sample(seq(lubridate::as_datetime(trtstdt), lubridate::as_datetime(trtendt), by = "day"), size = 1) |
|
| 110 | -30x | +60x |
- "Y",+ c4d1_date <- min(lubridate::date(c2d1_date + lubridate::days(60)), trtendt) |
|
| 111 | -30x | +
- ifelse(+ |
||
| 112 | -30x | +60x |
- toupper(visit_format) == "CYCLE" & x$AVISIT == "CYCLE 1 DAY 1",+ tibble::tibble( |
|
| 113 | -30x | +60x |
- "Y",+ STUDYID = pinfo$STUDYID, |
|
| 114 | -+ | 60x |
- ""+ SITEID = pinfo$SITEID, |
|
| 115 | -+ | 60x |
- )+ USUBJID = pinfo$USUBJID, |
|
| 116 | -+ | 60x |
- )+ PARAMCD = as.factor(c(rep("OVRINV", 6), "BESRSPI", "INVET")),
|
|
| 117 | -30x | +60x |
- x$LOQFL <- ifelse(x$AVAL < 32, "Y", "N")+ PARAM = as.factor(dplyr::recode( |
|
| 118 | -30x | +60x |
- x+ PARAMCD, |
|
| 119 | -+ | 60x |
- }+ OVRINV = "Overall Response by Investigator - by visit", |
|
| 120 | -+ | 60x |
- )+ OVRSPI = "Best Overall Response by Investigator (no confirmation required)", |
|
| 121 | -+ | 60x |
- )+ BESRSPI = "Best Confirmed Overall Response by Investigator", |
|
| 122 | -+ | 60x |
-
+ INVET = "Investigator End Of Induction Response" |
|
| 123 | -3x | +
- adqs$BASE2 <- retain(adqs, adqs$AVAL, adqs$ABLFL2 == "Y")+ )), |
||
| 124 | -3x | +60x |
- adqs$BASE <- ifelse(adqs$ABLFL2 != "Y", retain(adqs, adqs$AVAL, adqs$ABLFL == "Y"), NA)+ AVALC = c( |
|
| 125 | -+ | 60x |
-
+ rsp_screen, rsp_bsl, rsp_c2d1, rsp_c4d1, rsp_eoi, rsp_fu, |
|
| 126 | -3x | +60x |
- adqs <- adqs %>%+ names(param_codes)[best_rsp], |
|
| 127 | -3x | +60x |
- dplyr::mutate(CHG2 = AVAL - BASE2) %>%+ rsp_eoi |
|
| 128 | -3x | +
- dplyr::mutate(PCHG2 = 100 * (CHG2 / BASE2)) %>%+ ), |
||
| 129 | -3x | +60x |
- dplyr::mutate(CHG = AVAL - BASE) %>%+ AVAL = param_codes[AVALC], |
|
| 130 | -3x | +60x |
- dplyr::mutate(PCHG = 100 * (CHG / BASE)) %>%+ AVISIT = factor(c(avisit, avisit[best_rsp_i], avisit[5]), levels = avisit) |
|
| 131 | -3x | +
- var_relabel(+ ) %>% |
||
| 132 | -3x | +60x |
- STUDYID = attr(adsl$STUDYID, "label"),+ merge( |
|
| 133 | -3x | +60x |
- USUBJID = attr(adsl$USUBJID, "label")+ tibble::tibble( |
|
| 134 | -+ | 60x |
- )+ AVISIT = avisit, |
|
| 135 | -+ | 60x |
-
+ ADTM = c(scr_date, bs_date, c2d1_date, c4d1_date, eoi_date, flu_date), |
|
| 136 | -3x | +60x |
- adqs <- var_relabel(+ AVISITN = c(-1, 0, 2, 4, 999, 999), |
|
| 137 | -3x | +60x |
- adqs,+ TRTSDTM = pinfo$TRTSDTM |
|
| 138 | -3x | +
- STUDYID = "Study Identifier",+ ) %>% |
||
| 139 | -3x | +60x |
- USUBJID = "Unique Subject Identifier"+ dplyr::mutate( |
|
| 140 | -+ | 60x |
- )+ ADY = ceiling(difftime(ADTM, TRTSDTM, units = "days")) |
|
| 141 |
-
+ ) %>% |
|||
| 142 | -+ | 60x |
- # merge ADSL to be able to add QS date and study day variables+ dplyr::select(-"TRTSDTM"), |
|
| 143 | -3x | +60x |
- adqs <- dplyr::inner_join(+ by = "AVISIT" |
|
| 144 | -3x | +
- adqs,+ ) |
||
| 145 | -3x | +
- adsl,+ }) %>% |
||
| 146 | -3x | +6x |
- by = c("STUDYID", "USUBJID")
+ Reduce(rbind, .) %>% |
|
| 147 | -+ | 6x |
- ) %>%+ dplyr::mutate(AVALC = factor(AVALC, levels = names(param_codes))) %>% |
|
| 148 | -3x | +6x |
- dplyr::rowwise() %>%+ rcd_var_relabel( |
|
| 149 | -3x | +6x |
- dplyr::mutate(TRTENDT = lubridate::date(dplyr::case_when(+ STUDYID = "Study Identifier", |
|
| 150 | -3x | +6x |
- is.na(TRTEDTM) ~ lubridate::floor_date(lubridate::date(TRTSDTM) + study_duration_secs, unit = "day"),+ USUBJID = "Unique Subject Identifier" |
|
| 151 | -3x | +
- TRUE ~ TRTEDTM+ ) |
||
| 152 |
- ))) %>%+ |
|||
| 153 | -3x | +6x |
- ungroup()+ adrs <- rcd_var_relabel( |
|
| 154 | -+ | 6x |
-
+ adrs, |
|
| 155 | -3x | +6x |
- adqs <- adqs %>%+ STUDYID = "Study Identifier", |
|
| 156 | -3x | +6x |
- group_by(USUBJID) %>%+ USUBJID = "Unique Subject Identifier" |
|
| 157 | -3x | +
- arrange(USUBJID, AVISITN) %>%+ ) |
||
| 158 | -3x | +
- dplyr::mutate(ADTM = rep(+ |
||
| 159 | -3x | +
- sort(sample(+ # merge ADSL to be able to add RS date and study day variables |
||
| 160 | -3x | +
- seq(lubridate::as_datetime(TRTSDTM[1]), lubridate::as_datetime(TRTENDT[1]), by = "day"),+ |
||
| 161 | -3x | +
- size = nlevels(AVISIT)+ |
||
| 162 | -+ | 6x |
- )),+ adrs <- dplyr::inner_join( |
|
| 163 | -3x | +6x |
- each = n() / nlevels(AVISIT)+ dplyr::select(adrs, -"SITEID"), |
|
| 164 | -+ | 6x |
- )) %>%+ adsl, |
|
| 165 | -3x | +6x |
- dplyr::ungroup() %>%+ by = c("STUDYID", "USUBJID")
|
|
| 166 | -3x | +
- dplyr::mutate(ADY = ceiling(difftime(ADTM, TRTSDTM, units = "days"))) %>%+ ) |
||
| 167 | -3x | +
- dplyr::select(-TRTENDT) %>%+ |
||
| 168 | -3x | +6x |
- dplyr::arrange(STUDYID, USUBJID, ADTM)+ adrs <- adrs %>% |
|
| 169 | -+ | 6x |
-
+ dplyr::group_by(USUBJID) %>% |
|
| 170 | -3x | +6x |
- adqs <- adqs %>%+ dplyr::mutate(RSSEQ = seq_len(dplyr::n())) %>% |
|
| 171 | -3x | +6x |
- dplyr::group_by(USUBJID) %>%+ dplyr::mutate(ASEQ = RSSEQ) %>% |
|
| 172 | -3x | -
- dplyr::mutate(QSSEQ = seq_len(dplyr::n())) %>%- |
- ||
| 173 | -3x | -
- dplyr::mutate(ASEQ = QSSEQ) %>%- |
- ||
| 174 | -3x | +6x |
dplyr::ungroup() %>% |
|
| 175 | -3x | +173 | +6x |
dplyr::arrange( |
| 176 | -3x | +174 | +6x |
STUDYID, |
| 177 | -3x | +175 | +6x |
USUBJID, |
| 178 | -3x | +176 | +6x |
PARAMCD, |
| 179 | -3x | +177 | +6x |
AVISITN, |
| 180 | -3x | +178 | +6x |
ADTM, |
| 181 | -3x | +179 | +6x |
- QSSEQ+ RSSEQ |
| 182 | +180 |
) |
||
| 183 | +181 | |||
| 184 | -3x | +182 | +6x |
if (length(na_vars) > 0 && na_percentage > 0) {
|
| 185 | +183 | ! |
- adqs <- mutate_na(ds = adqs, na_vars = na_vars, na_percentage = na_percentage)+ adrs <- mutate_na(ds = adrs, na_vars = na_vars, na_percentage = na_percentage) |
|
| 186 | +184 |
} |
||
| 187 | +185 | |||
| 188 | +186 |
# apply metadata |
||
| 189 | -3x | +187 | +6x |
- adqs <- apply_metadata(adqs, "metadata/ADQS.yml")+ adrs <- apply_metadata(adrs, "metadata/ADRS.yml") |
| 190 | +188 | |||
| 191 | -3x | +189 | +6x |
- return(adqs)+ return(adrs) |
| 192 | +190 |
} |