Migrate metadata from safetyGraphics to safetyCharts

.Rbuildignore

@@ -18,3 +18,5 @@
 ^rsconnect$
 ^LICENSE\.md$
 
+
+

DESCRIPTION

@@ -44,6 +44,7 @@ Imports:
     shinyjs (>= 2.0.0),
     sortable (>= 0.4.4),
     stringr (>= 1.4.0),
+    tidyr (>= 1.2.0),
     yaml (>= 2.2.1)
 VignetteBuilder: knitr
 Roxygen: list(markdown = TRUE)

NAMESPACE

@@ -21,6 +21,7 @@ export(makeChartExport)
 export(makeChartParams)
 export(makeChartSummary)
 export(makeMapping)
+export(makeMeta)
 export(mappingColumn)
 export(mappingColumnUI)
 export(mappingDomain)
@@ -76,6 +77,8 @@ importFrom(stringr,str_replace_all)
 importFrom(stringr,str_split)
 importFrom(stringr,str_to_title)
 importFrom(stringr,str_to_upper)
+importFrom(tidyr,replace_na)
+importFrom(tidyr,starts_with)
 importFrom(utils,hasName)
 importFrom(utils,zip)
 importFrom(yaml,as.yaml)

R/app_startup.R

@@ -3,7 +3,7 @@
 #' Prepare inputs for safetyGraphics app - run before app is initialized. 
 #' 
 #' @param domainData named list of data.frames to be loaded in to the app. Sample AdAM data from the safetyData package used by default
-#' @param meta data frame containing the metadata for use in the app. See the preloaded file (\code{?safetyGraphics::meta}) for more data specifications and details. Defaults to \code{safetyGraphics::meta}. 
+#' @param meta data frame containing the metadata for use in the app. If no metadata is provided (default value is NULL), metatdata is generated by `makeMeta()`. 
 #' @param charts list of charts in the format produced by safetyGraphics::makeChartConfig()
 #' @param mapping list specifying the initial mapping values for each data mapping for each domain (e.g. list(aes= list(id_col='USUBJID', seq_col='AESEQ')). 
 #' @param autoMapping boolean indicating whether the app should attempt to automatically detect data standards and generate mappings for the data provided. Values specified in the `mapping` parameter overwrite automatically generated mappings when both are found. Defaults to true.
@@ -22,7 +22,7 @@
 #' 
 #' @export
 app_startup<-function(domainData=NULL, meta=NULL, charts=NULL, mapping=NULL, autoMapping=NULL, filterDomain=NULL, chartSettingsPaths=NULL){
-    # Process charts metadata
+    # If charts are not provided, load them from chartSettingsPath or the safetyCharts package
     if(is.null(charts)){
         if(is.null(chartSettingsPaths)){
             charts <- makeChartConfig()
@@ -31,13 +31,8 @@ app_startup<-function(domainData=NULL, meta=NULL, charts=NULL, mapping=NULL, aut
         }
     }
 
-    # Attempt to bind chart functions if none are provided
-    charts <- charts %>% map(function(chart){
-        if(!hasName(chart,"functions")){
-            chart <- prepareChart(chart)
-        } 
-        return(chart)
-    })
+    # Prepare charts - fill in defaults, build metadata, bind functions 
+    charts <- charts %>% map(prepareChart)
 
     # Drop charts where order is negative
     orderDrops <- charts[purrr::map_lgl(charts, function(chart) chart$order < 0)]
@@ -74,6 +69,9 @@ app_startup<-function(domainData=NULL, meta=NULL, charts=NULL, mapping=NULL, aut
         }
     }
 
+    # generate a full list of metadata if none is provided
+    if(is.null(meta)) meta <- makeMeta(charts)
+
     # generate mappings and data standards
     mappingObj <- makeMapping(domainData, meta, autoMapping, mapping)
 

R/detectStandard.R

@@ -5,19 +5,19 @@
 #' This function compares the columns in the provided \code{"data"} with the required columns for a given data standard/domain combination. The function is designed to work with the SDTM and ADaM CDISC(<https://www.cdisc.org/>) standards for clinical trial data by default. Additional standards can be added by modifying the \code{"meta"} data set included as part of this package.
 #'
 #' @param data A data frame in which to detect the data standard - required.
-#' @param meta the metadata containing the data standards. - default = safetyGraphics::meta
+#' @param meta the metadata containing the data standards.
 #' @param domain the domain to evaluate - should match a value of \code{meta$domain}. Uses the first value in \code{meta$domain} if no value is provided. 
 #'
 #' @return A data frame describing the detected standard for each \code{"text_key"} in the provided metadata. Columns are \code{"domain"}, \code{"text_key"}, \code{"column"} and \code{"standard"}.
 #' @examples 
-#' detectStandard(data=safetyData::adam_adae)  #aes domain evaluated by default
-#' detectStandard(data=safetyData::adam_adlbc,domain="labs" ) 
+#' detectStandard(data=safetyData::adam_adae, meta=safetyCharts::meta_aes) 
+#' detectStandard(data=safetyData::adam_adlbc,meta=safetyCharts::meta_labs, domain="labs" ) 
 #'
 #' @importFrom stringr str_detect 
 #' 
 #' @export
 
-detectStandard <- function(data, domain=NULL, meta=safetyGraphics::meta){
+detectStandard <- function(data, domain=NULL, meta=NULL){
   if(is.null(domain)){
     domain<-unique(meta$domain)[1]
   }

R/evaluateStandard.R

@@ -13,15 +13,15 @@
 #' # Match is TRUE
 #' evaluateStandard(
 #'  data=safetyData::adam_adlbc, 
-#'  meta=meta, 
+#'  meta=safetyCharts::meta_labs, 
 #'  domain="labs", 
 #'  standard="adam"
 #' ) 
 #' 
 #' # Match is FALSE
 #' evaluateStandard(
 #'  data=safetyData::adam_adlbc, 
-#'  meta=meta, 
+#'  meta=safetyCharts::meta_labs, 
 #'  domain="labs", 
 #'  standard="sdtm"
 #' ) 
@@ -74,32 +74,43 @@ evaluateStandard <- function(data, meta, domain, standard){
     )%>%
     select(.data$text_key, .data$current, .data$valid)
 
-  stopifnot(nrow(compare_summary[["mapping"]])>0)
-
-  # count valid/invalid data elements
-  compare_summary[["total_count"]] <- compare_summary[["mapping"]] %>% nrow()
-  compare_summary[["valid_count"]] <- compare_summary[["mapping"]] %>% filter(.data$valid) %>% nrow()
-  compare_summary[["invalid_count"]] <- compare_summary[["mapping"]] %>% filter(!.data$valid) %>% nrow()
-  compare_summary[["match_percent"]] <- compare_summary[["valid_count"]] / compare_summary[["total_count"]]
-
-  standard_formatted <- standard
+    standard_formatted <- standard
   if(standard=="adam"){
     standard_formatted = "ADaM"
   }else if(standard=="sdtm"){
     standard_formatted="SDTM"
   }
 
-  if (compare_summary[["invalid_count"]]==0) {
-     compare_summary[["match"]] <- "full"
-     compare_summary[["label"]] <- standard_formatted
-  } else if(compare_summary[["valid_count"]]>0) {
-    compare_summary[["match"]] <- "partial"
-    compare_summary[["label"]] <- paste0("Partial ",standard_formatted)
-    compare_summary[["details"]]<-paste0("(", compare_summary[["valid_count"]], "/" ,compare_summary[["total_count"]], " cols/fields matched)")
-  } else {
+  if(nrow(compare_summary[["mapping"]])>0){
+    # count valid/invalid data elements
+    compare_summary[["total_count"]] <- compare_summary[["mapping"]] %>% nrow()
+    compare_summary[["valid_count"]] <- compare_summary[["mapping"]] %>% filter(.data$valid) %>% nrow()
+    compare_summary[["invalid_count"]] <- compare_summary[["mapping"]] %>% filter(!.data$valid) %>% nrow()
+    compare_summary[["match_percent"]] <- compare_summary[["valid_count"]] / compare_summary[["total_count"]]
+
+    if (compare_summary[["invalid_count"]]==0) {
+      compare_summary[["match"]] <- "full"
+      compare_summary[["label"]] <- standard_formatted
+    } else if(compare_summary[["valid_count"]]>0) {
+      compare_summary[["match"]] <- "partial"
+      compare_summary[["label"]] <- paste0("Partial ",standard_formatted)
+      compare_summary[["details"]]<-paste0("(", compare_summary[["valid_count"]], "/" ,compare_summary[["total_count"]], " cols/fields matched)")
+    } else {
+      compare_summary[["match"]] <- "none"
+      compare_summary[["label"]] <- "No Match"
+    }
+  }else{
+    # No values provided for standard in this domain
+    compare_summary[["total_count"]] <- 0
+    compare_summary[["valid_count"]] <- NA
+    compare_summary[["invalid_count"]] <- NA
+    compare_summary[["match_percent"]] <- 0
     compare_summary[["match"]] <- "none"
     compare_summary[["label"]] <- "No Match"
   }
+
+
+
 
   return(compare_summary)
 }

R/makeMapping.R

@@ -1,7 +1,7 @@
 #' Create data mapping based on data standards and user input
 #' 
 #' @param domainData named list of data.frames to be loaded in to the app. Sample AdAM data from the safetyData package used by default
-#' @param meta data frame containing the metadata for use in the app. See the preloaded file (\code{?safetyGraphics::meta}) for more data specifications and details. Defaults to \code{safetyGraphics::meta}. 
+#' @param meta data frame containing the metadata for use in the app. 
 #' @param customMapping optional list specifying initial mapping values within each data mapping (e.g. list(aes= list(id_col='USUBJID', seq_col='AESEQ')). 
 #' @param autoMapping boolean indicating whether the app should use `safetyGraphics::detectStandard()` to detect data standards and automatically generate mappings for the data provided. Values specified in the `customMapping` parameter overwrite auto-generated mappings when both are found. Defaults to true.
 #' 

R/makeMeta.R

@@ -0,0 +1,106 @@
+#' Create a metadata object table for a set of charts
+#' 
+#' Generates metadata object for a list of charts. `makeMeta()` looks for metadata in 3 locations for each `chart` object:
+#' - Domain-level metadata saved as meta_{chart$name} in the chart$package namespace
+#' - Chart-specific metadata saved as meta_{chart$domain} in the chart$package namespace 
+#' - Chart-specific metadata saved directly to the chart object as chart$meta 
+#' After checking all charts, all metadata files are stacked in to a single dataframe and returned. If duplicate metadata rows (domain + text_key) are found, an error is thrown. 
+#' 
+#' @param charts list of safetyGraphics chart objects for which to create metadata
+#' 
+#' @return tibble of metadata with the following columns:
+#' \describe{
+#'    \item{domain}{Data domain}
+#'    \item{text_key}{Text key indicating the setting name. \code{'--'} delimiter indicates a field level data mapping}
+#'    \item{col_key}{Key for the column mapping}
+#'    \item{field_key}{Key for the field mapping (if any)}
+#'    \item{type}{type of mapping - "field" or "column"}
+#'    \item{label}{Label}
+#'    \item{description}{Description}
+#'    \item{multiple}{Mapping supports multiple columns/fields }
+#'    \item{standard_adam}{Default values for the ADaM data standard}
+#'    \item{standard_sdtm}{Default values for the SDTM data standard}
+#' }   
+#' 
+#' @importFrom tidyr replace_na starts_with
+#' @export
+
+makeMeta <- function(charts){
+    message(paste0("-Generating meta data for ",length(charts), " charts."))
+    # Check each chart to see if {package}::meta_{domain} or {package}::meta_{name} exists
+    sources <- charts %>% map(function(chart){
+        pkg<-ifelse(is.null(chart$package), 'safetyCharts',chart$package)
+        files<-paste0('meta_',c(chart$name, chart$domain)) %>% map(~list(file=.x, pkg=pkg))
+        return(files)
+    }) %>% 
+    flatten %>%
+    unique
+
+    pkg_dfs<-sources %>% map(function(src){
+        packagePath <- paste0('package:',src$pkg)
+        file_found <- exists(
+            src$file,
+            where=packagePath,
+            inherits=FALSE
+        )
+        if(file_found){
+            this_meta <-  get(
+                src$file,
+                pos=packagePath, 
+                inherits=FALSE
+            )
+
+            if(is.data.frame(this_meta)){
+                this_meta <- this_meta%>%            
+                    mutate(source = paste0(src$pkg, "::",src$file))
+                return(this_meta) 
+            } 
+        }
+    })
+
+    ## check for meta bound directly to the charts
+    chart_dfs <- charts %>% map(function(chart){
+        if(is.data.frame(chart$meta)){
+            this_meta <- chart$meta %>% mutate(source = paste0('charts$', chart$name, "$meta"))
+            return(this_meta)
+        }else{
+            if(!is.null(chart$meta)) warning(paste0("Ignoring non-data.frame object found in charts$", chart$name, "$meta"))
+        }
+    })
+
+    ## make sure dfs have required columns
+    dfs<-c(pkg_dfs,chart_dfs)
+    required_cols <- c("domain","text_key","col_key","type")
+    dfs <- dfs%>%
+        keep(is.data.frame)%>%
+        keep(function(df){
+            has_cols <- all(required_cols %in% names(df))
+            if(!has_cols) warning(paste(df[1,'source'],"dropped from meta because of missing required columns.")) 
+            return(has_cols)
+        })
+
+    ## combine list of dfs into single df
+    if(length(dfs)>0){
+        meta<-bind_rows(dfs) 
+        #%>% mutate_at(vars(tidyr::starts_with('standard_')), ~tidyr::replace_na(., ""))
+
+        # Throw error if duplicate records are found
+        dupes <- duplicated(meta%>%select(.data$domain, .data$text_key))
+        if(any(dupes)){
+            dupeIDs <- meta[dupes,]%>%
+                mutate(domain_text_key=paste(.data$domain,.data$text_key,sep="-"))%>%
+                pull(.data$domain_text_key)%>%
+                unique%>%
+                paste(collapse="\n")
+            stop(paste("Duplicate rows in metadata for:\n",dupeIDs))
+        } 
+
+        sources <- meta %>% pull(source) %>% unique %>% paste(collapse=" ")
+        message(paste0("-Meta object created using the following source(s): ",sources))
+        return(meta)
+    } else {
+        stop("No metadata found. ")
+    }
+
+}
+

R/mod_safetyGraphicsServer.R

@@ -5,7 +5,7 @@
 #' @param input Shiny input object
 #' @param output Shiny output object
 #' @param session Shiny session object
-#' @param meta data frame containing the metadata for use in the app. See the preloaded file (\code{?safetyGraphics::meta}) for more data specifications and details. Defaults to \code{safetyGraphics::meta}. 
+#' @param meta data frame containing the metadata for use in the app.
 #' @param domainData named list of data.frames to be loaded in to the app.
 #' @param mapping current mapping
 #' @param charts list of charts to include in the app

R/mod_safetyGraphicsUI.R

@@ -2,7 +2,7 @@
 #'
 #'
 #' @param id module ID
-#' @param meta data frame containing the metadata for use in the app. See the preloaded file (\code{?safetyGraphics::meta}) for more data specifications and details. Defaults to \code{safetyGraphics::meta}. 
+#' @param meta data frame containing the metadata for use in the app. 
 #' @param domainData named list of data.frames to be loaded in to the app.
 #' @param mapping data.frame specifying the initial values for each data mapping. If no mapping is provided, the app will attempt to generate one via \code{detectStandard()}
 #' @param standards a list of information regarding data standards. Each list item should use the format returned by safetyGraphics::detectStandard.