diff --git a/NAMESPACE b/NAMESPACE index 129a3f5b..0f3115f1 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -18,6 +18,7 @@ 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) @@ -25,4 +26,5 @@ importFrom(shiny,runApp) importFrom(stringr,str_detect) importFrom(stringr,str_split) importFrom(stringr,str_subset) +importFrom(tibble,tibble) importFrom(utils,globalVariables) diff --git a/R/checkColumnSetting.R b/R/checkColumn.R similarity index 81% rename from R/checkColumnSetting.R rename to R/checkColumn.R index b09e1107..3674be7b 100644 --- a/R/checkColumnSetting.R +++ b/R/checkColumn.R @@ -18,29 +18,29 @@ #' 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--" @@ -48,7 +48,7 @@ checkColumnSetting <- function(key, settings, data){ 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) } diff --git a/R/checkField.R b/R/checkField.R new file mode 100644 index 00000000..ec6c48d6 --- /dev/null +++ b/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) +} diff --git a/R/checkFieldSettings.R b/R/checkFieldSettings.R index 772ca3e6..ececcecc 100644 --- a/R/checkFieldSettings.R +++ b/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) } diff --git a/R/checkNumericColumns.R b/R/checkNumeric.R similarity index 76% rename from R/checkNumericColumns.R rename to R/checkNumeric.R index 80e5581e..435d4627 100644 --- a/R/checkNumericColumns.R +++ b/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) } diff --git a/R/checkSettingProvided.R b/R/checkRequired.R similarity index 81% rename from R/checkSettingProvided.R rename to R/checkRequired.R index 6032b38d..2e93f975 100644 --- a/R/checkSettingProvided.R +++ b/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--" diff --git a/R/validateSettings.R b/R/validateSettings.R index 08c651a4..fd5af710 100644 --- a/R/validateSettings.R +++ b/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) } diff --git a/man/checkColumnSetting.Rd b/man/checkColumn.Rd similarity index 79% rename from man/checkColumnSetting.Rd rename to man/checkColumn.Rd index 01e113b8..cc5eac43 100644 --- a/man/checkColumnSetting.Rd +++ b/man/checkColumn.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/checkColumnSetting.R -\name{checkColumnSetting} -\alias{checkColumnSetting} +% Please edit documentation in R/checkColumn.R +\name{checkColumn} +\alias{checkColumn} \title{Check that a setting parameter has a matching data column} \usage{ -checkColumnSetting(key, settings, data) +checkColumn(key, settings, data) } \arguments{ \item{key}{a list (like those provided by \code{getSettingKeys())} defining the position of parameter in the settings object.} @@ -30,19 +30,19 @@ testSettings$filters[[2]]<-list(value_col=NULL,label="No Column") 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) } \keyword{internal} diff --git a/man/checkField.Rd b/man/checkField.Rd new file mode 100644 index 00000000..253849d8 --- /dev/null +++ b/man/checkField.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/checkFieldSettings.R +\name{checkField} +\alias{checkField} +\title{Check that a setting parameter has a matching data field} +\usage{ +checkField(fieldKey, settings, data) +} +\arguments{ +\item{fieldKey}{a list (like those provided by \code{getSettingKeys())} defining the position of parameter in the settings object.} + +\item{settings}{The settings list used to generate a chart like \code{eDISH()}} + +\item{data}{A data frame to check for the specified field} +} +\value{ +A list containing the results of the check following the format specified in \code{validateSettings()[["checkList"]]} +} +\description{ +Checks that a single parameter from the settings list matches a field value in a specified data set +} +\details{ +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. +} +\examples{ +testSettings<-generateSettings(standard="AdAM") +fields<-list("measure_values","TB") +safetyGraphics:::checkField(fieldKey=fields,settings=testSettings, data=adlbc) + +} +\keyword{internal} diff --git a/man/checkFieldSettings.Rd b/man/checkFieldSettings.Rd index 708ad3ed..e8c48684 100644 --- a/man/checkFieldSettings.Rd +++ b/man/checkFieldSettings.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/checkFieldSettings.R +% Please edit documentation in R/checkField.R \name{checkFieldSettings} \alias{checkFieldSettings} \title{Check that a setting parameter has a matching data field} @@ -24,10 +24,8 @@ This function compares settings with field values as part of the \code{validateS } \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:::checkFieldSettings(fieldKey=fields,settings=testSettings, data=adlbc) } \keyword{internal} diff --git a/man/checkNumericColumns.Rd b/man/checkNumeric.Rd similarity index 60% rename from man/checkNumericColumns.Rd rename to man/checkNumeric.Rd index afc95c7f..ce7aded3 100644 --- a/man/checkNumericColumns.Rd +++ b/man/checkNumeric.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/checkNumericColumns.R -\name{checkNumericColumns} -\alias{checkNumericColumns} +% Please edit documentation in R/checkNumeric.R +\name{checkNumeric} +\alias{checkNumeric} \title{Check that settings for mapping numeric data are associated with numeric columns} \usage{ -checkNumericColumns(key, settings, data) +checkNumeric(key, settings, data) } \arguments{ \item{key}{a list (like those provided by \code{getSettingKeys())} defining the position of parameter in the settings object.} @@ -21,14 +21,11 @@ Check that settings for mapping numeric data are associated with numeric columns } \examples{ testSettings<-generateSettings(standard="AdAM") -#pass ($valid == TRUE) -safetyGraphics:::checkSettingProvided(key=list("id_col"),settings=testSettings) - -#fails since filters aren't specified by default -safetyGraphics:::checkSettingProvided(key=list("filters"),settings=testSettings) +#pass ($valid == FALSE) +safetyGraphics:::checkNumeric(key=list("id_col"),settings=testSettings, data=adlbc) -#fails since groups aren't specified by default -safetyGraphics:::checkSettingProvided(key=list("groups",1,"value_col"),settings=testSettings) +#pass ($valid == TRUE) +safetyGraphics:::checkNumeric(key=list("value_col"),settings=testSettings, data=adlbc) } \keyword{internal} diff --git a/man/checkSettingProvided.Rd b/man/checkRequired.Rd similarity index 74% rename from man/checkSettingProvided.Rd rename to man/checkRequired.Rd index e08d407b..89e3470e 100644 --- a/man/checkSettingProvided.Rd +++ b/man/checkRequired.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/checkSettingProvided.R -\name{checkSettingProvided} -\alias{checkSettingProvided} +% Please edit documentation in R/checkRequired.R +\name{checkRequired} +\alias{checkRequired} \title{Check that the user has provided a valid for a given settings parameter} \usage{ -checkSettingProvided(key, settings) +checkRequired(key, settings) } \arguments{ \item{key}{a list (like those provided by \code{getSettingKeys())} defining the position of parameter in the settings object.} @@ -21,15 +21,15 @@ Checks that a single required parameter from the settings list is provided by th 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) } \keyword{internal} diff --git a/man/validateSettings.Rd b/man/validateSettings.Rd index 0c1d39cb..972e2ade 100644 --- a/man/validateSettings.Rd +++ b/man/validateSettings.Rd @@ -22,7 +22,8 @@ A list describing the validation state for the data/settings combination. The re \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`} } diff --git a/tests/testthat/test_validateSettings.R b/tests/testthat/test_validateSettings.R index 9dcd151a..4f795d1f 100644 --- a/tests/testthat/test_validateSettings.R +++ b/tests/testthat/test_validateSettings.R @@ -2,6 +2,7 @@ context("Tests for the validateSetting() function") library(safetyGraphics) library(purrr) library(dplyr) +library(tibble) validSettings<-generateSettings(standard="adam") passed<-validateSettings(data=adlbc,settings=validSettings) @@ -16,14 +17,12 @@ test_that("our basic example is valid (until we break it)",{ }) test_that("function returns a list with the expected structure",{ - expect_named(passed,c("checkList","valid","status")) - expect_named(failed,c("checkList","valid","status")) - expect_type(passed$checkList,"list") + expect_named(passed,c("checks","valid","status")) + expect_named(failed,c("checks","valid","status")) + expect_true(is_tibble(passed$checks)) expect_type(passed$valid,"logical") expect_type(passed$status,"character") - for(item in passed[["checkList"]]){ - expect_named(item,c("key","text_key","check","value","valid","message")) - } + expect_equal(colnames(passed$checks),c("key","text_key","type","description","value","valid","message")) }) test_that("our examples have the correct number of failed checks",{ @@ -31,12 +30,12 @@ test_that("our examples have the correct number of failed checks",{ invalidSettings2$measure_col<-"not_a_measure_id" failed2<-validateSettings(data=adlbc,settings=invalidSettings2) - expect_equal(passed$checkList%>%map_dbl(~!.x[["valid"]])%>%sum,0) - expect_equal(failed$checkList%>%map_dbl(~!.x[["valid"]])%>%sum,1) - expect_equal(failed2$checkList%>%map_dbl(~!.x[["valid"]])%>%sum,6) #2 columns and 4 fields + expect_equal(passed$checks%>%filter(!valid)%>%nrow,0) + expect_equal(failed$checks%>%filter(!valid)%>%nrow,1) + expect_equal(failed2$checks%>%filter(!valid)%>%nrow,6) #2 columns and 4 fields - expect_true(all(passed$checkList%>%keep(~.x[["text_key"]]=="id_col")%>%map_lgl(~.x[["valid"]]))) - expect_false(all(failed$checkList%>%keep(~.x[["text_key"]]=="id_col")%>%map_lgl(~.x[["valid"]]))) + expect_true(passed$checks%>%filter(text_key=="id_col")%>%select(valid)%>%unlist%>%all) + expect_false(failed$checks%>%filter(text_key=="id_col")%>%select(valid)%>%unlist%>%all) }) test_that("field checks fail when expected",{ @@ -45,16 +44,18 @@ test_that("field checks fail when expected",{ fieldFailed<-validateSettings(data=adlbc,settings=invalidFieldSettings) expect_false(fieldFailed[["valid"]]) - failedChecks = fieldFailed[["checkList"]]%>%keep(~!.x[["valid"]]) - expect_length(failedChecks, 1) - expect_equal(failedChecks[[1]][['check']],"'_values' field from setting found in data?") - expect_equal(failedChecks[[1]][['text_key']],"measure_values--ALP") - - invalidFieldSettings$id_values <- list(test="not an id",test2="still not an id") - fieldFailed2<-validateSettings(data=adlbc,settings=invalidFieldSettings) - failedChecks2 = fieldFailed2[["checkList"]]%>%keep(~!.x[["valid"]]) - expect_false(fieldFailed[["valid"]]) - expect_length(failedChecks2, 3) + failedChecks <- fieldFailed$checks%>%filter(!valid) + expect_equal(nrow(failedChecks), 1) + expect_equal(failedChecks[1,"description"]%>%as.character,"field value from setting found in data") + expect_equal(failedChecks[1,'text_key']%>%as.character,"measure_values--ALP") + + # TODO: support vectorized fields/columns #170 + # a vector of values are each checked independently. + # invalidFieldSettings$baseline[["values"]] <- c("not a filter",test2="still not a filter") + # fieldFailed2<-validateSettings(data=adlbc,settings=invalidFieldSettings) + # failedChecks2 = fieldFailed2[["checkList"]]%>%keep(~!.x[["valid"]]) + # expect_false(fieldFailed[["valid"]]) + # expect_length(failedChecks2, 3) }) test_that("required setting checks fail when expected",{ @@ -63,10 +64,10 @@ test_that("required setting checks fail when expected",{ requiredFailed<-validateSettings(data=adlbc,settings=invalidRequiredSettings) expect_false(requiredFailed[["valid"]]) - failedChecks <- requiredFailed[["checkList"]]%>%keep(~!.x[["valid"]]) - expect_length(failedChecks, 1) - expect_equal(failedChecks[[1]][['check']],"value for specified key found in settings?") - expect_equal(failedChecks[[1]][['text_key']],"id_col") + failedChecks <- requiredFailed$checks%>%filter(!valid) + expect_equal(nrow(failedChecks), 1) + expect_equal(failedChecks[1,'description']%>%as.character,"value for specified key found in settings?") + expect_equal(failedChecks[1,'text_key']%>%as.character,"id_col") }) test_that("numeric column checks fail when no numeric values are found",{ @@ -75,10 +76,10 @@ test_that("numeric column checks fail when no numeric values are found",{ numericFailed<-validateSettings(data=adlbc,settings=invalidNumericSettings) expect_false(numericFailed[["valid"]]) - failedChecks <- numericFailed[["checkList"]]%>%keep(~!.x[["valid"]]) - expect_length(failedChecks, 1) - expect_equal(failedChecks[[1]][['check']],"specified column is numeric?") - expect_equal(failedChecks[[1]][['text_key']],"value_col") + failedChecks <- numericFailed$checks%>%filter(!valid) + expect_equal(nrow(failedChecks), 1) + expect_equal(failedChecks[1,'description']%>%as.character,"specified column is numeric?") + expect_equal(failedChecks[1,'text_key']%>%as.character,"value_col") }) test_that("numeric column checks still fails when more than half of the values are not numeric ",{ @@ -86,10 +87,10 @@ test_that("numeric column checks still fails when more than half of the values a validNumericSettings[["value_col"]]<-"someNumbers" adlbc_edit<-adlbc adlbc_edit$someNumbers <- c("10","11",rep("sometext", dim(adlbc_edit)[1]-2)) - numericPassed<-validateSettings(data=adlbc_edit,settings=validNumericSettings) - expect_false(numericPassed[["valid"]]) - partialNumericCheck <- numericPassed[["checkList"]]%>%keep(~.x$check=="specified column is numeric?" & .x$text_key=="value_col") - expect_equal(partialNumericCheck[[1]][["message"]],"10286 of 10288 values were not numeric. Records with non-numeric values may not appear in the graphic.") + numericFailedAgain<-validateSettings(data=adlbc_edit,settings=validNumericSettings) + expect_false(numericFailedAgain[["valid"]]) + partialNumericCheck <- numericFailedAgain$checks %>% filter(description=="specified column is numeric?" & text_key=="value_col") + expect_equal(partialNumericCheck[1,"message"]%>%as.character,"10286 of 10288 values were not numeric. Records with non-numeric values may not appear in the graphic.") }) @@ -100,7 +101,7 @@ test_that("numeric column checks pass when more than half of the values are nume adlbc_edit$someStrings <- c("b","a",rep("10", dim(adlbc_edit)[1]-2)) numericPassed<-validateSettings(data=adlbc_edit,settings=validNumericSettings) expect_true(numericPassed[["valid"]]) - partialNumericCheck <- numericPassed[["checkList"]]%>%keep(~.x$check=="specified column is numeric?" & .x$text_key=="value_col") - expect_equal(partialNumericCheck[[1]][["message"]],"2 of 10288 values were not numeric. Records with non-numeric values may not appear in the graphic.") + partialNumericCheck <- numericPassed$checks%>%filter(description=="specified column is numeric?" & text_key=="value_col") + expect_equal(partialNumericCheck[1,"message"]%>%as.character,"2 of 10288 values were not numeric. Records with non-numeric values may not appear in the graphic.") })