Dev v0.10.0

DESCRIPTION

@@ -18,11 +18,11 @@ License: MIT + file LICENSE
 Encoding: UTF-8
 LazyData: true
 RoxygenNote: 6.1.1
-Suggests: 
+Suggests:
     testthat,
     shinytest,
     knitr
-Imports: 
+Imports:
     dplyr,
     htmlwidgets,
     purrr,

NAMESPACE

@@ -16,6 +16,7 @@ import(rmarkdown)
 import(shinyjs)
 importFrom(dplyr,"filter")
 importFrom(dplyr,filter)
+importFrom(dplyr,full_join)
 importFrom(haven,read_sas)
 importFrom(magrittr,"%>%")
 importFrom(purrr,keep)

R/checkColumn.R

@@ -16,27 +16,27 @@
 #' testSettings$filters[[1]]<-list(value_col="RACE",label="Race")
 #' testSettings$filters[[2]]<-list(value_col=NULL,label="No Column")
 #' testSettings$filters[[3]]<-list(value_col="NotAColumn",label="Invalid Column")
-#' 
+#'
 #' #pass ($valid == TRUE)
 #' safetyGraphics:::checkColumn(key=list("id_col"),
-#'                                     settings=testSettings, adlbc) 
-#'                                     
+#'                                     settings=testSettings, adlbc)
+#'
 #' #pass
 #' safetyGraphics:::checkColumn(key=list("filters",1,"value_col"),
-#'                                     settings=testSettings, adlbc) 
-#'                                     
+#'                                     settings=testSettings, adlbc)
+#'
 #' #NULL column pass
 #' safetyGraphics:::checkColumn(key=list("filters",2,"value_col"),
-#'                                     settings=testSettings, adlbc) 
-#'                                     
+#'                                     settings=testSettings, adlbc)
+#'
 #' #invalid column fails
 #' safetyGraphics:::checkColumn(key=list("filters",3,"value_col"),
-#'                                     settings=testSettings, adlbc) 
+#'                                     settings=testSettings, adlbc)
 #' @keywords internal
 
 checkColumn <- function(key, settings, data){
   stopifnot(typeof(key)=="list",typeof(settings)=="list")
-  
+
   current <- list(key=key)
   current$text_key <-  paste( unlist(current$key), collapse='--')
   current$type <- "column"

R/checkNumeric.R

@@ -10,11 +10,11 @@
 #' @examples
 #' testSettings<-generateSettings(standard="AdAM")
 #' #pass ($valid == FALSE)
-#' safetyGraphics:::checkNumeric(key=list("id_col"),settings=testSettings, data=adlbc) 
-#' 
+#' safetyGraphics:::checkNumeric(key=list("id_col"),settings=testSettings, data=adlbc)
+#'
 #' #pass ($valid == TRUE)
-#' safetyGraphics:::checkNumeric(key=list("value_col"),settings=testSettings, data=adlbc) 
-#' 
+#' safetyGraphics:::checkNumeric(key=list("value_col"),settings=testSettings, data=adlbc)
+#'
 #' @keywords internal
 
 checkNumeric <- function(key, settings, data){

R/data_checks.R

@@ -0,0 +1 @@
+#Statistical Checks

R/generateSettings.R

@@ -1,104 +1,120 @@
 #' Generate a settings object based on a data standard
 #'
-#' This function returns a settings object for the eDish chart based on the specified data standard. 
+#' This function returns a settings object for the eDish chart based on the specified data standard.
 #'
 #' The function is designed to work with the SDTM and AdAM CDISC(<https://www.cdisc.org/>) standards for clinical trial data. Currently, eDish is the only chart supported.
 #'
-#' @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 standard The data standard for which to create settings. Valid options are "SDTM", "AdAM" or "None". Default: \code{"None"}.
+#' @param charts The chart or chart(s) for which settings should be generated. Default: \code{NULL} (uses all available charts).
+#' @param useDefaults Specifies whether default values from settingsMetadata should be included in the settings object. Default: \code{TRUE}.
 #' @param partial Boolean for whether or not the standard is a partial standard. Default: \code{FALSE}.
 #' @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}.
+#' @param custom_settings a tibble with text_key and customValue columns specifiying customizations to be applied to the settings object. Default: \code{NULL}.
 #' @return A list containing the appropriate settings for the selected chart
-#' 
-#' @examples 
-#' 
-#' generateSettings(standard="SDTM") 
+#'
+#' @examples
+#'
+#' generateSettings(standard="SDTM")
 #' generateSettings(standard="SdTm") #also ok
 #' generateSettings(standard="ADaM")
 #' pkeys<- c("id_col","measure_col","value_col")
 #' generateSettings(standard="adam", partial=TRUE, partial_keys=pkeys)
-#' 
-#' generateSettings(standard="a different standard") 
+#'
+#' generateSettings(standard="a different standard")
 #' #returns shell settings list with no data mapping
-#' 
+#'
 #' \dontrun{
-#' generateSettings(standard="adam",chart="AEExplorer") #Throws error. Only eDish supported so far. 
+#' generateSettings(standard="adam",chart="AEExplorer") #Throws error. Only eDish supported so far.
 #' }
-#' 
-#' @importFrom dplyr "filter"
+#'
+#' @importFrom dplyr "filter" full_join
 #' @importFrom stringr str_split
 #' @importFrom rlang .data
-#' 
+#'
 #' @export
 
-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."))
-  }
-
+generateSettings <- function(standard="None", charts=NULL, useDefaults=TRUE, partial=FALSE, partial_keys=NULL, custom_settings=NULL){
+
   # 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")
   }
-  
+
   # Coerce options to lowercase
   standard<-tolower(standard)
-  chart<-tolower(chart)
-
+  if(!is.null(charts)){
+    charts<-tolower(charts)
+  }
+
+  #############################################################################
+  # get keys & default values for settings using a data standard (data and field mappings)
+  ############################################################################
   # Build a table of data mappings for the selected standard and partial settings
-  standardList<-c("adam","sdtm") #TODO: automatically generate this from metadata
+  standardList<-safetyGraphics::standardsMetadata%>%select(-.data$text_key)%>%names
+
   if(standard %in% standardList){
-    dataMappings <- safetyGraphics::getSettingsMetadata(
-      charts = chart, 
+    dataDefaults <- safetyGraphics::getSettingsMetadata(
+      charts = charts,
       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) 
-    }
+    select(-.data$setting_required)%>%
+    rename("dataDefault" = standard)%>%
+    filter(.data$dataDefault != '')
+  }else{
+    dataDefaults<-tibble(text_key=character(),dataDefault=character(), .rows=0)
   }
-
-  # 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,
-    normal_col_low = NULL,
-    normal_col_high = NULL,
-    studyday_col=NULL,
-    visit_col = NULL,
-    visitn_col = NULL,
-    filters = NULL,
-    group_cols = NULL,
-    measure_values = list(ALT = NULL,
-                          AST = NULL,
-                          TB = NULL,
-                          ALP = NULL),
-    baseline = list(value_col=NULL,
-                    values=list()),
-    analysisFlag = list(value_col=NULL,
-                        values=list()),
-
-    x_options = c("ALT", "AST", "ALP"),
-    y_options = c("TB", "ALP"),
-    visit_window = 30,
-    r_ratio_filter = TRUE,
-    r_ratio_cut = 0,
-    showTitle = TRUE,
-    warningText = "Caution: This interactive graphic is not validated. Any clinical recommendations based on this tool should be confirmed using your organizations standard operating procedures."
-  )
-
-  # 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"])
-    }    
+
+  if(partial){
+    dataDefaults <-dataDefaults%>%filter(.data$text_key %in% partial_keys)
+  }
+
+  #############################################################################
+  # get keys & default values for settings not using a data standard
+  #############################################################################
+  if(useDefaults){
+    otherDefaults <- safetyGraphics::getSettingsMetadata(
+      charts = charts,
+      filter = !.data$column_mapping & !.data$field_mapping,
+      cols=c("text_key","default")
+    )%>%
+    rename("otherDefault"="default")
+  }else{
+    otherDefaults <- tibble(text_key=character(),otherDefault=character(), .rows=0)
+  }
+
+  #############################################################################
+  # merge all keys & default values
+  #############################################################################
+  key_values <- full_join(dataDefaults, otherDefaults, by="text_key")
+  key_values <- key_values %>% mutate(default=ifelse(is.na(.data$dataDefault),.data$otherDefault,.data$dataDefault))
+
+  #############################################################################
+  # Apply custom settings (if any)
+  #############################################################################
+  if(!is.null(custom_settings)){
+    key_values<-full_join(key_values, custom_settings, by="text_key")
+  } else {
+    key_values$customValue<-NA
+  }
+
+  key_values<-key_values %>% mutate(value=ifelse(is.na(.data$customValue), .data$default, .data$customValue))
+
+  #############################################################################
+  # create shell settings object
+  #############################################################################
+  shell<-generateShell(charts=charts)
+
+  #########################################################################################
+  # populate the shell settings by looping through key_values and apply them to the shell
+  #########################################################################################
+  for(row in 1:nrow(key_values)){
+    shell<-setSettingsValue(
+      settings = shell,
+      key = textKeysToList(key_values[row,"text_key"])[[1]],
+      value = key_values[row, "value"][[1]]
+    )
   }
 
-  return(shells[[chart]])
-}
+  return(shell)
+}

R/generateShell.R

@@ -0,0 +1,34 @@
+#' Generate a default settings shell based on settings metadata
+#'
+#' This function returns a default settings object based on the chart(s) specified.
+#'
+#' The function is designed to work with valid safetyGraphics charts.
+#'
+#' @param charts The chart or chart(s) to include in the shell settings object
+#' @return A list containing a setting shell (all values = NA) for the selected chart(s)
+#'
+#' @examples
+#'
+#' safetyGraphics:::generateShell(charts = "eDish")
+#'
+#' @keywords internal
+
+generateShell <- function(charts=NULL){
+  keys <- safetyGraphics::getSettingsMetadata(
+    charts = charts,
+    cols=c("text_key")
+  ) %>% textKeysToList()
+
+  shell <- list()
+
+  for (i in 1:length(keys) ) {
+    shell<-setSettingsValue(
+      key=keys[[i]],
+      value=NULL, 
+      settings=shell,
+      forceCreate=TRUE
+    )
+  }
+
+  return(shell)
+}

R/setSettingsValue.R

@@ -5,6 +5,7 @@
 #' @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()}
+#' @param forceCreate Specifies whether the function should create a new list() when none exisits. This most commonly occurs when deeply nested objects.  
 #' @return the updated settings object
 #' 
 #' @examples 
@@ -21,17 +22,26 @@
 #' @keywords internal
 
 
-setSettingsValue <- function(key, value, settings){
-  stopifnot(
-    typeof(settings)=="list"
-  )
+setSettingsValue <- function(key, value, settings, forceCreate=FALSE){
+
+  if(typeof(settings)!="list"){
+    if(forceCreate){
+      settings=list()  
+    }else{
+      stop("Settings is not a valid list object. Set forceCreate to TRUE and re-run if you want to create a new list and continue.")  
+    } 
+  }
 
   firstKey <- key[[1]]
   if(length(key)==1){
-    settings[[firstKey]]<-value
+    if(is.null(value)){
+      settings[firstKey]<-list(NULL)
+    }else{
+      settings[[firstKey]]<-value
+    }
     return(settings)
   }else{
-    settings[[firstKey]]<-setSettingsValue(settings = settings[[firstKey]],key = key[2:length(key)], value)
+    settings[[firstKey]]<-setSettingsValue(settings = settings[[firstKey]],key = key[2:length(key)], value=value, forceCreate=forceCreate)
     return(settings)
   }
 }

R/settingsMetadata.R

@@ -15,6 +15,7 @@
 #'    \item{field_mapping}{Flag indicating whether the setting corresponds to a field-level mapping in the data}
 #'    \item{field_column_key}{Key for the column that provides options for the field-level mapping in the data}
 #'    \item{setting_cat}{Setting category (data, measure, appearance)}
+#'    \item{default}{Default value for non-data settings}
 #' }    
 #' 
 #' @source Created for this package