diff --git a/R/checkColumn.R b/R/checkColumn.R index ff80d9fc..c6bb0db1 100644 --- a/R/checkColumn.R +++ b/R/checkColumn.R @@ -16,33 +16,33 @@ #' testSettings$filters[[1]]<-list(value_col="RACE",label="Race") #' testSettings$filters[[2]]<-list(value_col=NULL,label="No Column") #' testSettings$filters[[3]]<-list(value_col="NotAColumn",label="Invalid Column") -#' +#' #' #pass ($valid == TRUE) #' safetyGraphics:::checkColumn(key=list("id_col"), -#' settings=testSettings, adlbc) -#' +#' settings=testSettings, adlbc) +#' #' #pass #' safetyGraphics:::checkColumn(key=list("filters",1,"value_col"), -#' settings=testSettings, adlbc) -#' +#' settings=testSettings, adlbc) +#' #' #NULL column pass #' safetyGraphics:::checkColumn(key=list("filters",2,"value_col"), -#' settings=testSettings, adlbc) -#' +#' settings=testSettings, adlbc) +#' #' #invalid column fails #' safetyGraphics:::checkColumn(key=list("filters",3,"value_col"), -#' settings=testSettings, adlbc) +#' settings=testSettings, adlbc) #' @keywords internal checkColumn <- function(key, settings, data){ stopifnot(typeof(key)=="list",typeof(settings)=="list") - + current <- list(key=key) current$text_key <- paste( unlist(current$key), collapse='--') current$type <- "column" current$description <- "column parameter from setting setting found in data?" current$value <- getSettingValue(key=key,settings=settings) - if(is.na(current$value)||is.null(current$value)){ + if(is.null(current$value)){ current$value <- "--No Value Given--" current$valid <- TRUE current$message <- "" diff --git a/R/checkNumeric.R b/R/checkNumeric.R index 1dbe2983..588c95b4 100644 --- a/R/checkNumeric.R +++ b/R/checkNumeric.R @@ -10,11 +10,11 @@ #' @examples #' testSettings<-generateSettings(standard="AdAM") #' #pass ($valid == FALSE) -#' safetyGraphics:::checkNumeric(key=list("id_col"),settings=testSettings, data=adlbc) -#' +#' safetyGraphics:::checkNumeric(key=list("id_col"),settings=testSettings, data=adlbc) +#' #' #pass ($valid == TRUE) -#' safetyGraphics:::checkNumeric(key=list("value_col"),settings=testSettings, data=adlbc) -#' +#' safetyGraphics:::checkNumeric(key=list("value_col"),settings=testSettings, data=adlbc) +#' #' @keywords internal checkNumeric <- function(key, settings, data){ @@ -25,7 +25,7 @@ checkNumeric <- function(key, settings, data){ current$type <- "numeric" current$description <- "specified column is numeric?" current$value <- getSettingValue(key=key,settings=settings) - if(is.na(current$value)||is.null(current$value)){ + if(is.null(current$value)){ current$value <- "--No Value Given--" current$valid <- TRUE current$message <- "" diff --git a/R/generateSettings.R b/R/generateSettings.R index 7fd2e4cd..7a2963c7 100644 --- a/R/generateSettings.R +++ b/R/generateSettings.R @@ -1,80 +1,80 @@ #' Generate a settings object based on a data standard #' -#' This function returns a settings object for the eDish chart based on the specified data standard. +#' This function returns a settings object for the eDish chart based on the specified data standard. #' #' The function is designed to work with the SDTM and AdAM CDISC() standards for clinical trial data. Currently, eDish is the only chart supported. #' #' @param standard The data standard for which to create settings. Valid options are "SDTM", "AdAM" or "None". Default: \code{"None"}. #' @param charts The chart or chart(s) for which settings should be generated. Default: \code{NULL} (uses all available charts). -#' @param useDefaults Specifies whether default values from settingsMetadata should be included in the settings object. Default: \code{TRUE}. +#' @param useDefaults Specifies whether default values from settingsMetadata should be included in the settings object. Default: \code{TRUE}. #' @param partial Boolean for whether or not the standard is a partial standard. Default: \code{FALSE}. #' @param partial_keys Optional character vector of the matched settings if partial is TRUE. Settings should be identified using the text_key format described in ?settingsMetadata. Setting is ignored when partial is FALSE. Default: \code{NULL}. -#' @param custom_settings a tibble with text_key and customValue columns specifiying customizations to be applied to the settings object. Default: \code{NULL}. +#' @param custom_settings a tibble with text_key and customValue columns specifiying customizations to be applied to the settings object. Default: \code{NULL}. #' @return A list containing the appropriate settings for the selected chart -#' -#' @examples -#' -#' generateSettings(standard="SDTM") +#' +#' @examples +#' +#' generateSettings(standard="SDTM") #' generateSettings(standard="SdTm") #also ok #' generateSettings(standard="ADaM") #' pkeys<- c("id_col","measure_col","value_col") #' generateSettings(standard="adam", partial=TRUE, partial_keys=pkeys) -#' -#' generateSettings(standard="a different standard") +#' +#' generateSettings(standard="a different standard") #' #returns shell settings list with no data mapping -#' +#' #' \dontrun{ -#' generateSettings(standard="adam",chart="AEExplorer") #Throws error. Only eDish supported so far. +#' generateSettings(standard="adam",chart="AEExplorer") #Throws error. Only eDish supported so far. #' } -#' +#' #' @importFrom dplyr "filter" full_join #' @importFrom stringr str_split #' @importFrom rlang .data -#' +#' #' @export generateSettings <- function(standard="None", charts=NULL, useDefaults=TRUE, partial=FALSE, partial_keys=NULL, custom_settings=NULL){ - + # Check that partial_keys is supplied if partial is true if (is.null(partial_keys) & partial ) { stop("partial_keys must be supplied if the standard is partial") } - + # Coerce options to lowercase standard<-tolower(standard) if(!is.null(charts)){ - charts<-tolower(charts) + charts<-tolower(charts) } - + ############################################################################# - # get keys & default values for settings using a data standard (data and field mappings) + # get keys & default values for settings using a data standard (data and field mappings) ############################################################################ # Build a table of data mappings for the selected standard and partial settings standardList<-safetyGraphics::standardsMetadata%>%select(-.data$text_key)%>%names - + if(standard %in% standardList){ dataDefaults <- safetyGraphics::getSettingsMetadata( - charts = charts, + charts = charts, cols=c("text_key",standard,"setting_required") - ) %>% + ) %>% filter(.data$setting_required)%>% - select(-.data$setting_required)%>% + select(-.data$setting_required)%>% rename("dataDefault" = standard)%>% filter(.data$dataDefault != '') }else{ dataDefaults<-tibble(text_key=character(),dataDefault=character(), .rows=0) } - + if(partial){ - dataDefaults <-dataDefaults%>%filter(.data$text_key %in% partial_keys) + dataDefaults <-dataDefaults%>%filter(.data$text_key %in% partial_keys) } - + ############################################################################# - # get keys & default values for settings not using a data standard + # get keys & default values for settings not using a data standard ############################################################################# if(useDefaults){ otherDefaults <- safetyGraphics::getSettingsMetadata( - charts = charts, + charts = charts, filter = !.data$column_mapping & !.data$field_mapping, cols=c("text_key","default") )%>% @@ -82,13 +82,13 @@ generateSettings <- function(standard="None", charts=NULL, useDefaults=TRUE, par }else{ otherDefaults <- tibble(text_key=character(),otherDefault=character(), .rows=0) } - + ############################################################################# # merge all keys & default values ############################################################################# key_values <- full_join(dataDefaults, otherDefaults, by="text_key") key_values <- key_values %>% mutate(default=ifelse(is.na(.data$dataDefault),.data$otherDefault,.data$dataDefault)) - + ############################################################################# # Apply custom settings (if any) ############################################################################# @@ -97,24 +97,24 @@ generateSettings <- function(standard="None", charts=NULL, useDefaults=TRUE, par } else { key_values$customValue<-NA } - + key_values<-key_values %>% mutate(value=ifelse(is.na(.data$customValue), .data$default, .data$customValue)) - + ############################################################################# # create shell settings object ############################################################################# - shell<-generateShell(charts=charts) - + shell<-generateShell(charts=charts) + ######################################################################################### # populate the shell settings by looping through key_values and apply them to the shell ######################################################################################### for(row in 1:nrow(key_values)){ shell<-setSettingsValue( - settings = shell, - key = textKeysToList(key_values[row,"text_key"])[[1]], + settings = shell, + key = textKeysToList(key_values[row,"text_key"])[[1]], value = key_values[row, "value"][[1]] ) - } - + } + return(shell) } diff --git a/R/generateShell.R b/R/generateShell.R index e6ba68ba..f0dac6d7 100644 --- a/R/generateShell.R +++ b/R/generateShell.R @@ -24,7 +24,7 @@ generateShell <- function(charts=NULL){ for (i in 1:length(keys) ) { shell<-setSettingsValue( key=keys[[i]], - value=NA, #NA is prefered here since NULL deletes the element in the list + value=NULL, settings=shell, forceCreate=TRUE ) diff --git a/R/setSettingsValue.R b/R/setSettingsValue.R index cf8ce72d..e0cf4f53 100644 --- a/R/setSettingsValue.R +++ b/R/setSettingsValue.R @@ -34,7 +34,11 @@ setSettingsValue <- function(key, value, settings, forceCreate=FALSE){ firstKey <- key[[1]] if(length(key)==1){ - settings[[firstKey]]<-value + if(is.null(value)){ + settings[firstKey]<-list(NULL) + }else{ + settings[[firstKey]]<-value + } return(settings) }else{ settings[[firstKey]]<-setSettingsValue(settings = settings[[firstKey]],key = key[2:length(key)], value=value, forceCreate=forceCreate) diff --git a/R/trimData.R b/R/trimData.R index fb150005..b7e72c54 100644 --- a/R/trimData.R +++ b/R/trimData.R @@ -22,10 +22,10 @@ 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){ @@ -37,12 +37,12 @@ trimData <- function(data, settings, chart="edish"){ sub <- current[[i]] if(typeof(sub)=="list"){ newKey[[1+length(newKey)]]<-"value_col" - } - dataKeys[[1+length(dataKeys)]]<-newKey + } + dataKeys[[1+length(dataKeys)]]<-newKey } } } - + settings_values <- map(dataKeys, function(x) {return(getSettingValue(x, settings))}) common_cols <- intersect(col_names,settings_values) @@ -51,10 +51,10 @@ trimData <- function(data, settings, chart="edish"){ ## Remove rows if baseline or analysisFlag is specified ## baselineSetting<-settings[['baseline']][['value_col']] - baselineMissing <- is.null(baselineSetting) || is.na(baselineSetting) + baselineMissing <- is.null(baselineSetting) analysisSetting<-settings[['analysisFlag']][['value_col']] - analysisMissing <- is.null(analysisSetting) || is.na(analysisSetting) - + analysisMissing <- is.null(analysisSetting) + if(!baselineMissing | !analysisMissing) { # Create Baseline String diff --git a/tests/testthat/test_generateSettings.R b/tests/testthat/test_generateSettings.R index 4bd49f3a..f99a356c 100644 --- a/tests/testthat/test_generateSettings.R +++ b/tests/testthat/test_generateSettings.R @@ -28,13 +28,13 @@ test_that("data mappings are null when setting=none, character otherwise",{ none_settings <- generateSettings(standard="None") for(text_key in data_setting_keys){ key<-textKeysToList(text_key)[[1]] - expect_equal(getSettingValue(settings=none_settings,key=key),NA) + expect_equal(getSettingValue(settings=none_settings,key=key),NULL) } other_settings <- generateSettings(standard="a different standard") for(text_key in data_setting_keys){ key<-textKeysToList(text_key)[[1]] - expect_equal(getSettingValue(settings=other_settings,key=key),NA) + expect_equal(getSettingValue(settings=other_settings,key=key),NULL) } sdtm_settings <- generateSettings(standard="SDTM") @@ -71,7 +71,7 @@ test_that("data mappings are null when setting=none, character otherwise",{ if (text_key %in% c("id_col","measure_col","measure_values--ALT")) { expect_is(getSettingValue(settings=partial_adam_settings,key=key),"character") } else { - expect_equal(getSettingValue(settings=partial_adam_settings,key=key),NA) + expect_equal(getSettingValue(settings=partial_adam_settings,key=key),NULL) } } @@ -92,7 +92,7 @@ test_that("data mappings are null when setting=none, character otherwise",{ #non data mappings are NA for(text_key in option_keys){ key<-textKeysToList(text_key)[[1]] - expect_equal(getSettingValue(settings=noDefaults,key=key),NA) + expect_equal(getSettingValue(settings=noDefaults,key=key),NULL) } #data mappings are filled as expected diff --git a/tests/testthat/test_generateShell.R b/tests/testthat/test_generateShell.R index c271a10b..f0dbbba7 100644 --- a/tests/testthat/test_generateShell.R +++ b/tests/testthat/test_generateShell.R @@ -5,8 +5,8 @@ default <- generateShell() test_that("a list with the expected properties and structure is returned by default",{ expect_type(default, "list") - expect_equal(default[["id_col"]],NA) - expect_equal(default[["measure_values"]][["ALT"]],NA) + expect_equal(default[["id_col"]],NULL) + expect_equal(default[["measure_values"]][["ALT"]],NULL) expect_null(default[["not_a_setting"]]) })