Gilead-BioStats · samussiah · Apr 4, 2023 · Apr 3, 2023 · Apr 3, 2023
diff --git a/NAMESPACE b/NAMESPACE
@@ -53,6 +53,7 @@ export(QueryAge_Assess)
 export(QueryAge_Map_Raw)
 export(QueryRate_Assess)
 export(QueryRate_Map_Raw)
+export(Read_Mapping)
 export(RunQTL)
 export(RunStep)
 export(RunStratifiedWorkflow)
@@ -129,6 +130,7 @@ importFrom(purrr,imap)
 importFrom(purrr,imap_dfr)
 importFrom(purrr,iwalk)
 importFrom(purrr,keep)
+importFrom(purrr,list_flatten)
 importFrom(purrr,map)
 importFrom(purrr,map_chr)
 importFrom(purrr,map_dbl)
@@ -170,6 +172,7 @@ importFrom(tidyr,expand_grid)
 importFrom(tidyr,pivot_longer)
 importFrom(tidyr,replace_na)
 importFrom(tidyr,unnest)
+importFrom(tools,file_path_sans_ext)
 importFrom(tools,toTitleCase)
 importFrom(utils,hasName)
 importFrom(utils,head)

diff --git a/R/AE_Map_Adam.R b/R/AE_Map_Adam.R
@@ -45,7 +45,7 @@ AE_Map_Adam <- function(
     dfADSL = safetyData::adam_adsl,
     dfADAE = safetyData::adam_adae
   ),
-  lMapping = yaml::read_yaml(system.file("mappings", "mapping_adam.yaml", package = "gsm")),
+  lMapping = gsm::Read_Mapping("adam"),
   bReturnChecks = FALSE,
   bQuiet = TRUE
 ) {

diff --git a/R/AE_Map_Raw.R b/R/AE_Map_Raw.R
@@ -46,7 +46,7 @@ AE_Map_Raw <- function(
     dfSUBJ = clindata::rawplus_dm,
     dfAE = clindata::rawplus_ae
   ),
-  lMapping = yaml::read_yaml(system.file("mappings", "mapping_rawplus.yaml", package = "gsm")),
+  lMapping = gsm::Read_Mapping("rawplus"),
   bReturnChecks = FALSE,
   bQuiet = TRUE
 ) {

diff --git a/R/Consent_Map_Raw.R b/R/Consent_Map_Raw.R
@@ -47,7 +47,7 @@ Consent_Map_Raw <- function(
     dfSUBJ = clindata::rawplus_dm,
     dfCONSENT = clindata::rawplus_consent
   ),
-  lMapping = yaml::read_yaml(system.file("mappings", "mapping_rawplus.yaml", package = "gsm")),
+  lMapping = gsm::Read_Mapping("rawplus"),
   bReturnChecks = FALSE,
   bQuiet = TRUE
 ) {

diff --git a/R/DataChg_Map_Raw.R b/R/DataChg_Map_Raw.R
@@ -43,7 +43,7 @@ DataChg_Map_Raw <- function(
     dfSUBJ = clindata::rawplus_dm,
     dfDATACHG = clindata::edc_data_points
   ),
-  lMapping = yaml::read_yaml(system.file("mappings", "mapping_edc.yaml", package = "gsm")),
+  lMapping = gsm::Read_Mapping(c("rawplus", "edc")),
   bReturnChecks = FALSE,
   bQuiet = TRUE
 ) {

diff --git a/R/DataEntry_Map_Raw.R b/R/DataEntry_Map_Raw.R
@@ -44,7 +44,7 @@ DataEntry_Map_Raw <- function(
     dfSUBJ = clindata::rawplus_dm,
     dfDATAENT = clindata::edc_data_pages
   ),
-  lMapping = yaml::read_yaml(system.file("mappings", "mapping_edc.yaml", package = "gsm")),
+  lMapping = gsm::Read_Mapping(c("rawplus", "edc")),
   nMaxDataEntryLag = 10,
   bReturnChecks = FALSE,
   bQuiet = TRUE

diff --git a/R/Disp_Map_Raw.R b/R/Disp_Map_Raw.R
@@ -47,7 +47,7 @@ Disp_Map_Raw <- function(
     dfSTUDCOMP = clindata::rawplus_studcomp,
     dfSDRGCOMP = clindata::rawplus_sdrgcomp %>% filter(.data$phase == "Blinded Study Drug Completion")
   ),
-  lMapping = yaml::read_yaml(system.file("mappings", "mapping_rawplus.yaml", package = "gsm")),
+  lMapping = gsm::Read_Mapping("rawplus"),
   strContext = "Study",
   bReturnChecks = FALSE,
   bQuiet = TRUE

diff --git a/R/IE_Map_Raw.R b/R/IE_Map_Raw.R
@@ -45,7 +45,7 @@ IE_Map_Raw <- function(
     dfSUBJ = clindata::rawplus_dm,
     dfIE = clindata::rawplus_ie
   ),
-  lMapping = yaml::read_yaml(system.file("mappings", "mapping_rawplus.yaml", package = "gsm")),
+  lMapping = gsm::Read_Mapping("rawplus"),
   bReturnChecks = FALSE,
   bQuiet = TRUE
 ) {

diff --git a/R/LB_Map_Raw.R b/R/LB_Map_Raw.R
@@ -49,7 +49,7 @@ LB_Map_Raw <- function(
     dfLB = clindata::rawplus_lb
   ),
 
-  lMapping = yaml::read_yaml(system.file("mappings", "mapping_rawplus.yaml", package = "gsm")),
+  lMapping = gsm::Read_Mapping("rawplus"),
   bReturnChecks = FALSE,
   bQuiet = TRUE
 ) {

diff --git a/R/PD_Map_Raw_Binary.R b/R/PD_Map_Raw_Binary.R
@@ -45,7 +45,7 @@ PD_Map_Raw_Binary <- function(
     dfSUBJ = clindata::rawplus_dm,
     dfPD = clindata::ctms_protdev
   ),
-  lMapping = yaml::read_yaml(system.file("mappings", "mapping_ctms.yaml", package = "gsm")),
+  lMapping = gsm::Read_Mapping(c("ctms", "rawplus")),
   bReturnChecks = FALSE,
   bQuiet = TRUE
 ) {

diff --git a/R/PD_Map_Raw_Rate.R b/R/PD_Map_Raw_Rate.R
@@ -45,7 +45,7 @@ PD_Map_Raw_Rate <- function(
     dfSUBJ = clindata::rawplus_dm,
     dfPD = clindata::ctms_protdev
   ),
-  lMapping = yaml::read_yaml(system.file("mappings", "mapping_ctms.yaml", package = "gsm")),
+  lMapping = gsm::Read_Mapping(c("ctms", "rawplus")),
   bReturnChecks = FALSE,
   bQuiet = TRUE
 ) {

diff --git a/R/QueryAge_Map_Raw.R b/R/QueryAge_Map_Raw.R
@@ -46,7 +46,7 @@ QueryAge_Map_Raw <- function(
     dfSUBJ = clindata::rawplus_dm,
     dfQUERY = clindata::edc_queries
   ),
-  lMapping = yaml::read_yaml(system.file("mappings", "mapping_edc.yaml", package = "gsm")),
+  lMapping = gsm::Read_Mapping(c("edc", "rawplus")),
   nMaxQueryAge = 30,
   bReturnChecks = FALSE,
   bQuiet = TRUE

diff --git a/R/QueryRate_Map_Raw.R b/R/QueryRate_Map_Raw.R
@@ -47,7 +47,7 @@ QueryRate_Map_Raw <- function(
     dfQUERY = clindata::edc_queries,
     dfDATACHG = clindata::edc_data_points
   ),
-  lMapping = yaml::read_yaml(system.file("mappings", "mapping_edc.yaml", package = "gsm")),
+  lMapping = gsm::Read_Mapping(c("edc", "rawplus")),
   bReturnChecks = FALSE,
   bQuiet = TRUE
 

diff --git a/R/Read_Mapping.R b/R/Read_Mapping.R
@@ -0,0 +1,51 @@
+#' Read Mapping
+#'
+#' @description
+#' Read default mapping files from `inst/mappings`.
+#'
+#' @param strDomain `character` vector of length 1 or greater. Valid values include: `adam`, `ctms`, `edc`, and `rawplus`. Additionally, for very specific use-cases, `domain` is a valid option.
+#'
+#' @examples
+#' mappings <- Read_Mapping(c("ctms", "rawplus"))
+#'
+#' @return `list` of mappings for each available domain: `ADaM`, `CTMS`, `EDC`, and `rawplus`.
+#'
+#' @importFrom cli cli_alert_danger
+#' @importFrom purrr map list_flatten
+#' @importFrom tools file_path_sans_ext
+#' @importFrom yaml read_yaml
+#'
+#' @export
+Read_Mapping <- function(strDomain = NULL) {
+
+  # regex to read all YAML files that start with "mapping_" inside of `inst/mappings`
+  file_names <- list.files(system.file("mappings", package = "gsm"),
+                           pattern = "^mapping_.*\\.yaml$",
+                           full.names = TRUE)
+
+  # set names of character vector that contains file paths to remove "mapping_domain" by default,
+  # or to only search for values specified in `strDomain` when provided.
+  file_names <- setNames(file_names, tools::file_path_sans_ext(basename(file_names)))
+
+  if (is.null(strDomain)) {
+    file_names <- file_names[!names(file_names) %in% "mapping_domain"]
+  } else {
+    file_names <- file_names[names(file_names) %in% paste0("mapping_", tolower(strDomain))]
+  }
+
+  # if file_names is populated, read those mappings from the directory and stack as a
+  # list of depth 1
+  if (length(file_names) > 0) {
+    purrr::map(file_names, ~yaml::read_yaml(.x)) %>%
+      purrr::list_flatten(name_spec = "{inner}")
+  } else {
+    if (is.null(strDomain)) {
+      cli::cli_alert_danger("No mappings found.")
+    } else {
+      cli::cli_alert_danger("No mappings found with name{?s}: {.arg {strDomain}}.")
+    }
+
+  }
+
+
+}
diff --git a/R/Screening_Map_Raw.R b/R/Screening_Map_Raw.R
@@ -40,7 +40,7 @@ Screening_Map_Raw <- function(
   dfs = list(
     dfENROLL = clindata::rawplus_enroll
   ),
-  lMapping = yaml::read_yaml(system.file("mappings", "mapping_rawplus.yaml", package = "gsm")),
+  lMapping = gsm::Read_Mapping("rawplus"),
   bReturnChecks = FALSE,
   bQuiet = TRUE
 ) {

diff --git a/R/Study_Assess.R b/R/Study_Assess.R
@@ -54,12 +54,7 @@ Study_Assess <- function(
 
   # lMapping from clindata
   if (is.null(lMapping)) {
-    lMapping <- c(
-      yaml::read_yaml(system.file("mappings", "mapping_rawplus.yaml", package = "gsm")),
-      yaml::read_yaml(system.file("mappings", "mapping_ctms.yaml", package = "gsm")),
-      yaml::read_yaml(system.file("mappings", "mapping_edc.yaml", package = "gsm")),
-      yaml::read_yaml(system.file("mappings", "mapping_adam.yaml", package = "gsm"))
-    )
+    lMapping <- gsm::Read_Mapping()
   }
 
   # lAssessments from gsm inst/workflow

diff --git a/R/tests-map_raw_helpers.R b/R/tests-map_raw_helpers.R
@@ -143,8 +143,4 @@ test_logical_parameters <- function(map_function, dfs) {
   )
 }
 
-subset_input_mapping <- function(input_spec, mapping_domain = "mapping_rawplus.yaml") {
-  mapping <- yaml::read_yaml(system.file("mappings", mapping_domain, package = "gsm"))
-  mapping_subset <- mapping[names(input_spec)]
-  return(mapping_subset)
-}
+
diff --git a/inst/mappings/mapping_ctms.yaml b/inst/mappings/mapping_ctms.yaml
@@ -1,18 +1,3 @@
-dfSUBJ:
-  strStudyCol: studyid
-  strSiteCol: siteid
-  strIDCol: subjid
-  strEDCIDCol: subject_nsv
-  strStudyStartDateCol: firstparticipantdate
-  strStudyEndDateCol: lastparticipantdate
-  strTimeOnStudyCol: timeonstudy
-  strTreatmentStartDateCol: firstdosedate
-  strTreatmentEndDateCol: lastdosedate
-  strTimeOnTreatmentCol: timeontreatment
-  strCountryCol: country
-  strCustomGroupCol: invid
-  strEnrollCol: enrollyn
-  strEnrollVal: "Y"
 dfPD:
   strIDCol: SubjectEnrollmentNumber
   strDateCol: DeviationDate

diff --git a/inst/mappings/mapping_edc.yaml b/inst/mappings/mapping_edc.yaml
@@ -1,18 +1,3 @@
-dfSUBJ: # one record per subject
-  strStudyCol: studyid
-  strSiteCol: siteid
-  strIDCol: subjid
-  strEDCIDCol: subject_nsv
-  strStudyStartDateCol: firstparticipantdate
-  strStudyEndDateCol: lastparticipantdate
-  strTimeOnStudyCol: timeonstudy
-  strTreatmentStartDateCol: firstdosedate
-  strTreatmentEndDateCol: lastdosedate
-  strTimeOnTreatmentCol: timeontreatment
-  strCountryCol: country
-  strCustomGroupCol: invid
-  strEnrollCol: enrollyn
-  strEnrollVal: "Y"
 dfQUERY: # one record per query
   strStudyCol: protocolname
   strIDCol: subjectname

diff --git a/man/AE_Map_Adam.Rd b/man/AE_Map_Adam.Rd
diff --git a/man/AE_Map_Raw.Rd b/man/AE_Map_Raw.Rd
diff --git a/man/Consent_Map_Raw.Rd b/man/Consent_Map_Raw.Rd
diff --git a/man/DataChg_Map_Raw.Rd b/man/DataChg_Map_Raw.Rd
diff --git a/man/DataEntry_Map_Raw.Rd b/man/DataEntry_Map_Raw.Rd
diff --git a/man/Disp_Map_Raw.Rd b/man/Disp_Map_Raw.Rd
diff --git a/man/IE_Map_Raw.Rd b/man/IE_Map_Raw.Rd
diff --git a/man/LB_Map_Raw.Rd b/man/LB_Map_Raw.Rd
diff --git a/man/PD_Map_Raw_Binary.Rd b/man/PD_Map_Raw_Binary.Rd
diff --git a/man/PD_Map_Raw_Rate.Rd b/man/PD_Map_Raw_Rate.Rd
diff --git a/man/QueryAge_Map_Raw.Rd b/man/QueryAge_Map_Raw.Rd
diff --git a/man/QueryRate_Map_Raw.Rd b/man/QueryRate_Map_Raw.Rd
diff --git a/man/Read_Mapping.Rd b/man/Read_Mapping.Rd