Refactor validation

NAMESPACE

@@ -18,11 +18,13 @@ 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(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,37 +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,76 +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 
 #' @keywords internal
 
-
-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)
-      }
-    }
-  }
-
-
+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,29 +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]]
@@ -43,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--"

R/validateSettings.R

@@ -16,7 +16,8 @@
 #' \item{"key"}{ - list specifying the position of the property being checked. For example, `list("group_cols",1,"value_col")` corresponds to `settings[["group_cols"]][[1]][["value_col"]]`}
 #' \item{"text_key"}{ - list from `key` parsed to character with a "--" separator.}
 #' \item{"value"}{ - value of the setting}
-#' \item{"check"}{ - description of the check performed.}
+#' \item{"type"}{ - type of the check performed.}
+#' \item{"description"}{ - description of the check performed.}
 #' \item{"valid"}{ - boolean indicating whether the check was passed}
 #' \item{"message"}{ - string describing failed checks (where `valid=FALSE`). returns an empty string when `valid==TRUE`}
 #'  }
@@ -30,7 +31,9 @@
 #' # .$valid is now FALSE
 #'
 #' @export
-#' @importFrom purrr map map_lgl map_dbl
+#' @import dplyr
+#' @importFrom tibble tibble
+#' @importFrom purrr map map_lgl map_dbl map_chr
 #' @importFrom magrittr "%>%"
 #' @importFrom rlang .data
 
@@ -40,28 +43,43 @@ validateSettings <- function(data, settings, chart="eDish"){
   settingStatus<-list()
 
   # Check that all required parameters are not null
-  requiredChecks <- getRequiredSettings(chart = chart) %>% purrr::map(checkSettingProvided, settings = settings)
+  requiredChecks <- getRequiredSettings(chart = chart) %>% purrr::map(checkRequired, settings = settings)
 
   #Check that non-null setting columns are found in the data
-  columnChecks <- getSettingKeys(patterns="_col",settings=settings) %>% purrr::map(checkColumnSetting, settings=settings, data=data)
+  dataKeys <- getSettingsMetadata(charts=chart, filter_expr = .data$column_mapping, cols = "text_key")%>%textKeysToList()
+  columnChecks <- dataKeys %>% purrr::map(checkColumn, settings=settings, data=data)
 
   #Check that non-null field/column combinations are found in the data
-  fieldChecks <- getSettingKeys(patterns="_values",settings=settings, matchLists=TRUE) %>% purrr::map(checkFieldSettings, settings=settings, data=data )
-  fieldChecks_flat <- unlist(fieldChecks, recursive=FALSE)
+  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()
+  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, cols="text_key", filter_expr=.data$column_type=="numeric")%>%textKeysToList()
-  numericChecks <- numericKeys %>% purrr::map(checkNumericColumns, settings=settings, data=data )
+  numericKeys <- getSettingsMetadata(charts=chart, filter_expr=.data$column_type=="numeric", cols="text_key")%>%textKeysToList()
+  numericChecks <- numericKeys %>% purrr::map(checkNumeric, settings=settings, data=data )
 
   #Combine different check types in to a master list
-  settingStatus$checkList<-c(requiredChecks, columnChecks, fieldChecks_flat, numericChecks)
-
+  settingStatus$checks <-c(requiredChecks, columnChecks, fieldChecks, numericChecks) %>% {
+    tibble(
+      key = map(., "key"),
+      text_key = map_chr(., "text_key"),
+      type = map_chr(., "type"),       
+      description= map_chr(., "description"),       
+      value = map_chr(., "value"),
+      valid = map_lgl(., "valid"),
+      message = map_chr(., "message")
+    )
+  }
+
   #valid=true if all checks pass, false otherwise
-  settingStatus$valid <- settingStatus$checkList%>%purrr::map_lgl(~.x[["valid"]])%>%all
+  settingStatus$valid <- settingStatus$checks%>%select(.data$valid)%>%unlist%>%all
 
   #create summary string
-  failCount <- settingStatus$checkList%>%purrr::map_dbl(~!.x[["valid"]])%>%sum
-  checkCount <- length(settingStatus$checkList)
+  failCount <- nrow(settingStatus$checks%>%filter(!.data$valid))
+  checkCount <- nrow(settingStatus$checks)
   settingStatus$status <- paste0(failCount," of ",checkCount," checks failed.")
   return (settingStatus)
 }