diff --git a/.gitignore b/.gitignore index cd67eac..aef76f8 100644 --- a/.gitignore +++ b/.gitignore @@ -1 +1,3 @@ .Rproj.user +.Rhistory +.Rdata diff --git a/DESCRIPTION b/DESCRIPTION index 4c83b0b..69f341d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -14,3 +14,6 @@ License: MIT + file LICENSE Encoding: UTF-8 Roxygen: list(markdown = TRUE) RoxygenNote: 7.2.1 +Depends: + R (>= 2.10) +LazyData: true diff --git a/R/getDefaultData.R b/R/getDefaultData.R new file mode 100644 index 0000000..421da19 --- /dev/null +++ b/R/getDefaultData.R @@ -0,0 +1,17 @@ +getDefaultData <- function(standard) { + data <- list() + + if (standard == 'sdtm') { + data$aes <- safetyData::sdtm_ae + data$dm <- safetyData::sdtm_dm + data$labs <- safetyData::sdtm_lb + } + + if (standard == 'adam') { + data$aes <- safetyData::adam_adae + data$dm <- safetyData::adam_adsl + data$labs <- safetyData::adam_adlbc + } + + data +} diff --git a/R/getDefaultSettings.R b/R/getDefaultSettings.R new file mode 100644 index 0000000..69313a0 --- /dev/null +++ b/R/getDefaultSettings.R @@ -0,0 +1,63 @@ +getDefaultSettings <- function(standard) { + settings <- list() + + if (standard == 'sdtm') { + settings$aes <- list( + id_col = "USUBJID", + stdt_col = "AESTDTC", + endt_col = "AEENDTC", + stdy_col = NULL, + endy_col = NULL, + aeterm_col = "AETERM", + decod_col = 'AEDECOD', + bodsys_col = "AEBODSYS", + severity_col = "AESEV" + ) + + settings$dm <- list( + id_col = "USUBJID", + reference_date_col = 'RFSTDTC', + treatment_col = "ARM" + ) + + settings$labs <- list( + id_col = "USUBJID", + visit_col = 'VISIT', + visit_order_col = 'VISITNUM', + dt_col = 'LBDTC', + dy_col = NULL, + result_col = 'LBSTRESN' + ) + } + + if (standard == 'adam') { + settings$aes <- list( + id_col = "USUBJID", + stdt_col = 'ASTDT', + endt_col = 'AENDT', + stdy_col = "ASTDY", + endy_col = "AENDY", + aeterm_col = "AETERM", + decod_col = 'AEDECOD', + bodsys_col = "AEBODSYS", + severity_col = "AESEV" + ) + + settings$dm <- list( + id_col = "USUBJID", + reference_date_col = 'TRTSDT', + treatment_col = "TRT01P" + ) + + settings$labs <- list( + id_col = "USUBJID", + visit_col = 'AVISIT', + visit_order_col = 'AVISITN', + dt_col = 'ADT', + dy_col = 'ADY', + result_col = 'AVAL' + ) + } + + settings +} diff --git a/R/getSDTMTiming.R b/R/getSDTMTiming.R new file mode 100644 index 0000000..8114cd7 --- /dev/null +++ b/R/getSDTMTiming.R @@ -0,0 +1,45 @@ +getSDTMTiming <- function() { + stopifnot( + '[ standard ] must be a character-classed variable.' = + class(standard) == 'character', + '[ standard ] must be one of "sdtm", "adam", "custom".' = + tolower(standard) %in% c('sdtm', 'adam', 'custom') + ) + + standard <- tolower(standard) + + ## Create list of default data when undefined. + if (is.null(data)) + data <- getDefaultData(standard) + + ## Create list of default settings when undefined. + if (is.null(settings)) + settings <- getDefaultSettings(standard) + + ## Calculate study timing. + if (standard == 'sdtm') { + data$aes <- getTiming( + params = list( + data = data, + settings = settings, + standard = standard + ), + 'aes', + domainStartDate = settings$aes$stdt_col, + domainEndDate = settings$aes$endt_col + ) + settings$aes$stdy_col <- paste0(settings$aes$stdt_col, '_dy') + settings$aes$endy_col <- paste0(settings$aes$endt_col, '_dy') + + data$labs <- getTiming( + params = list( + data = data, + settings = settings, + standard = standard + ), + 'labs', + domainDate = settings$labs$dt_col + ) + settings$labs$dy_col <- paste0(settings$labs$dt_col, '_dy') + } +} diff --git a/R/getTiming.R b/R/getTiming.R new file mode 100644 index 0000000..894c67b --- /dev/null +++ b/R/getTiming.R @@ -0,0 +1,59 @@ +#' Calculate reference timepoint. +#' +#' @param params `list` Reactive list of input data and mappings +#' @param domain `character` Name of data domain with which to calculate reference timepoint +#' @param domainDate `character` Name of date column with which to calculate reference timepoint +#' @param reference `character` Name of data reference with which to calculate reference timepoint +#' @param referenceDate `character` Name of date column with which to calculate reference timepoint + +getTiming <- function( + params, + domain, + domainDate = NULL, + refDomain = 'dm', + refDate = 'RFSTDTC', + domainStartDate = NULL, + domainEndDate = NULL +) { + # TODO: add stopifnot() logic + + id_col <- params$settings[[ refDomain ]]$id_col + + ref_data <- params$data[[ refDomain ]] %>% + select( + id_col, refDate + ) %>% + mutate( + # TODO: add logic around date format... lubridate::ymd? + refDate = as.Date(.data[[ refDate ]]) + ) + + domain_data <- params$data[[ domain ]] %>% + left_join( + ref_data, + id_col + ) + + getStudyDay <- function(data, date_col) { + data[[ date_col ]] <- as.Date(data[[ date_col ]]) + + data[[ paste0(date_col, '_dy') ]] <- as.numeric( + data[[ date_col ]] - data$refDate + ) + ( + data[[ date_col ]] >= data$refDate + ) + + data + } + + if (!is.null(domainDate)) + domain_data <- getStudyDay(domain_data, domainDate) + + if (!is.null(domainStartDate)) + domain_data <- getStudyDay(domain_data, domainStartDate) + + if (!is.null(domainEndDate)) + domain_data <- getStudyDay(domain_data, domainEndDate) + + domain_data +} diff --git a/R/profileApp.R b/R/profileApp.R index a6218c2..d93661f 100644 --- a/R/profileApp.R +++ b/R/profileApp.R @@ -1,24 +1,49 @@ #' Safety Profile App #' -#' @param dfAE AE Data -#' @param dfDemog demog data -#' @param settings safetyGraphics settings -#' @param ptid participant ID to select when app is initialized +#' @param data `list` Named list of data domains +#' @param settings `list` Named list of data mappings +#' @param ptid `character` Initially selected participant ID +#' @param standard `character` Name of data standard +#' - "adam" (default) +#' - "sdtm" +#' - "custom" +#' @param runNow `logical` Run app? #' +#' @return `shiny.appobj` Shiny app +#' +#' @importFrom dplyr filter #' @import shiny #' #' @export profileApp <- function( - data = list( - aes = safetyData::adam_adae, - dm = safetyData::adam_adsl, - labs = safetyData::adam_adlbc %>% filter(PARAMCD %in% c("PHOS", "GLUC", "PROT")) - ), - settings = NULL, - ptid = NULL, - runNow = TRUE + data = list( + aes = safetyData::adam_adae, + dm = safetyData::adam_adsl, + labs = safetyData::adam_adlbc %>% + filter(PARAMCD %in% c("PHOS", "GLUC", "PROT")) + ), + settings = NULL, + ptid = NULL, + standard = 'adam', + runNow = TRUE ) { + stopifnot( + '[ standard ] must be a character-classed variable.' = + class(standard) == 'character', + '[ standard ] must be one of "sdtm", "adam", "custom".' = + tolower(standard) %in% c('sdtm', 'adam', 'custom') + ) + + standard <- tolower(standard) + + # TODO: use default data given standard + if (is.null(data)) + settings <- safetyProfile::example_data[[ standard ]] + + # TODO: make sure settings work + if (is.null(settings)) + settings <- safetyProfile::mapping[[ standard ]] ## create default settings when settings is not defined by default if (is.null(settings)) { @@ -49,11 +74,12 @@ profileApp <- function( ) } - ## create object containing data and setting to pass to server + ## Create reactive list of data and settings to pass to server params <- reactive({ list( data = data, - settings = settings + settings = settings, + standard = standard ) }) @@ -74,8 +100,8 @@ profileApp <- function( } ) - # if(runNow) - runApp(app) - # else - # app + if (runNow) + runApp(app) + + return(app) } diff --git a/data-raw/mapping.R b/data-raw/mapping.R new file mode 100644 index 0000000..ab11f80 --- /dev/null +++ b/data-raw/mapping.R @@ -0,0 +1,21 @@ +library(dplyr) +library(purrr) + +mapping_sdtm <- read.csv("data-raw/mapping_sdtm.csv") +mapping_adam <- read.csv("data-raw/mapping_adam.csv") + +usethis::use_data(mapping_sdtm, overwrite = TRUE) +usethis::use_data(mapping_adam, overwrite = TRUE) + +mapping <- bind_rows(mapping_sdtm, mapping_adam) %>% + split(.$standard) %>% + map(function(standard) { + standard %>% + split(.$domain) %>% + map(function(domain) { + as.list(domain$value) %>% + setNames(domain$key) + }) + }) + +usethis::use_data(mapping, overwrite = TRUE) diff --git a/data-raw/mapping_adam.csv b/data-raw/mapping_adam.csv new file mode 100644 index 0000000..6ca2a9a --- /dev/null +++ b/data-raw/mapping_adam.csv @@ -0,0 +1,19 @@ +standard,domain,key,value +adam,aes,id_col,USUBJID +adam,aes,stdt_col,ASTDT +adam,aes,endt_col,AENDT +adam,aes,stdy_col,ASTDY +adam,aes,endy_col,AENDY +adam,aes,aeterm_col,AETERM +adam,aes,decod_col,AEDECOD +adam,aes,bodsys_col,AEBODSYS +adam,aes,severity_col,AESEV +adam,dm,id_col,USUBJID +adam,dm,reference_date_col,TRTSDT +adam,dm,treatment_col,TRT01P +adam,labs,id_col,USUBJID +adam,labs,visit_col,AVISIT +adam,labs,visit_order_col,AVISITN +adam,labs,dt_col,ADT +adam,labs,dy_col,ADY +adam,labs,result_col,AVAL diff --git a/data-raw/mapping_sdtm.csv b/data-raw/mapping_sdtm.csv new file mode 100644 index 0000000..2688e30 --- /dev/null +++ b/data-raw/mapping_sdtm.csv @@ -0,0 +1,16 @@ +standard,domain,key,value +sdtm,aes,id_col,USUBJID +sdtm,aes,stdt_col,AESTDTC +sdtm,aes,endt_col,AEENDTC +sdtm,aes,aeterm_col,AETERM +sdtm,aes,decod_col,AEDECOD +sdtm,aes,bodsys_col,AEBODSYS +sdtm,aes,severity_col,AESEV +sdtm,dm,id_col,USUBJID +sdtm,dm,reference_date_col,RFSTDTC +sdtm,dm,treatment_col,ARM +sdtm,labs,id_col,USUBJID +sdtm,labs,visit_col,VISIT +sdtm,labs,visit_order_col,VISITNUM +sdtm,labs,dt_col,LBDTC +sdtm,labs,result_col,LBSTRESN diff --git a/data/mapping.rda b/data/mapping.rda new file mode 100644 index 0000000..cd4566c Binary files /dev/null and b/data/mapping.rda differ diff --git a/data/mapping_adam.rda b/data/mapping_adam.rda new file mode 100644 index 0000000..3b46a98 Binary files /dev/null and b/data/mapping_adam.rda differ diff --git a/data/mapping_sdtm.rda b/data/mapping_sdtm.rda new file mode 100644 index 0000000..46b6c00 Binary files /dev/null and b/data/mapping_sdtm.rda differ