Dev v0.9.0

DESCRIPTION

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

NAMESPACE

@@ -15,13 +15,15 @@ import(htmlwidgets)
 import(rmarkdown)
 import(shinyjs)
 importFrom(dplyr,"filter")
+importFrom(dplyr,filter)
 importFrom(magrittr,"%>%")
 importFrom(purrr,keep)
 importFrom(purrr,map)
 importFrom(purrr,map_chr)
 importFrom(purrr,map_dbl)
 importFrom(purrr,map_lgl)
 importFrom(rlang,.data)
+importFrom(rlang,parse_expr)
 importFrom(shiny,runApp)
 importFrom(stringr,str_detect)
 importFrom(stringr,str_split)

R/checkField.R

@@ -13,11 +13,11 @@
 #' @examples
 #' testSettings<-generateSettings(standard="AdAM")
 #' fields<-list("measure_values","TB")
-#' safetyGraphics:::checkFieldSettings(fieldKey=fields,settings=testSettings, data=adlbc) 
+#' safetyGraphics:::checkField(fieldKey=fields,settings=testSettings, data=adlbc) 
 #' 
 #' @keywords internal
 
-checkFieldSettings <- function(fieldKey, settings, data){
+checkField <- function(fieldKey, settings, data){
   stopifnot(typeof(fieldKey)=="list", typeof(settings)=="list")
 
   # Check to see that the field data specified in the seetings is found in the data
@@ -29,12 +29,22 @@ checkFieldSettings <- function(fieldKey, settings, data){
   fieldCheck$value <-  getSettingValue(key=fieldCheck$key,settings=settings)
 
   #get the name of the column containing the field 
-  columnTextKey<-getSettingsMetadata(cols="field_column_key",text_keys=fieldCheck$text_key)
+  lastKey <- fieldCheck$key[[length(fieldCheck$key)]]
+
+  #use the parent metadata entry if the item is a vector
+  if(is.numeric(lastKey)){
+    sub_key <- fieldKey[-length(fieldKey)]
+    sub_text_key <- paste(unlist(sub_key), collapse='--')
+    columnTextKey <-getSettingsMetadata(cols="field_column_key",text_keys=sub_text_key)
+  }else{
+    columnTextKey <-getSettingsMetadata(cols="field_column_key",text_keys=fieldCheck$text_key)
+  }
+
   columnKey<-textKeysToList(columnTextKey)[[1]]
   columnName<-getSettingValue(key=columnKey,settings=settings)
 
   if(length(fieldCheck$value)>0){
-    fieldCheck$valid <-  hasField(fieldValue=fieldCheck$value, columnName=columnName,data=data)     
+    fieldCheck$valid <- hasField(fieldValue=fieldCheck$value, columnName=columnName,data=data)     
   }else{
     fieldCheck$value <-  "--No Value Given--"
     fieldCheck$valid <- TRUE #null values are ok

R/safetyGraphicsApp.R

@@ -1,5 +1,7 @@
 #' Run the interactive safety graphics builder
 #'
+#' @param maxFileSize maximum file size in MB allowed for file upload.
+#'
 #' @importFrom shiny runApp
 #' @import shinyjs
 #' @import dplyr
@@ -10,7 +12,10 @@
 #'
 #' @export
 #'
-safetyGraphicsApp <- function() {
+safetyGraphicsApp <- function(maxFileSize = 20) {
+  #increase maximum file upload limit
+  options(shiny.maxRequestSize=(maxFileSize*1024^2))
+
   path <- system.file("eDISH_app", package = "safetyGraphics")
   shiny::runApp(path, launch.browser = TRUE)
 }

R/trimData.R

@@ -0,0 +1,80 @@
+#' Removes unnecessary rows and columns
+#'
+#' Removes unnecessary rows and columns from data based on current settings
+#'
+#' @param data a data frame to trim
+#' @param settings the settings list used to determine which rows and columns to drop
+#' @param chart the chart being created
+#' @return A dataframe with unnecessary columns and rows removed
+#'
+#' @examples
+#' testSettings <- generateSettings(standard="adam")
+#' trimmed<-safetyGraphics:::trimData(data=adlbc, settings=testSettings)
+#'
+#' @importFrom dplyr filter
+#' @importFrom purrr map
+#' @importFrom rlang parse_expr .data
+#'
+#' @keywords internal
+
+
+trimData <- function(data, settings, chart="edish"){
+
+  ## Remove columns not in settings ##
+  col_names <- colnames(data)
+
+  allKeys <- getSettingsMetadata(charts=chart, filter_expr = .data$column_mapping, cols = c("text_key","setting_type"))
+  dataKeys <- allKeys %>% filter(.data$setting_type !="vector") %>% pull(.data$text_key) %>% textKeysToList()
+
+  # Add items in vectors to list individually
+  dataVectorKeys <- allKeys %>% filter(.data$setting_type =="vector") %>% pull(.data$text_key) %>% textKeysToList()
+  for(key in dataVectorKeys){
+    current<-getSettingValue(key, settings=settings)
+    if (length(current) > 0 ) {
+      for (i in 1:length(current)){
+        newKey <- key
+        newKey[[1+length(newKey)]]<-i
+        sub <- current[[i]]
+        if(typeof(sub)=="list"){
+          newKey[[1+length(newKey)]]<-"value_col"
+        }  
+        dataKeys[[1+length(dataKeys)]]<-newKey 
+      }
+    }
+  }
+
+  settings_values <- map(dataKeys, function(x) {return(getSettingValue(x, settings))})
+
+  common_cols <- intersect(col_names,settings_values)
+
+  data_subset <- select(data, unlist(common_cols))
+
+  ## Remove rows if baseline or analysisFlag is specified ##
+
+  if(!is.null(settings[['baseline']][['value_col']]) | !is.null(settings[['analysisFlag']][['value_col']])) {
+
+    # Create Baseline String
+    baseline_string <- ifelse(!is.null(settings[['baseline']][['value_col']]),
+     paste(settings[['baseline']][['value_col']], "%in% settings[['baseline']][['values']]"),
+     "")
+
+    # Create AnalysisFlag String
+    analysis_string <- ifelse(!is.null(settings[['analysisFlag']][['value_col']]),
+      paste(settings[['analysisFlag']][['value_col']], "%in% settings[['analysisFlag']][['values']]"),
+    "")
+
+    # Include OR operator if both are specified
+    operator <- ifelse(!is.null(settings[['baseline']][['value_col']]) & !is.null(settings[['analysisFlag']][['value_col']]),
+                        "|","")
+
+    # Create filter string and make it an expression
+    filter_string <- paste(baseline_string, operator, analysis_string)
+    filter_expression <- parse_expr(filter_string)
+
+    #Filter on baseline and analysisFlag
+    data_subset <-  filter(data_subset, !!filter_expression)
+
+  }
+
+  return(data_subset)
+}

R/validateSettings.R

@@ -39,24 +39,53 @@
 
 
 validateSettings <- function(data, settings, chart="eDish"){
-
+  
   settingStatus<-list()
-
+  
   # Check that all required parameters are not null
   requiredChecks <- getRequiredSettings(chart = chart) %>% purrr::map(checkRequired, settings = settings)
-
+  
   #Check that non-null setting columns are found in the data
-  dataKeys <- getSettingsMetadata(charts=chart, filter_expr = .data$column_mapping, cols = "text_key")%>%textKeysToList()
+  allKeys <- getSettingsMetadata(charts=chart, filter_expr = .data$column_mapping, cols = c("text_key","setting_type"))
+  dataKeys <- allKeys %>% filter(.data$setting_type !="vector") %>% pull(.data$text_key) %>% textKeysToList()
+
+  # Add items in vectors to list individually
+  dataVectorKeys <- allKeys %>% filter(.data$setting_type =="vector") %>% pull(.data$text_key) %>% textKeysToList()
+  for(key in dataVectorKeys){
+    current<-getSettingValue(key, settings=settings)
+    if (length(current) > 0 ) {
+      for (i in 1:length(current)){
+        newKey <- key
+        newKey[[1+length(newKey)]]<-i
+        sub <- current[[i]]
+        if(typeof(sub)=="list"){
+          newKey[[1+length(newKey)]]<-"value_col"
+        }  
+        dataKeys[[1+length(dataKeys)]]<-newKey 
+      }
+    }
+  }
+
   columnChecks <- dataKeys %>% purrr::map(checkColumn, settings=settings, data=data)
 
   #Check that non-null field/column combinations are found in the data
-  fieldKeys <- getSettingsMetadata(charts=chart, filter_expr = .data$field_mapping)%>%
-    filter(.data$setting_type!="vector")%>% #TODO: check the vectorized fields as well. Not sure a big deal now, since none are required ... 
-    select(.data$text_key)%>%
-    unlist()%>%
-    textKeysToList()
+  allKeys <- getSettingsMetadata(charts=chart, filter_expr = .data$field_mapping, cols = c("text_key","setting_type"))
+  fieldKeys <- allKeys %>% filter(.data$setting_type!="vector")%>% pull(.data$text_key)%>%textKeysToList()
+
+  #Add items in vectors to list individually
+  fieldVectorKeys <- allKeys %>% filter(.data$setting_type=="vector")%>% pull(.data$text_key)%>%textKeysToList()
+  for(key in fieldVectorKeys){
+    current<-getSettingValue(key, settings=settings)
+    if (length(current) > 0 ) {
+      for (i in 1:length(current)){
+        newKey <- key
+        newKey[[1+length(newKey)]]<-i
+        fieldKeys[[1+length(fieldKeys)]]<-newKey
+      }
+    }
+  }
   fieldChecks <- fieldKeys %>% purrr::map(checkField, settings=settings, data=data )
-
+  
   #Check that settings for mapping numeric data are associated with numeric columns
   numericKeys <- getSettingsMetadata(charts=chart, filter_expr=.data$column_type=="numeric", cols="text_key")%>%textKeysToList()
   numericChecks <- numericKeys %>% purrr::map(checkNumeric, settings=settings, data=data )
@@ -76,10 +105,10 @@ validateSettings <- function(data, settings, chart="eDish"){
 
   #valid=true if all checks pass, false otherwise
   settingStatus$valid <- settingStatus$checks%>%select(.data$valid)%>%unlist%>%all
-
+  
   #create summary string
   failCount <- nrow(settingStatus$checks%>%filter(!.data$valid))
   checkCount <- nrow(settingStatus$checks)
   settingStatus$status <- paste0(failCount," of ",checkCount," checks failed.")
   return (settingStatus)
-}
+}

inst/eDISH_app/modules/dataUpload/dataUpload.R

@@ -2,7 +2,6 @@ dataUpload <- function(input, output, session){
 
   ns <- session$ns
 
-
   # initiate reactive values - list of uploaded data files
   # standard to imitate output of detectStandard.R
   dd <- reactiveValues(data = list("Example data" = adlbc), current = 1, standard = list(list("standard" = "ADaM", "details" = list("ADaM"=list("match"="Full")))))

inst/eDISH_app/modules/renderChart/eDishReport/eDishReport.Rmd

@@ -33,9 +33,11 @@ safetyGraphics is an open source project built using standard web technology and
 
 #### Code to Reproduce Chart
 
-Use the script below to (1) load your data and (2) render the chart. Make sure to update the first line to point at your data. 
+Use the script below to (1) load the safetyGraphics package, (2) load your data and (3) render the chart. Make sure to update the second line to point at your data. 
 
 ```{r, comment=NA, echo=FALSE}
+lib_code <- quote(library(safetyGraphics))
+lib_code
 
 writeLines("path <- 'path_to_data'") ### <-- Update this!
 writeLines("my_data <- read.csv(file.path(path, 'data.csv'))")

inst/eDISH_app/modules/renderChart/renderEDishChart.R

@@ -8,7 +8,8 @@ renderEDishChart <- function(input, output, session, data, settings, valid){
     req(settings())
 
     if (valid()==TRUE){
-      eDISH(data = data(), settings = settings())
+      trimmed_data <- safetyGraphics:::trimData(data = data(), settings = settings())
+      eDISH(data = trimmed_data, settings = settings())
     } else{
       return()
     }

inst/eDISH_app/modules/renderSettings/renderSettings.R

@@ -213,7 +213,7 @@ renderSettings <- function(input, output, session, data, settings, status){
     }
 
     if (! is.null(input$`analysisFlag--values`)){
-      if (! input$`analysisFlag--values`==""){
+      if (! input$`analysisFlag--values`[1]==""){
         settings$analysisFlag <- list(value_col = input$`analysisFlag--value_col`,
                                       values = input$`analysisFlag--values`)
       }