From bd885e3486c7869da3273b15ede05ef5b97f9394 Mon Sep 17 00:00:00 2001 From: Jeremy Wildfire Date: Fri, 26 May 2023 13:26:55 -0400 Subject: [PATCH 1/2] new stack_events function + tests --- NAMESPACE | 2 + R/stack_events.R | 85 ++++++++++++++++++++++++ man/stack_events.Rd | 28 ++++++++ man/standardize_events.Rd | 21 ++++++ tests/testthat/test_stack_events.R | 100 +++++++++++++++++++++++++++++ 5 files changed, 236 insertions(+) create mode 100644 R/stack_events.R create mode 100644 man/stack_events.Rd create mode 100644 man/standardize_events.Rd create mode 100644 tests/testthat/test_stack_events.R diff --git a/NAMESPACE b/NAMESPACE index 9fc2b4f..aac21e3 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -30,8 +30,10 @@ import(Tplyr) import(dplyr) import(ggplot2) import(htmlwidgets) +import(purrr) import(rlang) import(shiny) +import(tidyr) importFrom(huxtable,as_hux) importFrom(huxtable,set_align) importFrom(huxtable,set_bold) diff --git a/R/stack_events.R b/R/stack_events.R new file mode 100644 index 0000000..11c80aa --- /dev/null +++ b/R/stack_events.R @@ -0,0 +1,85 @@ +#' Combine Event Domains +#' +#' @param data safetyGraphics data object +#' @param settings safetyGraphics settings object +#' @param domains list of safetyGraphics domains. Adverse events ('aes'), concominate medications ('cm') and exposure ('ex') included by default. +#' @return combined dataset with stacked AE and CM data + +#' +#' @examples +#' stack_events( +#' ) + +stack_events <- function(data, settings, domains=c("aes","cm", "ex")){ + + all_events <- domains %>% map(function(domain){ + # check it exists in the data + if(!domain %in% names(data)){ + message(paste0("'",domain, "' data not found in data object and will be skipped in stacked event data.")) + return(NULL) + + }else{ + domain_data <- data[[domain]] + domain_settings<- settings[[domain]] + return(standardize_events(domain_data, domain_settings, domain=domain)) + } + + }) %>% bind_rows + + return(all_events) +} + +#' Create a standardized event data set +#' +#' Create an event data set with a standard set of hard-coded column names using standard safetyGraphics settings and data. The settings for each specified domain should contain valid mappings for ID ("id_col"), event start date ("stdy_col") and event end date ("endy_col"). Missing start day and end day values are extrapolated to NA. All other columns specified in settings are collapsed into a single "details" column. The final standardized data contains the following columns: "id", "domain", "stdy", "endy", "details". +#' +#' @param data safetyGraphics data object +#' @param settings safetyGraphics settings object. +#' @param domains list of safetyGraphics domains. Adverse events ('aes'), concominate medications ('cm') and exposure ('ex') included by default. +#' @return combined dataset with stacked AE and CM data +#' +#' @import purrr +#' @import tidyr + +standardize_events <- function(data, settings, domain=""){ + # stop if id_col doesn't exist + stopifnot("id_col" %in% names(settings)) + stopifnot(settings$id_col %in% names(data)) + + # add stdy_col & endy_col if missing + if(!"stdy_col" %in% names(settings)){ + settings$stdy_col <- 'stdy' + data$stdy<-NA + }else{ + stopifnot(settings$stdy_col %in% names(data)) + } + + if(!"endy_col" %in% names(settings)){ + settings$endy_col <- 'endy' + data$endy<-NA + }else{ + stopifnot(settings$endy_col %in% names(data)) + } + + # make a details object with all other columns in settings + cols<-as.character(settings) + details <- data %>% + select(cols) %>% + select(-settings[["id_col"]]) %>% + select(-settings[["stdy_col"]]) %>% + select(-settings[["endy_col"]]) %>% + imap( ~ paste(.y, .x, sep=": ")) %>% + as_tibble %>% + unite("details", sep="\n") + + # get id, start day and end day + event_data <- data %>% select( + id = settings[["id_col"]], + stdy = settings[["stdy_col"]], + endy = settings[["endy_col"]] + ) %>% + bind_cols(details) %>% + mutate(domain = domain) + + return(event_data) +} \ No newline at end of file diff --git a/man/stack_events.Rd b/man/stack_events.Rd new file mode 100644 index 0000000..76dbe86 --- /dev/null +++ b/man/stack_events.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/stack_events.R +\name{stack_events} +\alias{stack_events} +\title{Combine Event Domains} +\usage{ +stack_events(data, settings, domains = c("aes", "cm", "ex")) +} +\arguments{ +\item{data}{safetyGraphics data object} + +\item{settings}{safetyGraphics settings object} + +\item{domains}{list of safetyGraphics domains. Adverse events ('aes'), concominate medications ('cm') and exposure ('ex') included by default.} +} +\value{ +combined dataset with stacked AE and CM data +} +\description{ +Combine Event Domains +} +\examples{ +stack_events( + aes_data = params()$data$aes, + cm_data = params()$data$cm, + settings = params()$settings +) +} diff --git a/man/standardize_events.Rd b/man/standardize_events.Rd new file mode 100644 index 0000000..ef8be68 --- /dev/null +++ b/man/standardize_events.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/stack_events.R +\name{standardize_events} +\alias{standardize_events} +\title{Create a standardized event data set} +\usage{ +standardize_events(data, settings) +} +\arguments{ +\item{data}{safetyGraphics data object} + +\item{settings}{safetyGraphics settings object.} + +\item{domains}{list of safetyGraphics domains. Adverse events ('aes'), concominate medications ('cm') and exposure ('ex') included by default.} +} +\value{ +combined dataset with stacked AE and CM data +} +\description{ +Create an event data set with a standard set of hard-coded column names using standard safetyGraphics settings and data. The settings for each specified domain should contain valid mappings for ID ("id_col"), event start date ("stdy_col") and event end date ("endy_col"). Missing start day and end day values are extrapolated to NA. All other columns specified in settings are collapsed into a single "details" column. The final standardized data contains the following columns: "id", "domain", "stdy", "endy", "details". +} diff --git a/tests/testthat/test_stack_events.R b/tests/testthat/test_stack_events.R new file mode 100644 index 0000000..2117262 --- /dev/null +++ b/tests/testthat/test_stack_events.R @@ -0,0 +1,100 @@ +# Test data + +settings <- list( + aes = list( + id_col = "USUBJID", + bodsys_col = "AEBODSYS", + term_col = "AEDECOD", + term_col = "AETERM", + severity_col = "AESEV", + stdy_col = "AESTDY", + endy_col = "AEENDY" + ), + cm = list( + id_col = "USUBJID", + cmtrt_col = "CMTRT", + stdy_col = "CMSTDY", + endy_col = "CMENDY", + class_col = "CMCLAS", + desc_col = "CMINDC" + ) +) +data <- list(aes=safetyData::sdtm_ae, cm=safetyData::sdtm_cm) + + +# standardize_events tests + +test_that('stops if id_col is missing in settings', { + settings2 <- settings$aes + settings2$id_col <- NULL + expect_error(standardize_events(data$aes, settings2)) +}) + +test_that('stops if id_col in settings is not found in the data', { + settings2$id_col <- "Notanidcol" + expect_error(standardize_events(data$aes, settings2)) +}) + +test_that('stops if stdy_col in settings is not found in the data', { + settings3 <- settings$aes + settings3$stdy_col <- "notacol" + expect_error(standardize_events(data$aes, settings3)) +}) + +test_that('adds col of NA if stdy_col is missing in settings', { + settings3$stdy_col <- NULL + df<-standardize_events(data$aes, settings3) + expect_true(all(is.na(df$stdy))) +}) + +test_that('stops if endy_col in settings is not found in the data', { + settings4 <- settings$aes + settings4$endy_col <- "notacol" + expect_error(standardize_events(data$aes, settings4)) +}) + +test_that('adds col of NA if stdy_col is missing in settings', { + settings4$endy_col <- NULL + df<-standardize_events(data$aes, settings4) + expect_true(all(is.na(df$endy))) +}) + +aedf<-standardize_events(data$aes, settings$aes,domain="aes") +test_that('returns a data.frame with the expected names', { + expect_true(is.data.frame(aedf)) + expect_setequal(names(aedf), c("id","domain","stdy","endy","details")) +}) + +test_that('ae output matches raw data', { + expect_equal(aedf$id, data$aes$USUBJID) + expect_equal(aedf$stdy, data$aes$AESTDY) + expect_equal(aedf$endy, data$aes$AEENDY) +}) + +test_that('ae domain is set correctly',{ + expect_true(all(aedf$domain=="aes")) +}) + + +cmdf<-standardize_events(data$cm, settings$cm, domain="cm") +test_that('cm returns a data.frame with the expected names', { + expect_true(is.data.frame(cmdf)) + expect_setequal(names(cmdf), c("id","domain","stdy","endy","details")) +}) + +#stack events tests + +all<-stack_events(data,settings,domains=c("aes","cm")) +test_that('returns a dataframe with the right rows/cols', { + expect_true(is.data.frame(all)) + expect_setequal(names(all), c("id","domain","stdy","endy","details")) + expect_equal(nrow(all), nrow(data$aes)+nrow(data$cm)) +}) + +all2<-stack_events(data,settings,domains=c("aes","cm","some","other","domains")) +test_that('ignores invalid domains', { + expect_message(stack_events(data,settings,domains=c("aes","cm","some","other","domains"))) + expect_true(is.data.frame(all2)) + expect_setequal(names(all2), c("id","domain","stdy","endy","details")) + expect_equal(nrow(all2), nrow(data$aes)+nrow(data$cm)) +}) \ No newline at end of file From 1997fa6b8720716b326ca6b4fef510f066a6acf9 Mon Sep 17 00:00:00 2001 From: Jeremy Wildfire Date: Fri, 16 Jun 2023 12:42:40 -0400 Subject: [PATCH 2/2] add all_of() --- R/stack_events.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/stack_events.R b/R/stack_events.R index 11c80aa..568fe73 100644 --- a/R/stack_events.R +++ b/R/stack_events.R @@ -64,7 +64,7 @@ standardize_events <- function(data, settings, domain=""){ # make a details object with all other columns in settings cols<-as.character(settings) details <- data %>% - select(cols) %>% + select(all_of(cols)) %>% select(-settings[["id_col"]]) %>% select(-settings[["stdy_col"]]) %>% select(-settings[["endy_col"]]) %>%