136 AET01 problematic preprocessing (#137)

* correct preprocessing * correct table layout * repair several bugs and add error messages * snake_case Co-authored-by: benoit <[email protected]>
insightsengineering · Feb 9, 2022 · 638337d · 638337d
1 parent 694e467
commit 638337d
Show file tree

Hide file tree

Showing 7 changed files with 172 additions and 96 deletions.
diff --git a/R/aet01.R b/R/aet01.R
@@ -18,6 +18,7 @@
 #'
 #' @examples
 #' library(dm)
+#' library(dplyr)
 #'
 #' db <- syn_test_data() %>%
 #'   preprocess_data("aet01_1")
@@ -30,7 +31,7 @@ aet01_1 <- function(adam_db,
                     prune_0 = FALSE,
                     deco = std_deco("AET01"),
                     safety_var = .study$safety_var,
-                    lbl_safety_var = var_labels_for(adam_db$adae, .study$safety_var),
+                    lbl_safety_var = var_labels_for(adam_db$adae, safety_var),
                     .study = list(
                       armvar = "ARM",
                       lbl_overall = NULL,
@@ -40,6 +41,9 @@ aet01_1 <- function(adam_db,
 
   dbsel <- get_db_data(adam_db, "adsl", "adae")
 
+  assert_colnames(dbsel$adsl, c("DTHFL", "DCSREAS"))
+  assert_colnames(dbsel$adae, safety_var)
+
   lyt <- aet01_1_lyt(
     armvar = armvar,
     lbl_overall = lbl_overall,
@@ -48,7 +52,18 @@ aet01_1 <- function(adam_db,
     lbl_safety_var = lbl_safety_var
   )
 
-   tbl <- build_table(lyt, dbsel$adae, alt_counts_df = dbsel$adsl)
+   tbl_adae <- build_table(lyt$lyt_adae, dbsel$adae, alt_counts_df = dbsel$adsl)
+   tbl_adsl <- build_table(lyt$lyt_adsl, dbsel$adsl)
+
+   col_info(tbl_adsl) <- col_info(tbl_adae)
+
+   tbl <- rbind(
+     tbl_adae[1:2, ],
+     tbl_adsl,
+     tbl_adae[3:nrow(tbl_adae), ]
+   )
+
+   tbl <- set_decoration(tbl, deco)
 
    if (prune_0) {
     tbl <- tbl %>% prune_table()
@@ -90,45 +105,53 @@ aet01_1_lyt <- function(armvar = .study$armvar,
                                              "RELWD", "RELDSM", "CTC35", "CTC45", "SEV")
                         )) {
 
+
   names(lbl_safety_var) <- safety_var
 
-  basic_table_deco(deco) %>%
+  lyt_adae <-
+    basic_table_deco(deco) %>%
     split_cols_by(var = armvar) %>%
     add_colcounts() %>%
     ifneeded_add_overall_col(lbl_overall) %>%
     summarize_num_patients(
       var = "USUBJID",
       .stats = c("unique", "nonunique"),
       .labels = c(
-        unique = "  Total number of patients with at least one AE",
-        nonunique = "  Total number of AEs"
+        unique = "Total number of patients with at least one AE",
+        nonunique = "Total number of AEs"
       )
     ) %>%
+    count_patients_with_flags(
+      "USUBJID",
+      flag_variables = lbl_safety_var,
+      denom = "N_col",
+      var_labels = "Total number of patients with at least one",
+      show_labels = "visible",
+      table_names = "AllAE",
+      .indent_mods = 0L
+    )
+
+  lyt_adsl <-
+    basic_table_deco(deco) %>%
+    split_cols_by(var = armvar) %>%
+    add_colcounts() %>%
+    ifneeded_add_overall_col(lbl_overall) %>%
     count_patients_with_event(
       "USUBJID",
       filters = c("DTHFL" = "Y"),
       denom = "N_col",
       .labels = c(count_fraction = "Total number of deaths"),
-      table_names = "TotDeath",
-      .indent_mods = 0L
+      table_names = "TotDeath"
     ) %>%
     count_patients_with_event(
       "USUBJID",
       filters = c("DCSREAS" = "ADVERSE EVENT"),
       denom = "N_col",
       .labels = c(count_fraction = "Total number of patients withdrawn from study due to an AE"),
-      table_names = "TotWithdrawal",
-      .indent_mods = 0L
-    ) %>%
-    count_patients_with_flags(
-    "USUBJID",
-    flag_variables = lbl_safety_var,
-    denom = "N_col",
-    var_labels = "Total number of patients with at least one",
-    show_labels = "visible",
-    table_names = "AllAE",
-    .indent_mods = 0L
-  )
+      table_names = "TotWithdrawal"
+    )
+
+  list(lyt_adae = lyt_adae, lyt_adsl = lyt_adsl)
 }
 
 
@@ -166,9 +189,9 @@ aet01_2 <- function(adam_db,
                     prune_0 = FALSE,
                     deco = std_deco("AET01"),
                     safety_var = .study$safety_var,
-                    lbl_safety_var = var_labels_for(adam_db$adae, .study$safety_var),
+                    lbl_safety_var = var_labels_for(adam_db$adae, safety_var),
                     medconcept_var = .study$medconcept_var,
-                    lbl_medconcept_var = var_labels_for(adam_db$adae, .study$medconcept_var),
+                    lbl_medconcept_var = var_labels_for(adam_db$adae, medconcept_var),
                     .study = list(
                       armvar = "ARM",
                       lbl_overall = NULL,
@@ -179,6 +202,9 @@ aet01_2 <- function(adam_db,
 
   dbsel <- get_db_data(adam_db, "adsl", "adae")
 
+  assert_colnames(dbsel$adsl, c("DTHFL", "DCSREAS"))
+  assert_colnames(dbsel$adae, c(safety_var, medconcept_var))
+
   lyt <- aet01_2_lyt(
     armvar = armvar,
     lbl_overall = lbl_overall,
@@ -189,7 +215,18 @@ aet01_2 <- function(adam_db,
     lbl_medconcept_var = lbl_medconcept_var
   )
 
-   tbl <- build_table(lyt, dbsel$adae, alt_counts_df = dbsel$adsl)
+   tbl_adae <- build_table(lyt$lyt_adae, dbsel$adae, alt_counts_df = dbsel$adsl)
+   tbl_adsl <- build_table(lyt$lyt_adsl, dbsel$adsl)
+
+   col_info(tbl_adsl) <- col_info(tbl_adae)
+
+   tbl <- rbind(
+     tbl_adae[1:2, ],
+     tbl_adsl,
+     tbl_adae[3:nrow(tbl_adae), ]
+   )
+
+   tbl <- set_decoration(tbl, deco)
 
    if (prune_0) {
     tbl <- tbl %>% prune_table()
@@ -238,50 +275,57 @@ aet01_2_lyt <- function(armvar = .study$armvar,
   names(lbl_safety_var) <- safety_var
   names(lbl_medconcept_var) <- medconcept_var
 
-  basic_table_deco(deco) %>%
+  lyt_adae <-
+    basic_table_deco(deco) %>%
     split_cols_by(var = armvar) %>%
     add_colcounts() %>%
     ifneeded_add_overall_col(lbl_overall) %>%
     summarize_num_patients(
       var = "USUBJID",
       .stats = c("unique", "nonunique"),
       .labels = c(
-        unique = "  Total number of patients with at least one AE",
-        nonunique = "  Total number of AEs"
+        unique = "Total number of patients with at least one AE",
+        nonunique = "Total number of AEs"
       )
     ) %>%
+    count_patients_with_flags(
+      "USUBJID",
+      flag_variables = lbl_safety_var,
+      denom = "N_col",
+      var_labels = "Total number of patients with at least one",
+      show_labels = "visible",
+      table_names = "AllAE",
+      .indent_mods = 0L
+    ) %>%
+    count_patients_with_flags(
+      "USUBJID",
+      flag_variables = lbl_medconcept_var,
+      denom = "N_col",
+      var_labels = "Total number of patients with at least one",
+      show_labels = "visible",
+      table_names = "MedConcept",
+      .indent_mods = 0L
+    )
+
+  lyt_adsl <-
+    basic_table_deco(deco) %>%
+    split_cols_by(var = armvar) %>%
+    add_colcounts() %>%
+    ifneeded_add_overall_col(lbl_overall) %>%
     count_patients_with_event(
       "USUBJID",
       filters = c("DTHFL" = "Y"),
       denom = "N_col",
       .labels = c(count_fraction = "Total number of deaths"),
-      table_names = "TotDeath",
-      .indent_mods = 0L
+      table_names = "TotDeath"
     ) %>%
     count_patients_with_event(
       "USUBJID",
       filters = c("DCSREAS" = "ADVERSE EVENT"),
       denom = "N_col",
       .labels = c(count_fraction = "Total number of patients withdrawn from study due to an AE"),
-      table_names = "TotWithdrawal",
-      .indent_mods = 0L
-    ) %>%
-    count_patients_with_flags(
-    "USUBJID",
-    flag_variables = lbl_safety_var,
-    denom = "N_col",
-    var_labels = "Total number of patients with at least one",
-    show_labels = "visible",
-    table_names = "AllAE",
-    .indent_mods = 0L
-  ) %>%
-      count_patients_with_flags(
-    "USUBJID",
-    flag_variables = lbl_medconcept_var,
-    denom = "N_col",
-    var_labels = "Total number of patients with at least one",
-    show_labels = "visible",
-    table_names = "MedConcept",
-    .indent_mods = 0L
-  )
+      table_names = "TotWithdrawal"
+    )
+
+  list(lyt_adae = lyt_adae, lyt_adsl = lyt_adsl)
 }
diff --git a/R/assertions.R b/R/assertions.R
@@ -0,0 +1,50 @@
+# assert_colnames ----
+
+#' Check if strings are column names of a data frame
+#'
+#' Provides a clearer error message in the case of missing variable.
+#'
+#' @param df (`data.frame`)
+#' @param x (vector of `character`) the names of the columns to be checked.
+#' @param null_ok (`logical`) can `x` be NULL.
+#'
+#' @export
+#'
+#' @examples
+#' \dontrun{
+#' assert_colnames(mtcars, c("speed", "seats"), null_ok = TRUE)
+#'
+#' my_colnames = NULL
+#' assert_colnames(mtcars, my_colnames, null_ok = FALSE)
+#' }
+#'
+assert_colnames <- function(df, x, null_ok = TRUE) {
+
+  if (!null_ok && is.null(x)) {
+    stop(
+      paste0(
+        deparse(substitute(x)),
+        " cannot be NULL."
+      ),
+      call. = FALSE
+    )
+  }
+
+  missing_var <- setdiff(x, colnames(df))
+  if (length(missing_var) > 0) {
+    stop(
+      paste0(
+        "Variable(s) not a column name of ",
+        deparse(substitute(df)),
+        ":",
+        paste("\n", missing_var, collapse = ""),
+        "\n [available columns are: ",
+        paste(colnames(df), collapse = ", "),
+        "]"
+      ),
+      call. = FALSE
+    )
+  } else {
+    invisible(TRUE)
+  }
+}
diff --git a/R/standard_data_preprocessing.R b/R/standard_data_preprocessing.R
@@ -195,7 +195,7 @@ std_filter_fun <- function(tlgfname, pmap = std_pmap()) {
 #' @examples
 #' std_mutate_fun("aet02_1")
 std_mutate_fun <- function(tlgfname, pmap = std_pmap()) {
-  lookup_fun(tlgfname, "filter_fname", pmap)
+  lookup_fun(tlgfname, "mutate_fname", pmap)
 }
 
 
@@ -315,20 +315,20 @@ mutate_for_aet01 <- function(adam_db) {
     REL = AREL == "Y",
     RELWD = (AREL == "Y" & AEACN == "DRUG WITHDRAWN"),
     RELDSM = (AREL == "Y" & AEACN %in% c("DRUG INTERRUPTED", "DOSE INCREASED", "DOSE REDUCED")),
-    CTC35 = ATOXGR %in% c("3", "4", "5"),
-    CTC45 = ATOXGR %in% c("4", "5"),
-    SEV = ASEV == "SEVERE",
-    SMQ01 = SMQ01NAM != "",
-    SMQ02 = SMQ02NAM != "",
-    CQ01 = CQ01NAM != ""
+    CTC35 = if ("ATOXGR" %in% colnames(.)) ATOXGR %in% c("3", "4", "5"),
+    CTC45 = if ("ATOXGR" %in% colnames(.)) ATOXGR %in% c("4", "5"),
+    SEV = if ("ASEV" %in% colnames(.)) ASEV == "SEVERE",
+    SMQ01 = if ("SMQ01NAM" %in% colnames(.)) SMQ01NAM != "",
+    SMQ02 = if ("SMQ02NAM" %in% colnames(.)) SMQ02NAM != "",
+    CQ01 = if ("CQ01NAM" %in% colnames(.)) CQ01NAM != ""
     ) %>%
     mutate(
     AEDECOD = with_label(AEDECOD, "Dictionary-Derived Term"),
     AESDTH = with_label(AESDTH, "Results in Death"),
     AEACN = with_label(AEACN, "Action Taken with Study Treatment"),
     FATAL = with_label(FATAL, "AE with fatal outcome"),
     SER = with_label(SER, "Serious AE"),
-    SEV = with_label(SEV, "Severe AE (at greatest intensity)"),
+    SEV = if ("SEV" %in% colnames(.)) with_label(SEV, "Severe AE (at greatest intensity)"),
     SERWD = with_label(SERWD, "Serious AE leading to withdrawal from treatment"),
     SERDSM = with_label(SERDSM, "Serious AE leading to dose modification/interruption"),
     RELSER = with_label(RELSER, "Related Serious AE"),
@@ -337,11 +337,11 @@ mutate_for_aet01 <- function(adam_db) {
     REL = with_label(REL, "Related AE"),
     RELWD = with_label(RELWD, "Related AE leading to withdrawal from treatment"),
     RELDSM = with_label(RELDSM, "Related AE leading to dose modification/interruption"),
-    CTC35 = with_label(CTC35, "Grade 3-5 AE"),
-    CTC45 = with_label(CTC45, "Grade 4/5 AE"),
-    SMQ01 =  with_label(SMQ01, aesi_label(SMQ01NAM, SMQ01SC)),
-    SMQ02 = with_label(SMQ02, aesi_label(SMQ02NAM, SMQ02SC)),
-    CQ01 = with_label(CQ01, aesi_label(CQ01NAM))
+    CTC35 = if ("CTC35" %in% colnames(.)) with_label(CTC35, "Grade 3-5 AE"),
+    CTC45 = if ("CTC45" %in% colnames(.)) with_label(CTC45, "Grade 4/5 AE"),
+    SMQ01 = if ("SMQ01" %in% colnames(.)) with_label(SMQ01, aesi_label(SMQ01NAM, SMQ01SC)),
+    SMQ02 = if ("SMQ02" %in% colnames(.)) with_label(SMQ02, aesi_label(SMQ02NAM, SMQ02SC)),
+    CQ01 = if ("CQ01" %in% colnames(.)) with_label(CQ01, aesi_label(CQ01NAM))
     ) %>%
     dm_update_zoomed()
 

diff --git a/R/utils.R b/R/utils.R
@@ -125,32 +125,6 @@ cut_by_group <- function(df,
   df
 }
 
-
-#' Check if strings are column names of a data frame
-#'
-#' @param df (`data frame`)
-#' @param x (`vector of strings`)
-#'
-#' @export
-#'
-#' @examples
-#'
-#' assert_colnames(mtcars, c("mpg", "cyl"))
-assert_colnames <- function(df, x) {
-  # provide a clearer error message in the case of missing variable
-  missing_var <- setdiff(x, colnames(df))
-  if (length(missing_var) > 0) {
-    stop(paste(
-      "Variable(s) not a column name in",
-      deparse(substitute(df)),
-      ":\n",
-      paste(missing_var, "\n", collapse = "")
-    ))
-  } else {
-    invisible(TRUE)
-  }
-}
-
 #' Reorder PARAM and PARAMCD Levels Simultaneously
 #'
 #' @param df data.frame with PARAM and PARAMCD variables

diff --git a/man/aet01_1.Rd b/man/aet01_1.Rd