diff --git a/DESCRIPTION b/DESCRIPTION index b2c8c4d1..8627616e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: safetyGraphics Title: Create Interactive Graphics Related to Clinical Trial Safety -Version: 0.8.0 +Version: 0.8.1 Authors@R: c( person("Jeremy", "Wildfire", email = "jeremy_wildfire@rhoworld.com", role = c("cre","aut")), person("Becca", "Krouse", role="aut"), diff --git a/R/checkField.R b/R/checkField.R index ec6c48d6..5afb45c2 100644 --- a/R/checkField.R +++ b/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 diff --git a/R/checkFieldSettings.R b/R/checkFieldSettings.R deleted file mode 100644 index ececcecc..00000000 --- a/R/checkFieldSettings.R +++ /dev/null @@ -1,48 +0,0 @@ -#' 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:::checkField(fieldKey=fields,settings=testSettings, data=adlbc) -#' -#' @importFrom stringr str_split -#' @importFrom magrittr "%>%" -#' @importFrom purrr map -#' @keywords internal - -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 - 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 - } - fieldCheck$message <- ifelse(!fieldCheck$valid, paste0("Value of ",fieldCheck$value, " for '",fieldCheck$text_key,"' not found in ",columnName),"") - - return(fieldCheck) -} diff --git a/R/trimData.R b/R/trimData.R index 4ed44b52..f50fe288 100644 --- a/R/trimData.R +++ b/R/trimData.R @@ -4,37 +4,55 @@ #' #' @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") -#' safetyGraphics:::trimData(data=adlbc, settings=testSettings) -#' +#' trimmed<-safetyGraphics:::trimData(data=adlbc, settings=testSettings) +#' #' @importFrom dplyr filter -#' @importFrom purrr map -#' @importFrom rlang parse_expr -#' +#' @importFrom purrr map +#' @importFrom rlang parse_expr .data +#' #' @keywords internal -trimData <- function(data, settings){ - +trimData <- function(data, settings, chart="edish"){ + ## Remove columns not in settings ## - col_names <- colnames(data) - settings_keys <- safetyGraphics::getSettingsMetadata(cols="text_key", filter_expr=column_mapping==TRUE) %>% - str_split("--") - settings_values <- map(settings_keys, function(x) {return(safetyGraphics:::getSettingValue(x, settings))}) - - common_cols <- intersect(col_names,settings_values) + 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']]"), @@ -44,19 +62,19 @@ trimData <- function(data, settings){ 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 + + # 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) - - } - + data_subset <- filter(data_subset, !!filter_expression) + + } + return(data_subset) } diff --git a/R/validateSettings.R b/R/validateSettings.R index fd5af710..59b982e5 100644 --- a/R/validateSettings.R +++ b/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) -} +} \ No newline at end of file diff --git a/inst/eDISH_app/modules/renderSettings/renderSettings.R b/inst/eDISH_app/modules/renderSettings/renderSettings.R index 3c6aa6d9..41e62c3f 100644 --- a/inst/eDISH_app/modules/renderSettings/renderSettings.R +++ b/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`) } diff --git a/man/checkField.Rd b/man/checkField.Rd index 253849d8..3d856609 100644 --- a/man/checkField.Rd +++ b/man/checkField.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{checkField} \alias{checkField} \title{Check that a setting parameter has a matching data field} diff --git a/man/checkFieldSettings.Rd b/man/checkFieldSettings.Rd deleted file mode 100644 index e8c48684..00000000 --- a/man/checkFieldSettings.Rd +++ /dev/null @@ -1,31 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/checkField.R -\name{checkFieldSettings} -\alias{checkFieldSettings} -\title{Check that a setting parameter has a matching data field} -\usage{ -checkFieldSettings(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:::checkFieldSettings(fieldKey=fields,settings=testSettings, data=adlbc) - -} -\keyword{internal} diff --git a/man/trimData.Rd b/man/trimData.Rd index 8f4dc1ef..c0f8223a 100644 --- a/man/trimData.Rd +++ b/man/trimData.Rd @@ -4,12 +4,14 @@ \alias{trimData} \title{Removes unnecessary rows and columns} \usage{ -trimData(data, settings) +trimData(data, settings, chart = "edish") } \arguments{ \item{data}{a data frame to trim} \item{settings}{the settings list used to determine which rows and columns to drop} + +\item{chart}{the chart being created} } \value{ A dataframe with unnecessary columns and rows removed @@ -19,7 +21,7 @@ Removes unnecessary rows and columns from data based on current settings } \examples{ testSettings <- generateSettings(standard="adam") -safetyGraphics:::trimData(data=adlbc, settings=testSettings) +trimmed<-safetyGraphics:::trimData(data=adlbc, settings=testSettings) } \keyword{internal} diff --git a/tests/testthat/test_trimData.R b/tests/testthat/test_trimData.R index 9acef804..aab56744 100644 --- a/tests/testthat/test_trimData.R +++ b/tests/testthat/test_trimData.R @@ -11,6 +11,9 @@ analysisFlag_settings <- settings analysisFlag_settings[['analysisFlag']][['value_col']] <- 'TRTA' analysisFlag_settings[['analysisFlag']][['values']] <- list("Placebo","Xanomeline High Dose") +filter_settings <- settings +filter_settings[['filters']]<-list("SEX", "AGEGR1") + both_settings <- baseline_settings both_settings[['analysisFlag']][['value_col']] <- 'TRTA' both_settings[['analysisFlag']][['values']] <- list("Placebo","Xanomeline High Dose") @@ -21,6 +24,8 @@ test_that("columns are removed",{ expect_length(trimData(adlbc, baseline_settings), 6) expect_length(trimData(adlbc, analysisFlag_settings), 7) expect_length(trimData(adlbc, both_settings), 7) + expect_length(trimData(adlbc, filter_settings), 8) + }) test_that("rows are removed",{ diff --git a/tests/testthat/test_validateSettings.R b/tests/testthat/test_validateSettings.R index 4f795d1f..1d5d6b00 100644 --- a/tests/testthat/test_validateSettings.R +++ b/tests/testthat/test_validateSettings.R @@ -48,14 +48,18 @@ test_that("field checks fail when expected",{ 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) + # a vector of values are each checked independently. + invalidFieldSettings <- validSettings + invalidFieldSettings$baseline[["value_col"]]<- "PARAM" + invalidFieldSettings$baseline[["values"]] <- list("not a filter","still not a filter") + + expect_false(safetyGraphics:::checkField(list("baseline","values",1), settings=invalidFieldSettings, data=adlbc )$valid) + + fieldFailed2<-validateSettings(data=adlbc,settings=invalidFieldSettings) + expect_false(fieldFailed2[["valid"]]) + expect_equal(fieldFailed2$checks%>%filter(!valid)%>%nrow,2) #2 fields fail }) test_that("required setting checks fail when expected",{ @@ -105,3 +109,17 @@ test_that("numeric column checks pass when more than half of the values are nume 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.") }) + +test_that("validateSettings works with filters and group_cols ",{ + groupFilterSettings <- validSettings + groupFilterSettings$filters <- list() + groupFilterSettings$filters[[1]] <- list(value_col = "RACE", + label = "RACE") + groupFilterSettings$group_cols <- list() + groupFilterSettings$group_cols[[1]] <- list(value_col = "SEX", + label = "SEX") + Passed<-validateSettings(data=adlbc,settings=groupFilterSettings) + expect_true(Passed[["valid"]]) +}) + +