Merge pull request #22 from Merck/20-add-discontinued-reason-for-disp…

…osition-table

Add caluculation logic for a lower level variable

R/collect.R

@@ -59,6 +59,7 @@ collect_baseline <- function(
   # Obtain variables
   par_var <- metalite::collect_adam_mapping(meta, parameter)$var
   par_var_group <- metalite::collect_adam_mapping(meta, parameter)$vargroup
+  par_var_lower <- metalite::collect_adam_mapping(meta, parameter)$var_lower
 
   # Obtain Data
   pop <- metalite::collect_population_record(meta, population, var = c(par_var))
@@ -198,6 +199,60 @@ collect_baseline <- function(
     pop_prop <- rbind(pop_prop_group, pop_prop)
   }
 
+  # variable lower level
+  if (!is.null(par_var_lower)) {
+
+    # Obtain number of subjects
+    pop_num_lower <- apply(pop_num, 1, function (x) {
+      pop_lower <- pop[pop[[par_var]] == x[["name"]] & !is.na(pop[[par_var_lower]]), ]
+      id_lower <- seq(pop_lower[[pop_id]])
+      group_lower <- pop_lower[[pop_group]]
+      varlower <- pop_lower[[par_var_lower]]
+      stopifnot(inherits(varlower, c("factor", "character")))
+      varlower <- factor(varlower, exclude = NULL)
+
+      if (length(varlower) > 0) {
+        lower <- metalite::n_subject(id_lower, group_lower, par = varlower)
+        max_length <- sapply(pop_num, function(x) max(nchar(x)))
+        for (i in 2:length(max_length)) {
+          lower[[i]] <- formatC(lower[[i]], width = max_length[[i]])
+        }
+
+        lower$name <- paste("   ", lower$name)
+        rbind(x, lower)
+      } else {
+        as.data.frame(t(x))
+      }
+    })
+    pop_num <- do.call(rbind, pop_num_lower)
+
+    # Obtain proportion
+    pop_prop_lower <- apply(pop_prop, 1, function (x) {
+      pop_lower <- pop[pop[[par_var]] == x[["name"]] & !is.na(pop[[par_var_lower]]), ]
+      id_lower <- seq(pop_lower[[pop_id]])
+      group_lower <- pop_lower[[pop_group]]
+      varlower <- pop_lower[[par_var_lower]]
+      stopifnot(inherits(varlower, c("factor", "character")))
+      varlower <- factor(varlower, exclude = NULL)
+
+      if (length(varlower) > 0) {
+        lower <- metalite::n_subject(id_lower, group_lower, par = varlower)
+        for (i in seq(names(lower))) {
+          if ("integer" %in% class(lower[[i]])) {
+            pct <- lower[[i]] / pop_all[[i]] * 100
+            lower[[i]] <- pct
+          }
+        }
+        lower$name <- paste("   ", lower$name)
+        rbind(x, lower)
+      } else {
+        as.data.frame(t(x))
+      }
+    })
+    pop_prop <- do.call(rbind, pop_prop_lower)
+
+  }
+
   pop_n["var_label"] <- label
   pop_num["var_label"] <- label
   pop_prop["var_label"] <- label

R/meta_sl_example.R

@@ -39,10 +39,16 @@ meta_sl_example <- function() {
   adsl$EOSSTT <- sample(x = c("Participants Ongoing", "Discontinued"),
                         size = length(adsl$USUBJID), 
                         prob = c(0.8, 0.2), replace = TRUE)
+  adsl[adsl[["EOSSTT"]] == "Discontinued", "DCSREAS"] <- sample(x = c("Adverse Event", "I/E Not Met", "Withdrew Consent", "Lack of Efficacy"),
+                                                                size = length(adsl[adsl[["EOSSTT"]] == "Discontinued", "USUBJID"]), 
+                                                                prob = c(0.7, 0.1, 0.1, 0.1), replace = TRUE)
   # Create a variable EOTSTT1 indicating the end of treatment status part 1
   adsl$EOTSTT1 <- sample(x = c("Completed", "Discontinued"),
                          size = length(adsl$USUBJID), 
                          prob = c(0.85, 0.15), replace = TRUE)
+  adsl[adsl[["EOTSTT1"]] == "Discontinued", "DCTREAS"] <- sample(x = c("Adverse Event", "Lack of Efficacy"),
+                                                                size = length(adsl[adsl[["EOTSTT1"]] == "Discontinued", "USUBJID"]), 
+                                                                prob = c(0.9, 0.1), replace = TRUE)
 
   plan <- metalite::plan(
     analysis = "base_char", population = "apat",
@@ -66,7 +72,7 @@ meta_sl_example <- function() {
       name = "apat",
       group = "TRTA",
       subset = quote(SAFFL == "Y"),
-      var = c("USUBJID", "TRTA", "SAFFL", "AGEGR1", "SEX", "RACE", "EOSSTT", "EOTSTT1", "COMP8FL", "COMP16FL", "COMP24FL")
+      var = c("USUBJID", "TRTA", "SAFFL", "AGEGR1", "SEX", "RACE", "EOSSTT", "EOTSTT1", "DCSREAS", "DCTREAS", "COMP8FL", "COMP16FL", "COMP24FL")
     ) |>
     metalite::define_parameter(
       name = "age",
@@ -87,12 +93,14 @@ meta_sl_example <- function() {
     metalite::define_parameter(
       name = "disposition",
       var = "EOSSTT",
-      label = "Trial Disposition"
+      label = "Trial Disposition",
+      var_lower = "DCSREAS"
     ) |>
     metalite::define_parameter(
       name = "medical-disposition",
       var = "EOTSTT1",
-      label = "Participant Study Medication Disposition"
+      label = "Participant Study Medication Disposition",
+      var_lower = "DCTREAS"
     ) |>
     metalite::define_parameter(
       name = "comp8",