Dev v0.8.0

R/generateSettings.R

@@ -7,15 +7,16 @@
 #' @param standard The data standard for which to create settings. Valid options are "SDTM", "AdAM" or "None". Default: \code{"SDTM"}
 #' @param chart The chart for which standards should be generated ("eDish" only for now) . Default: \code{"eDish"}.
 #' @param partial Boolean for whether or not the standard is a partial standard. Default: \code{FALSE}.
-#' @param partial_cols Optional character vector of the matched cols if partial is TRUE. It will not be used if partial is FALSE Default: \code{NULL}.
+#' @param partial_keys Optional character vector of the matched settings if partial is TRUE. Settings should be identified using the text_key format described in ?settingsMetadata. Setting is ignored when partial is FALSE. Default: \code{NULL}.
 #' @return A list containing the appropriate settings for the selected chart
 #' 
 #' @examples 
 #' 
 #' generateSettings(standard="SDTM") 
 #' generateSettings(standard="SdTm") #also ok
-#' generateSettings(standard="SDTM", partial=TRUE, partial_cols = c("USUBJID","TEST","STRESN"))
 #' generateSettings(standard="ADaM")
+#' pkeys<- c("id_col","measure_col","value_col")
+#' generateSettings(standard="adam", partial=TRUE, partial_keys=pkeys)
 #' 
 #' generateSettings(standard="a different standard") 
 #' #returns shell settings list with no data mapping
@@ -30,26 +31,40 @@
 #' 
 #' @export
 
-generateSettings <- function(standard="None", chart="eDish", partial=FALSE, partial_cols=NULL){
+generateSettings <- function(standard="None", chart="eDish", partial=FALSE, partial_keys=NULL){
   if(tolower(chart)!="edish"){
     stop(paste0("Can't generate settings for the specified chart ('",chart,"'). Only the 'eDish' chart is supported for now."))
   }
 
-  # Check that partial_cols is supplied if partial is true
-  if  (is.null(partial_cols) & partial ) {
-    stop("partial_cols must be supplied if the standard is partial")
+  # Check that partial_keys is supplied if partial is true
+  if  (is.null(partial_keys) & partial ) {
+    stop("partial_keys must be supplied if the standard is partial")
   }
 
-  metadata <- safetyGraphics::getSettingsMetadata(
-    charts = chart, 
-    cols=c("text_key","adam","sdtm"),
-    filter_expr = .data$adam != '' & .data$sdtm != '' 
-  )
-
-  # Split on -- for multi-level handling 
-  hierarchical_metadata <- str_split(metadata$text_key, "--") 
+  # Coerce options to lowercase
+  standard<-tolower(standard)
+  chart<-tolower(chart)
+
+  # Build a table of data mappings for the selected standard and partial settings
+  standardList<-c("adam","sdtm") #TODO: automatically generate this from metadata
+  if(standard %in% standardList){
+    dataMappings <- safetyGraphics::getSettingsMetadata(
+      charts = chart, 
+      cols=c("text_key",standard,"setting_required")
+    ) %>% 
+    filter(.data$setting_required)%>%
+    rename("column_name" = standard)%>%
+    filter(.data$column_name != '')
+
+    if(partial){
+      dataMappings<-dataMappings%>%filter(.data$text_key %in% partial_keys) 
+    }
+  }
 
-  settings<-list(
+  # build shell settings for each chart 
+  # TODO: move these to `/data` eventually
+  shells<-list()
+  shells[["edish"]]<-list(
     id_col = NULL,
     value_col = NULL,
     measure_col = NULL,
@@ -69,7 +84,7 @@ generateSettings <- function(standard="None", chart="eDish", partial=FALSE, part
     analysisFlag = list(value_col=NULL,
                         values=list()),
 
-    x_options = c("LT", "AST", "ALP"),
+    x_options = c("ALT", "AST", "ALP"),
     y_options = c("TB", "ALP"),
     visit_window = 30,
     r_ratio_filter = TRUE,
@@ -78,42 +93,12 @@ generateSettings <- function(standard="None", chart="eDish", partial=FALSE, part
     warningText = "Caution: This interactive graphic is not validated. Any clinical recommendations based on this tool should be confirmed using your organizations standard operating procedures."
   )
 
-  potential_settings <- settings
-
-  standard_low <- tolower(standard)
-
-  if (standard_low == "adam" | standard_low == "sdtm") {
-
-  for (row in hierarchical_metadata)  {
-    if (length(row) == 1) {
-      potential_settings[row] <- filter(metadata,.data$text_key == !!row)[[standard_low]]
-    } else if (length(row) == 2) {
-      potential_settings[row[[1]]][[1]][row[[2]]] <- filter(metadata, grepl(!!row[[2]],.data$text_key))[[standard_low]]
-    } else{
-      stop("Three level setting nests are not currently supported")
-    }
-
-  }
-
-  }
-
-  if(partial) {
-
-    settings_names <- names(settings)
-
-    potential_names <- names(potential_settings)
-
-    for(i in 1:length(settings)) {
-      if (potential_settings[i] %in% partial_cols) {
-        settings[[which(settings_names == potential_names[i])]] <- potential_settings[[i]]
-      }
-    }
-
-  } else {
-
-    settings <- potential_settings
-
+  # loop through dataMappings and apply them to the shell
+  if(standard %in% standardList){
+    for(row in 1:nrow(dataMappings)){
+      shells[[chart]]<-setSettingsValue(settings = shells[[chart]], key = textKeysToList(dataMappings[row,"text_key"])[[1]], value = dataMappings[row, "column_name"])
+    }    
   }
-  
-  return(settings)
+
+  return(shells[[chart]])
 }

R/setSettingsValue.R

@@ -0,0 +1,37 @@
+#' Set the value for a given named parameter
+#'
+#' Sets the value for a named parameter (\code{key}) to given \code{value} in a list (\code{settings})
+#'
+#' @param key a list (like those provided by \code{getSettingKeys()}) defining the position of parameter in the settings object. 
+#' @param value the value to set
+#' @param settings The settings list used to generate a chart like \code{eDISH()}
+#' @return the updated settings object
+#' 
+#' @examples 
+#' testSet<-list(a=list(b="myValue"))
+#' safetyGraphics:::setSettingsValue(key=list("a","b"), value="notMyValue", settings=testSet) 
+#' #returns list(a=list(b="notMyValue")))
+#' 
+#' adamSettings<-generateSettings(standard="AdAM")
+#' safetyGraphics:::setSettingsValue(list("id_col"),"customID",adamSettings) 
+#' safetyGraphics:::setSettingsValue(list("measure_values","ALP"),"Alanine Aminotrans",adamSettings)
+#' safetyGraphics:::setSettingsValue(list("myCustomSetting"),"customized",adamSettings) 
+#' #adds myCustomSetting to adamSettings
+#' 
+#' @keywords internal
+
+
+setSettingsValue <- function(key, value, settings){
+  stopifnot(
+    typeof(settings)=="list"
+  )
+
+  firstKey <- key[[1]]
+  if(length(key)==1){
+    settings[[firstKey]]<-value
+    return(settings)
+  }else{
+    settings[[firstKey]]<-setSettingsValue(settings = settings[[firstKey]],key = key[2:length(key)], value)
+    return(settings)
+  }
+}

tests/testthat/test_generateSettings.R

@@ -26,51 +26,64 @@ test_that("a warning is thrown if chart isn't eDish",{
 })
 
 test_that("data mappings are null when setting=none, character otherwise",{
-  column_setting_names<-c("id_col", "value_col", "measure_col", "normal_col_low", "normal_col_high", "studyday_col", "visit_col", "visitn_col")
+  data_setting_keys<-c("id_col", "value_col", "measure_col", "normal_col_low", "normal_col_high", "studyday_col","measure_values--ALT","measure_values--ALP","measure_values--TB","measure_values--AST")
   none_settings <- generateSettings(standard="None")
-  for(name in column_setting_names){
-    expect_null(none_settings[[name]])
+  for(text_key in data_setting_keys){
+    key<-textKeysToList(text_key)[[1]]
+    expect_null(getSettingValue(settings=none_settings,key=key))
+  }
+
+  other_settings <- generateSettings(standard="a different standard") 
+  for(text_key in data_setting_keys){
+    key<-textKeysToList(text_key)[[1]]
+    expect_null(getSettingValue(settings=other_settings,key=key))
   }
 
   sdtm_settings <- generateSettings(standard="SDTM")
-  for(name in column_setting_names){
-    expect_is(sdtm_settings[[name]],"character")
+  for(text_key in data_setting_keys){
+    key<-textKeysToList(text_key)[[1]]
+    expect_is(getSettingValue(settings=sdtm_settings,key=key),"character")
   }
 
+
   sdtm_settings2 <- generateSettings(standard="SdTm")
-  for(name in column_setting_names){
-    expect_is(sdtm_settings2[[name]],"character")
+  for(text_key in data_setting_keys){
+    key<-textKeysToList(text_key)[[1]]
+    expect_is(getSettingValue(settings=sdtm_settings2,key=key),"character")
   }
 
+
   adam_settings <- generateSettings(standard="ADaM")
-  for(name in column_setting_names){
-    expect_is(adam_settings[[name]],"character")
+  for(text_key in data_setting_keys){
+    key<-textKeysToList(text_key)[[1]]
+    expect_is(getSettingValue(settings=adam_settings,key=key),"character")
   }
 
   adam_settings2 <- generateSettings(standard="ADAM")
-  for(name in column_setting_names){
-    expect_is(adam_settings2[[name]],"character")
+  for(text_key in data_setting_keys){
+    key<-textKeysToList(text_key)[[1]]
+    expect_is(getSettingValue(settings=adam_settings2,key=key),"character")
   }
 
+
   # Test Partial Spec Match
-  partial_adam_settings <- generateSettings(standard="SDTM", partial=TRUE, partial_cols = c("USUBJID","TEST"))
-  for(name in column_setting_names){
-
-    if (name %in% c("id_col","measure_col")) {
-      expect_is(partial_adam_settings[[name]],"character")
+  partial_adam_settings <- generateSettings(standard="adam", partial=TRUE, partial_keys = c("id_col","measure_col","measure_values--ALT"))
+  for(text_key in data_setting_keys){
+    key<-textKeysToList(text_key)[[1]]
+    if (text_key %in% c("id_col","measure_col","measure_values--ALT")) {
+      expect_is(getSettingValue(settings=partial_adam_settings,key=key),"character")
     } else {
-      expect_null(partial_adam_settings[[name]])
+      expect_null(getSettingValue(settings=partial_adam_settings,key=key))
     }
   }
 
   #Testing that partial cols are only used when partial=TRUE
-  full_adam_partial_cols <- generateSettings(standard="ADaM", partial_cols = c("USUBJID","TEST"))
-  for(name in column_setting_names){
-    expect_is(full_adam_partial_cols[[name]],"character")
+  full_adam_partial_cols <- generateSettings(standard="ADaM",  partial_keys = c("id_col","measure_col","measure_values--ALT"))
+  for(text_key in data_setting_keys){
+    key<-textKeysToList(text_key)[[1]]
+    expect_is(getSettingValue(settings=full_adam_partial_cols,key=key),"character")
   }
 
   #Testing failure when partial is true with no specified columns
   expect_error(partial_settings_no_cols <- generateSettings(standard="ADaM", partial=TRUE))
-
-
 })