diff --git a/R/aet01.R b/R/aet01.R index bab1a5fc0b..d74efb1880 100644 --- 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,9 +105,11 @@ 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) %>% @@ -100,35 +117,41 @@ aet01_1_lyt <- function(armvar = .study$armvar, 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,7 +275,8 @@ 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) %>% @@ -246,42 +284,48 @@ aet01_2_lyt <- function(armvar = .study$armvar, 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 new file mode 100644 index 0000000000..9110c62f81 --- /dev/null +++ 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 index 9e0df6dd82..80631dfd6f 100644 --- 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,12 +315,12 @@ 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"), @@ -328,7 +328,7 @@ mutate_for_aet01 <- function(adam_db) { 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 index 678a728144..65e78ddb53 100644 --- 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 index 79f0bb4e10..dc2cfc8347 100644 --- a/man/aet01_1.Rd +++ b/man/aet01_1.Rd @@ -12,7 +12,7 @@ aet01_1( 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, safety_var = c("FATAL", "SER", "SERWD", "SERDSM", "RELSER", "WD", "DSM", "REL", "RELWD", "RELDSM", "SEV")) ) @@ -66,6 +66,7 @@ Overview of death and summary of adverse events. \examples{ library(dm) +library(dplyr) db <- syn_test_data() \%>\% preprocess_data("aet01_1") diff --git a/man/aet01_2.Rd b/man/aet01_2.Rd index 29285abd00..65df68d501 100644 --- a/man/aet01_2.Rd +++ b/man/aet01_2.Rd @@ -12,9 +12,9 @@ aet01_2( 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, safety_var = c("FATAL", "SER", "SERWD", "SERDSM", "RELSER", "WD", "DSM", "REL", "RELWD", "RELDSM", "SEV"), medconcept_var = c("SMQ01", "SMQ02", "CQ01")) diff --git a/man/assert_colnames.Rd b/man/assert_colnames.Rd index 7be69f58cc..afd3ae285f 100644 --- a/man/assert_colnames.Rd +++ b/man/assert_colnames.Rd @@ -1,20 +1,27 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils.R +% Please edit documentation in R/assertions.R \name{assert_colnames} \alias{assert_colnames} \title{Check if strings are column names of a data frame} \usage{ -assert_colnames(df, x) +assert_colnames(df, x, null_ok = TRUE) } \arguments{ -\item{df}{(\verb{data frame})} +\item{df}{(\code{data.frame})} -\item{x}{(\verb{vector of strings})} +\item{x}{(vector of \code{character}) the names of the columns to be checked.} + +\item{null_ok}{(\code{logical}) can \code{x} be NULL.} } \description{ -Check if strings are column names of a data frame +Provides a clearer error message in the case of missing variable. } \examples{ +\dontrun{ +assert_colnames(mtcars, c("speed", "seats"), null_ok = TRUE) + +my_colnames = NULL +assert_colnames(mtcars, my_colnames, null_ok = FALSE) +} -assert_colnames(mtcars, c("mpg", "cyl")) }