Merge pull request #211 from SafetyGraphics/dev-v0.10.0

v0.10.0 Dev branch

Author: jwildfire

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: safetyGraphics
 Title: Create Interactive Graphics Related to Clinical Trial Safety
-Version: 0.9.1
+Version: 0.10.0
 Authors@R: c(
 	person("Jeremy", "Wildfire", email = "jeremy_wildfire@rhoworld.com", role = c("cre","aut")),
 	person("Becca", "Krouse", role="aut"),

NAMESPACE

@@ -7,7 +7,10 @@ export(generateSettings)
 export(getRequiredSettings)
 export(getSettingsMetadata)
 export(renderEDISH)
+export(renderSafetyHistogram)
 export(safetyGraphicsApp)
+export(safetyHistogram)
+export(safetyHistogramOutput)
 export(validateSettings)
 import(DT)
 import(dplyr)
@@ -16,6 +19,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,138 @@
 #' 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 != '') %>%
+    as_tibble
+  }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
+  #########################################################################################
+  #print(key_values)
+  for(row in 1:nrow(key_values)){
+    text_key<-key_values[row,]%>%pull("text_key")
+    key<- textKeysToList(text_key)[[1]]
+    type <- safetyGraphics::getSettingsMetadata(text_keys=text_key,cols="setting_type")
+    value <- key_values[row,"value"][[1]]
+    finalValue <- value[[1]]
+
+    #print(paste(text_key," (",type,"):",toString(value),typeof(value),length(value),"->",finalValue,typeof(finalValue),length(finalValue)))
+    shell<-setSettingsValue(
+      settings = shell,
+      key = key,
+      value = finalValue
+    )
+  }
+
+  #Coerce empty string to NULL
+  for (i in names(shell)){
+    if (!is.null(shell[[i]])){
+      if (shell[[i]][1]==""){
+        shell[i] <- list(NULL)
+      }
+    }
   }
 
-  return(shells[[chart]])
-}
+  #print(shell)
+  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/getChartSettings.R

@@ -0,0 +1,19 @@
+#' Get chart-specific settings
+#'
+#' Subset master settings list to chart-specific settings list only
+#'
+#' @param settings Settings list containing settings for all selected charts.
+#' @param chart The chart for which settings should be returned.
+#'
+#' @return Chart-specific settings
+#'
+#' @examples
+#' settings <- safetyGraphics::generateSettings(standard="ADaM")
+#' safetyGraphics:::getChartSettings(settings = settings, chart = "edish")
+#' 
+#' @keywords internal
+#' 
+getChartSettings <- function(settings, chart){
+  settings_names <- names(safetyGraphics::generateSettings("None",chart=chart))
+  return(settings[settings_names])
+}

R/getSettingValue.R

@@ -29,6 +29,9 @@ getSettingValue <- function(key,settings){
     #If there are more keys and the value is a list, iterate
     if(typeof(value)=="list"){
       value<-getSettingValue(key[2:length(key)],value)  
+    #If position is provided and the value is a vector
+    }else if(is.numeric(key[[2]]) & length(value)>=key[[2]] & length(key)==2){ 
+      value<-value[[key[[2]]]]
     }else{
       #If there are more keys, but the value is not a list, return NULL
       value<-NULL