v0.8.0 dev branch

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: safetyGraphics
 Title: Create Interactive Graphics Related to Clinical Trial Safety
-Version: 0.7.3
+Version: 0.8.0
 Authors@R: c(
 	person("Jeremy", "Wildfire", email = "jeremy_wildfire@rhoworld.com", role = c("cre","aut")),
 	person("Becca", "Krouse", role="aut"),
@@ -11,6 +11,8 @@ Authors@R: c(
 	person("Rho Inc.", role = "cph"))
 Maintainer: Jeremy Wildfire <jeremy_wildfire@rhoworld.com>
 Description: A framework for evaluation of clinical trial safety. Users can interactively explore their data using the 'Shiny' application or create standalone 'htmlwidget' charts. Interactive charts are built using 'd3.js' and 'webcharts.js' 'JavaScript' libraries.
+URL: https://github.com/ASA-DIA-InteractiveSafetyGraphics/safetyGraphics
+BugReports: https://github.com/ASA-DIA-InteractiveSafetyGraphics/safetyGraphics/issues
 Depends: R (>= 3.5)
 License: MIT + file LICENSE
 Encoding: UTF-8
@@ -21,16 +23,17 @@ Suggests:
     shinytest,
     knitr
 Imports: 
-	dplyr, 
-	htmlwidgets,
-	purrr,
-	stringr,
- 	jsonlite, 
- 	shiny,
-	magrittr,
-	DT,
-	shinyjs,
-	rmarkdown,
-	rlang
+    dplyr,
+    htmlwidgets,
+    purrr,
+    stringr,
+    jsonlite,
+    shiny,
+    magrittr,
+    DT,
+    shinyjs,
+    rmarkdown,
+    rlang,
+    tibble,
+    utils
 VignetteBuilder: knitr
-

NAMESPACE

@@ -15,13 +15,18 @@ 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)
 importFrom(stringr,str_subset)
+importFrom(tibble,tibble)
+importFrom(utils,globalVariables)

R/checkColumnSetting.R → R/checkColumn.R

@@ -18,36 +18,37 @@
 #' testSettings$filters[[3]]<-list(value_col="NotAColumn",label="Invalid Column")
 #' 
 #' #pass ($valid == TRUE)
-#' safetyGraphics:::checkColumnSetting(key=list("id_col"),
+#' safetyGraphics:::checkColumn(key=list("id_col"),
 #'                                     settings=testSettings, adlbc) 
 #'                                     
 #' #pass
-#' safetyGraphics:::checkColumnSetting(key=list("filters",1,"value_col"),
+#' safetyGraphics:::checkColumn(key=list("filters",1,"value_col"),
 #'                                     settings=testSettings, adlbc) 
 #'                                     
 #' #NULL column pass
-#' safetyGraphics:::checkColumnSetting(key=list("filters",2,"value_col"),
+#' safetyGraphics:::checkColumn(key=list("filters",2,"value_col"),
 #'                                     settings=testSettings, adlbc) 
 #'                                     
 #' #invalid column fails
-#' safetyGraphics:::checkColumnSetting(key=list("filters",3,"value_col"),
+#' safetyGraphics:::checkColumn(key=list("filters",3,"value_col"),
 #'                                     settings=testSettings, adlbc) 
+#' @keywords internal
 
-checkColumnSetting <- function(key, settings, data){
+checkColumn <- function(key, settings, data){
   stopifnot(typeof(key)=="list",typeof(settings)=="list")
-
-  validCols <- names(data)
+
   current <- list(key=key)
   current$text_key <-  paste( unlist(current$key), collapse='--')
-  current$check <- "'_col' parameter from setting setting found in data?"
+  current$type <- "column"
+  current$description <- "column parameter from setting setting found in data?"
   current$value <- getSettingValue(key=key,settings=settings)
   if(is.null(current$value)){
     current$value <- "--No Value Given--"
     current$valid <- TRUE
     current$message <- ""
     return(current)
   }else{
-    current$valid <- current$value %in% validCols
+    current$valid <- hasColumn(current$value, data)
     current$message <- ifelse(current$valid,"",paste0(current$value," column not found in data."))
     return(current)
   }

R/checkField.R

@@ -0,0 +1,45 @@
+#' Check that a setting parameter has a matching data field
+#'
+#' Checks that a single parameter from the settings list matches a field value in a specified data set
+#'
+#' This function compares settings with field values as part of the \code{validateSettings()} function. More specifically, the function checks whether the \code{fieldKey} in a \code{settings} object matches a column/field combination in \code{"data"}. The function makes 2 major assumptions about the structure of the settings object. First, it assumes that the first value in fieldKey is "settingName_values" and there is a corresponding "settingName_col" setting that defines the column to search for field-level data. Second, it expects that the value specified by key/settings is a list, and that each value in the list is a field of the variable above.
+#'
+#' @param fieldKey a list (like those provided by \code{getSettingKeys())} defining the position of parameter in the settings object.
+#' @param settings The settings list used to generate a chart like \code{eDISH()}
+#' @param data A data frame to check for the specified field
+#' @return A list containing the results of the check following the format specified in \code{validateSettings()[["checkList"]]}
+#'
+#'
+#' @examples
+#' testSettings<-generateSettings(standard="AdAM")
+#' fields<-list("measure_values","TB")
+#' safetyGraphics:::checkFieldSettings(fieldKey=fields,settings=testSettings, data=adlbc) 
+#' 
+#' @keywords internal
+
+checkFieldSettings <- 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
+  fieldCheck <- list()
+  fieldCheck$key<-fieldKey
+  fieldCheck$text_key<- paste( unlist(fieldKey), collapse='--')
+  fieldCheck$type <- "field value from setting found in data"
+  fieldCheck$description <- "field value from setting found in 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)
+  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)     
+  }else{
+    fieldCheck$value <-  "--No Value Given--"
+    fieldCheck$valid <- TRUE #null values are ok
+  }
+  fieldCheck$message <- ifelse(!fieldCheck$valid,  paste0("Value of ",fieldCheck$value, " for '",fieldCheck$text_key,"' not found in ",columnName),"")
+
+  return(fieldCheck)
+}

R/checkFieldSettings.R

@@ -12,75 +12,37 @@
 #'
 #' @examples
 #' testSettings<-generateSettings(standard="AdAM")
-#' 
-#' #list of 4 checks. all pass ($valid ==TRUE)
-#' safetyGraphics:::checkFieldSettings(fieldKey=list("measure_values"),
-#'                                     settings=testSettings, adlbc) 
+#' fields<-list("measure_values","TB")
+#' safetyGraphics:::checkField(fieldKey=fields,settings=testSettings, data=adlbc) 
 #' 
 #' @importFrom stringr str_split
 #' @importFrom magrittr "%>%"
 #' @importFrom purrr map 
-#'
-
-checkFieldSettings <- function(fieldKey, settings, data){
-
-  # compare the fields in the settings to the fields in the data.
-  key <- NULL
-
-  fieldCheck <- function(key){
-    function(key){
-      current <- list()
-      current$key<-fieldKey
-      nextKey<-length(current$key)+1
-      current$key[[nextKey]]<-key
-
-      current$text_key <-  paste( unlist(current$key), collapse='--')
-      current$check <- "'_values' field from setting found in data?"
-      current$value <- getSettingValue(key=current$key,settings=settings)
-      if(is.null(current$value)){
-        current$value <- "--No Value Given--"
-        current$valid <- TRUE
-        current$message <- ""
-        return(current)
-      }else if(!columnSpecified){
-        current$valid<-FALSE
-        current$message<-paste0("No column for ",columnKey," found in settings.")
-      }else{
-        current$valid <- current$value %in% validFields
-        current$message <- ifelse(current$valid,"",paste0(current$value," field not found in the ",columnName," column"))
-        return(current)
-      }
-    }
-  }
-
+#' @keywords internal
 
+checkField<- function(fieldKey, settings, data){
   stopifnot(typeof(fieldKey)=="list", typeof(settings)=="list")
-
-   # get a list of all of the column's values from the data
-  key_base<-stringr::str_split(fieldKey, "_")[[1]][1]   # get the name of the column containing the fields(e.g. fields = "measure_values" -> column = "measure_col")
-  columnKey<-getSettingKeys(patterns=paste0(key_base,"_col") ,settings=settings)[[1]]
-  columnName<-getSettingValue(key=columnKey, settings=settings) # get the name of the column from the value associated with columnKey
-  columnSpecified <- is.character(columnName)
-  if(columnSpecified){
-    validFields <- unique(data[[columnName]])
-  } else{
-    validFields <- c()
-  }
-
-  # get a list of fields from the settings object
-  fieldList<-getSettingValue(key=fieldKey, settings=settings)
-
-  if(typeof(fieldList)=="list"){
-    fieldChecks <- fieldList %>% names %>% purrr::map(fieldCheck(key))
-  } else {
-    current <- list()
-    current$key<-fieldKey
-    current$check <- "'_values' field from setting found in data?"
-    current$text_key <-  paste( unlist(current$key), collapse='--')
-    current$value <- NULL
-    current$valid <- FALSE
-    current$message <- "No list of values found in settings."
-    fieldChecks <- list(current)
+
+  # Check to see that the field data specified in the seetings is found in the data
+  fieldCheck <- list()
+  fieldCheck$key<-fieldKey
+  fieldCheck$text_key<- paste( unlist(fieldKey), collapse='--')
+  fieldCheck$type <- "field"
+  fieldCheck$description <- "field value from setting found in 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)
+  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)     
+  }else{
+    fieldCheck$value <-  "--No Value Given--"
+    fieldCheck$valid <- TRUE #null values are ok
   }
-  return(fieldChecks)
+  fieldCheck$message <- ifelse(!fieldCheck$valid,  paste0("Value of ",fieldCheck$value, " for '",fieldCheck$text_key,"' not found in ",columnName),"")
+
+  return(fieldCheck)
 }

R/checkNumericColumns.R → R/checkNumeric.R

@@ -9,28 +9,30 @@
 #'
 #' @examples
 #' testSettings<-generateSettings(standard="AdAM")
-#' #pass ($valid == TRUE)
-#' safetyGraphics:::checkSettingProvided(key=list("id_col"),settings=testSettings) 
+#' #pass ($valid == FALSE)
+#' safetyGraphics:::checkNumeric(key=list("id_col"),settings=testSettings, data=adlbc) 
 #' 
-#' #fails since filters aren't specified by default
-#' safetyGraphics:::checkSettingProvided(key=list("filters"),settings=testSettings) 
+#' #pass ($valid == TRUE)
+#' safetyGraphics:::checkNumeric(key=list("value_col"),settings=testSettings, data=adlbc) 
 #' 
-#' #fails since groups aren't specified by default
-#' safetyGraphics:::checkSettingProvided(key=list("groups",1,"value_col"),settings=testSettings) 
-#'
+#' @keywords internal
 
-checkNumericColumns <- function(key, settings, data){
+checkNumeric <- function(key, settings, data){
   stopifnot(typeof(key)=="list",typeof(settings)=="list")
 
   current <- list(key=key)
   current$text_key <-  paste( unlist(current$key), collapse='--')
-  current$check <- "specified column is numeric?"
+  current$type <- "numeric"
+  current$description <- "specified column is numeric?"
   current$value <- getSettingValue(key=key,settings=settings)
   if(is.null(current$value)){
     current$value <- "--No Value Given--"
     current$valid <- TRUE
     current$message <- ""
-    return(current)
+  }else if(!hasColumn(current$value,data)){
+    current$value <- "--Column not found--"
+    current$valid <- TRUE
+    current$message <- ""
   }else{
     #check to see if the specified column contains numeric values
     values<- data[[current$value]]
@@ -42,7 +44,6 @@ checkNumericColumns <- function(key, settings, data){
     current$valid <- percentNonNumeric < 0.5
     current$message <- paste0(nonNumericCount," of ", totalCount," values were not numeric.")
     if(nonNumericCount>0){current$message<-paste0(current$message, " Records with non-numeric values may not appear in the graphic.")}
-
-    return(current)
   }
+  return(current)
 }

R/checkSettingProvided.R → R/checkRequired.R

@@ -10,24 +10,25 @@
 #' testSettings<-generateSettings(standard="AdAM")
 #' 
 #' #pass ($valid == TRUE)
-#' safetyGraphics:::checkSettingProvided(key=list("id_col"),
+#' safetyGraphics:::checkRequired(key=list("id_col"),
 #'                                       settings=testSettings) 
 #' 
 #' #fails since filters aren't specified by default
-#' safetyGraphics:::checkSettingProvided(key=list("filters"),
+#' safetyGraphics:::checkRequired(key=list("filters"),
 #'                                       settings=testSettings) 
 #' 
 #' #fails since groups aren't specified by default
-#' safetyGraphics:::checkSettingProvided(key=list("groups",1,"value_col"),
+#' safetyGraphics:::checkRequired(key=list("groups",1,"value_col"),
 #'                                       settings=testSettings) 
-#'
+#' @keywords internal
 
-checkSettingProvided <- function(key, settings){
+checkRequired <- function(key, settings){
   stopifnot(typeof(key)=="list",typeof(settings)=="list")
 
   current <- list(key=key)
   current$text_key <-  paste( unlist(current$key), collapse='--')
-  current$check <- "value for specified key found in settings?"
+  current$type<-"required"
+  current$description <- "value for specified key found in settings?"
   current$value <- getSettingValue(key=key,settings=settings)
   if(is.null(current$value)){
     current$value <- "--No Value Given--"