diff --git a/R/detectStandard.R b/R/detectStandard.R index 6a7acf5a..da4a806c 100644 --- a/R/detectStandard.R +++ b/R/detectStandard.R @@ -1,16 +1,16 @@ #' Detect the data standard used for a data set #' -#' This function attempts to detect the data CDISC clinical standard used in a given R data frame. +#' This function attempts to detect the clinical data standard used in a given R data frame. #' -#' This function compares the columns in the provided \code{"data"} with the required columns for a given data standard/domain combination. The function is designed to work with the SDTM and AdAM CDISC() standards for clinical trial data. Currently, "labs" is the only domain supported. +#' This function compares the columns in the provided \code{"data"} with the required columns for a given data standard/domain combination. The function is designed to work with the SDTM and AdAM CDISC() standards for clinical trial data by default. Additional standards can be added by modifying the \code{"standardMetadata"} data set included as part of this package. Currently, "labs" is the only domain supported. #' #' @param data A data frame in which to detect the data standard #' @param includeFields specifies whether to check the data set for field level data in addition to columns. Default: \code{TRUE}. #' @param domain The data domain for the data set provided. Default: \code{"labs"}. -#' @return A list containing the matching \code{"standard"} ("ADaM", "SDTM" or "None") and a list of \code{"details"} describing each standard considered. +#' @return A list containing the matching \code{"standard"} from \code{"standardMetadata"} and a list of \code{"details"} describing each standard considered. #' @examples -#' detectStandard(adlbc)[["standard"]] #AdAM +#' detectStandard(adlbc)[["standard"]] #adam #' detectStandard(iris)[["standard"]] #none #' #' \dontrun{ @@ -26,28 +26,45 @@ detectStandard <- function(data, includeFields=TRUE, domain="labs"){ ) - # Create placeholder list, with Standard = None. + # Create placeholder list, with Standard = none. + available_standards <- safetyGraphics::standardsMetadata %>% select(-.data$text_key) %>% names standard_list <- list() standard_list[["details"]] = list() - standard_list[["details"]][["ADaM"]]<-evaluateStandard(data,standard="ADaM", includeFields=includeFields, domain=domain) - standard_list[["details"]][["SDTM"]]<-evaluateStandard(data,standard="SDTM", includeFields=includeFields, domain=domain) + standard_list[["standard"]] = "none" + standard_list[["standard_percent"]] = 0 + + for(standard in available_standards){ + # evaluate the current standard and save the result + standard_list[["details"]][[standard]]<-evaluateStandard(data,standard=standard, includeFields=includeFields, domain=domain) + + # if the current standard is a better match, use it as the overall standard + # if there is a tie, don't change the standard - this means the column order in standardMetadata breaks ties! + current_percent <- standard_list[["details"]][[standard]][["match_percent"]] + overall_percent <- standard_list[["standard_percent"]] + if(current_percent > overall_percent){ + standard_list[["standard"]] <- standard + standard_list[["standard_percent"]] <- current_percent + } + } # Determine the final standard - if(standard_list[["details"]][["SDTM"]][["match"]] == "Full"){ - standard_list[["standard"]]<- "SDTM" - } else if(standard_list[["details"]][["ADaM"]][["match"]] == "Full"){ - standard_list[["standard"]]<- "ADaM" - } else if(standard_list[["details"]][["SDTM"]][["match"]] == "Partial" | - standard_list[["details"]][["ADaM"]][["match"]] == "Partial"){ - standard_list[["standard"]] <- ifelse( - length(standard_list[["details"]][["ADaM"]][["valid_count"]]) > - length(standard_list[["details"]][["SDTM"]][["valid_count"]]), - "ADaM" , "SDTM" #SDTM if they are equal - ) - - } else { - standard_list[["standard"]]<-"None" - } + + # TODO: write a general algorithm to do this ... + # if(standard_list[["details"]][["sdtm"]][["match"]] == "Full"){ + # standard_list[["standard"]]<- "sdtm" + # } else if(standard_list[["details"]][["adam"]][["match"]] == "Full"){ + # standard_list[["standard"]]<- "adam" + # } else if(standard_list[["details"]][["sdtm"]][["match"]] == "Partial" | + # standard_list[["details"]][["adam"]][["match"]] == "Partial"){ + # standard_list[["standard"]] <- ifelse( + # length(standard_list[["details"]][["adam"]][["valid_count"]]) > + # length(standard_list[["details"]][["sdtm"]][["valid_count"]]), + # "adam" , "sdtm" #SDTM if they are equal + # ) + # + # } else { + # standard_list[["standard"]]<-"None" + # } return(standard_list) } diff --git a/R/evaluateStandard.R b/R/evaluateStandard.R index ae820df5..ffe13068 100644 --- a/R/evaluateStandard.R +++ b/R/evaluateStandard.R @@ -7,7 +7,7 @@ #' @param includeFields should field level data be evaluated? #' @param domain data domain. "labs" only for now. #' -#' @return a list describing to what degree the data set matches the data standard. The "match" property describes compliance with the standard as "Full", "Partial" or "None". The "checks" property is a list of the data elements expected for the standard and whether they are "valid" in the given data set. "valid_checks" and "invalid_checks" provide counts of the specified checks. +#' @return a list describing to what degree the data set matches the data standard. The "match" property describes compliance with the standard as "full", "partial" or "none". The "checks" property is a list of the data elements expected for the standard and whether they are "valid" in the given data set. "total_checks", "valid_checks" and "invalid_checks" provide counts of the specified checks. "match_percent" is calculated as valid_checks/total_checks. #' #' @examples #' safetyGraphics:::evaluateStandard(data=adlbc, standard="adam") # Match is TRUE @@ -26,8 +26,7 @@ evaluateStandard <- function(data, standard, includeFields=TRUE, domain="labs"){ is.data.frame(data), is.character(standard), is.logical(includeFields), - is.character(domain), - tolower(standard) %in% c("adam","sdtm") + is.character(domain) ) standard<-tolower(standard) @@ -43,7 +42,8 @@ evaluateStandard <- function(data, standard, includeFields=TRUE, domain="labs"){ mutate(type = ifelse(.data$column_mapping, "column", "field")) %>% rowwise %>% mutate(field_column_name = ifelse(.data$field_mapping, getSettingsMetadata(cols=standard, text_keys=.data$field_column_key),"")) %>% - mutate(valid = ifelse(.data$column_mapping, + mutate( + valid = ifelse(.data$column_mapping, hasColumn(data=data, columnName=.data$standard_val), hasField(data=data, columnName=.data$field_column_name, fieldValue=.data$standard_val) )) %>% @@ -54,20 +54,20 @@ evaluateStandard <- function(data, standard, includeFields=TRUE, domain="labs"){ standardChecks <- standardChecks %>% filter(.data$type != "field") } - # compare_summary[["checks"]] <- split(standardChecks, seq(nrow(standardChecks)))%>%map(~as.list(.)) #coerce to list of lists? - compare_summary[["checks"]] <- standardChecks #or just keep the tibble ... + compare_summary[["checks"]] <- standardChecks # count valid/invalid data elements + compare_summary[["total_count"]] <- standardChecks %>% nrow() compare_summary[["valid_count"]] <- standardChecks %>% filter(.data$valid) %>% nrow() compare_summary[["invalid_count"]] <- standardChecks %>% filter(!.data$valid) %>% nrow() - - + compare_summary[["match_percent"]] <- compare_summary[["valid_count"]] / compare_summary[["total_count"]] + if (compare_summary[["invalid_count"]]==0) { - compare_summary[["match"]] <- "Full" + compare_summary[["match"]] <- "full" } else if(compare_summary[["valid_count"]]>0) { - compare_summary[["match"]] <- "Partial" + compare_summary[["match"]] <- "partial" } else { - compare_summary[["match"]] <- "None" + compare_summary[["match"]] <- "none" } return(compare_summary) diff --git a/R/getSettingsMetadata.R b/R/getSettingsMetadata.R index 14257138..7ae8aec8 100644 --- a/R/getSettingsMetadata.R +++ b/R/getSettingsMetadata.R @@ -5,6 +5,7 @@ #' @param charts optional vector of chart names used to filter the metadata. Exact matches only (case-insensitive). All rows returned by default. #' @param text_keys optional vector of keys used to filter the metadata. Partial matches for any of the strings are returned (case-insensitive). All rows returned by default. #' @param filter_expr optional filter expression used to subset the data. +#' @param add_standards should data standard info stored in standardsMetadata be included #' @param cols optional vector of columns to return from the metadata. All columns returned by default. #' @param metadata metadata data frame to be queried #' @@ -27,9 +28,15 @@ #' #' @export -getSettingsMetadata<-function(charts=NULL, text_keys=NULL, cols=NULL, filter_expr=NULL, metadata = safetyGraphics::settingsMetadata){ +getSettingsMetadata<-function(charts=NULL, text_keys=NULL, cols=NULL, filter_expr=NULL, add_standards=TRUE, metadata = safetyGraphics::settingsMetadata){ - md <- metadata + md <- metadata %>% mutate(text_key=as.character(.data$text_key)) + + if(add_standards){ + ms<-safetyGraphics::standardsMetadata %>% mutate(text_key=as.character(.data$text_key)) + md<-md%>%left_join(ms, by="text_key") + } + all_columns <- names(md) #filter the metadata based on the charts option (if any) diff --git a/R/settingsMetadata.R b/R/settingsMetadata.R index 5e8981f6..92882d95 100644 --- a/R/settingsMetadata.R +++ b/R/settingsMetadata.R @@ -8,15 +8,13 @@ #' \item{text_key}{Text key indicating the setting name. \code{'--'} delimiter indicates a nested setting} #' \item{label}{Label} #' \item{description}{Description} -#' \item{setting_cat}{Setting category (data, measure, appearance)} #' \item{setting_type}{Expected type for setting value. Should be "character", "vector", "numeric" or "logical"} #' \item{setting_required}{Flag indicating if the setting is required} #' \item{column_mapping}{Flag indicating if the setting corresponds to a column in the associated data} #' \item{column_type}{Expected type for the data column values. Should be "character","logical" or "numeric"} #' \item{field_mapping}{Flag indicating whether the setting corresponds to a field-level mapping in the data} #' \item{field_column_key}{Key for the column that provides options for the field-level mapping in the data} -#' \item{adam}{Settings values for the ADaM standard} -#' \item{sdtm}{Settings values for the SDTM standard} +#' \item{setting_cat}{Setting category (data, measure, appearance)} #' } #' #' @source Created for this package diff --git a/R/standardsMetadata.R b/R/standardsMetadata.R new file mode 100644 index 00000000..c1ffaac0 --- /dev/null +++ b/R/standardsMetadata.R @@ -0,0 +1,13 @@ +#' Standards Metadata +#' +#' Metadata about the data standards used to configure safetyGraphics charts. One record per unique setting. Columns contain default setting values for clinical data standards, like the CDISC "adam" and "sdtm" standards. +#' +#' @format A data frame with 25 rows and 3 columns +#' \describe{ +#' \item{text_key}{Text key indicating the setting name. \code{'--'} delimiter indicates a nested setting} +#' \item{adam}{Settings values for the ADaM standard} +#' \item{sdtm}{Settings values for the SDTM standard} +#' } +#' +#' @source Created for this package +"standardsMetadata" \ No newline at end of file diff --git a/data-raw/csv_to_rda.R b/data-raw/csv_to_rda.R index 9449676f..de6c8b5f 100644 --- a/data-raw/csv_to_rda.R +++ b/data-raw/csv_to_rda.R @@ -3,5 +3,8 @@ library(usethis) ablbc <- read.csv("data-raw/adlbc.csv") usethis::use_data(adlbc, overwrite = TRUE) -settingsMetadata<- read.csv("data-raw/settingsMetadata.csv") +settingsMetadata <- read.csv("data-raw/settingsMetadata.csv") usethis::use_data(settingsMetadata, overwrite = TRUE) + +standardsMetadata <- read.csv("data-raw/standardsMetadata.csv") +usethis::use_data(standardsMetadata, overwrite = TRUE) \ No newline at end of file diff --git a/data-raw/settingsMetadata.csv b/data-raw/settingsMetadata.csv index 3854500d..ac64c845 100644 --- a/data-raw/settingsMetadata.csv +++ b/data-raw/settingsMetadata.csv @@ -1,26 +1,26 @@ -chart_edish,text_key,label,description,setting_type,setting_required,column_mapping,column_type,field_mapping,field_column_key,adam,sdtm,setting_cat -TRUE,id_col,ID column,Unique subject identifier variable name.,character,TRUE,TRUE,character,FALSE,,USUBJID,USUBJID,data -TRUE,value_col,Value column,Lab result variable name.,character,TRUE,TRUE,numeric,FALSE,,AVAL,STRESN,data -TRUE,measure_col,Measure column,Lab measure variable name,character,TRUE,TRUE,character,FALSE,,PARAM,TEST,data -TRUE,measure_values--ALT,Alanine Aminotransferase value,Value used for Alanine Aminotransferase in the specified measure column,character,TRUE,FALSE,NA,TRUE,measure_col,Alanine Aminotransferase (U/L),"Aminotransferase, alanine (ALT)",data -TRUE,measure_values--AST,Aspartate Aminotransferase value,Value used for Aspartate Aminotransferase in the specified measure column,character,TRUE,FALSE,NA,TRUE,measure_col,Aspartate Aminotransferase (U/L),"Aminotransferase, aspartate (AST)",data -TRUE,measure_values--TB,Total Bilirubin value,Value used for Total Bilirubin in the specified measure column,character,TRUE,FALSE,NA,TRUE,measure_col,Bilirubin (umol/L),Total Bilirubin,data -TRUE,measure_values--ALP,Alkaline Phosphatase value,Value used for Alkaline Phosphatase in the specified measure column,character,TRUE,FALSE,NA,TRUE,measure_col,Alkaline Phosphatase (U/L),Alkaline phosphatase (ALP),data -TRUE,normal_col_low,Lower Limit of Normal column,Lower limit of normal variable name,character,TRUE,TRUE,numeric,FALSE,,A1LO,STNRLO,data -TRUE,normal_col_high,Upper Limit of Normal column,Upper limit of normal variable name,character,TRUE,TRUE,numeric,FALSE,,A1HI,STNRHI,data -TRUE,studyday_col,Study Day column,Visit day variable name,character,TRUE,TRUE,numeric,FALSE,,ADY,DY,data -TRUE,visit_col,Visit column,Visit variable name,character,FALSE,TRUE,character,FALSE,,VISIT,VISIT,data -TRUE,visitn_col,Visit Number column,Visit number variable name,character,FALSE,TRUE,numeric,FALSE,,VISITNUM,VISITNUM,data -TRUE,filters,Filters columns,"An optional list of specifications for filters. Each filter is a nested, named list (containing the filter value column: 'value_col' and associated label: 'label') within the larger list.",vector,FALSE,TRUE,NA,FALSE,,,,data -TRUE,group_cols,Group columns,"An optional list of specifications for grouping columns. Each group column is a nested, named list (containing the group variable column: 'value_col' and associated label: 'label') within the larger list. ",vector,FALSE,TRUE,NA,FALSE,,,,data -TRUE,baseline--value_col,Baseline column,An optional list defining which column represent the baseline visit(s) of the study.,character,FALSE,TRUE,NA,FALSE,,,,data -TRUE,baseline--values,Baseline values,An optional list defining which values (one or more) represent the baseline visit(s) of the study.,vector,FALSE,FALSE,NA,TRUE,baseline--value_col,,,data -TRUE,analysisFlag--value_col,Analysis Flag column,An optional list defining which column should be used in eDish and mDish analyses.,character,FALSE,TRUE,NA,FALSE,,,,data -TRUE,analysisFlag--values,Analysis Flag values,An optional list defining which values should be used in eDish and mDish analyses.,vector,FALSE,FALSE,NA,TRUE,analysisFlag--value_col,,,data -TRUE,x_options,X axis options,"Specifies variable options for the x-axis using the key values from measure_values (e.g. 'ALT'). When multiple options are specified, a control allowing the user to interactively change the x variable is shown. ",vector,FALSE,FALSE,NA,FALSE,,,,measure -TRUE,y_options,Y axis options,"Specifies variable options for the y-axis using the key values from measure_values (e.g. 'TB'). When multiple options are specified, a control allowing the user to interactively change the y variable is shown. ",vector,FALSE,FALSE,NA,FALSE,,,,measure -TRUE,visit_window,Default Visit Window in Days ,Default visit window used to highlight eDish points where x and y measures occurred within the specified number of days. Editable by user after render. ,numeric,FALSE,FALSE,NA,FALSE,,,,appearance -TRUE,r_ratio_filter,Show R Ratio Filter?,Specifies whether the R Ratio filter should be shown. R ratio is defined as: (ALT value/ULN for ALT) / (ALP value/ULN for ALP).,logical,FALSE,FALSE,NA,FALSE,,,,appearance -TRUE,r_ratio_cut,Default R Ratio Cut,Default cut point for R Ratio filter. Ignored when r_ratio_filter = FALSE. User can update this setting via the UI when r_ratio_filter = TRUE. ,numeric,FALSE,FALSE,NA,FALSE,,,,appearance -TRUE,showTitle,Show Chart Title? ,Specifies whether the title should be drawn above the controls.,logical,FALSE,FALSE,NA,FALSE,,,,appearance -TRUE,warningText,Warning text,"Informational text to be displayed near the top of the controls (beneath the title, if any). No warning is displayed if warningText = ''. ",character,FALSE,FALSE,NA,FALSE,,,,appearance +chart_edish,text_key,label,description,setting_type,setting_required,column_mapping,column_type,field_mapping,field_column_key,setting_cat +TRUE,id_col,ID column,Unique subject identifier variable name.,character,TRUE,TRUE,character,FALSE,,data +TRUE,value_col,Value column,Lab result variable name.,character,TRUE,TRUE,numeric,FALSE,,data +TRUE,measure_col,Measure column,Lab measure variable name,character,TRUE,TRUE,character,FALSE,,data +TRUE,measure_values--ALT,Alanine Aminotransferase value,Value used for Alanine Aminotransferase in the specified measure column,character,TRUE,FALSE,NA,TRUE,measure_col,data +TRUE,measure_values--AST,Aspartate Aminotransferase value,Value used for Aspartate Aminotransferase in the specified measure column,character,TRUE,FALSE,NA,TRUE,measure_col,data +TRUE,measure_values--TB,Total Bilirubin value,Value used for Total Bilirubin in the specified measure column,character,TRUE,FALSE,NA,TRUE,measure_col,data +TRUE,measure_values--ALP,Alkaline Phosphatase value,Value used for Alkaline Phosphatase in the specified measure column,character,TRUE,FALSE,NA,TRUE,measure_col,data +TRUE,normal_col_low,Lower Limit of Normal column,Lower limit of normal variable name,character,TRUE,TRUE,numeric,FALSE,,data +TRUE,normal_col_high,Upper Limit of Normal column,Upper limit of normal variable name,character,TRUE,TRUE,numeric,FALSE,,data +TRUE,studyday_col,Study Day column,Visit day variable name,character,TRUE,TRUE,numeric,FALSE,,data +TRUE,visit_col,Visit column,Visit variable name,character,FALSE,TRUE,character,FALSE,,data +TRUE,visitn_col,Visit Number column,Visit number variable name,character,FALSE,TRUE,numeric,FALSE,,data +TRUE,filters,Filters columns,"An optional list of specifications for filters. Each filter is a nested, named list (containing the filter value column: 'value_col' and associated label: 'label') within the larger list.",vector,FALSE,TRUE,NA,FALSE,,data +TRUE,group_cols,Group columns,"An optional list of specifications for grouping columns. Each group column is a nested, named list (containing the group variable column: 'value_col' and associated label: 'label') within the larger list. ",vector,FALSE,TRUE,NA,FALSE,,data +TRUE,baseline--value_col,Baseline column,An optional list defining which column represent the baseline visit(s) of the study.,character,FALSE,TRUE,NA,FALSE,,data +TRUE,baseline--values,Baseline values,An optional list defining which values (one or more) represent the baseline visit(s) of the study.,vector,FALSE,FALSE,NA,TRUE,baseline--value_col,data +TRUE,analysisFlag--value_col,Analysis Flag column,An optional list defining which column should be used in eDish and mDish analyses.,character,FALSE,TRUE,NA,FALSE,,data +TRUE,analysisFlag--values,Analysis Flag values,An optional list defining which values should be used in eDish and mDish analyses.,vector,FALSE,FALSE,NA,TRUE,analysisFlag--value_col,data +TRUE,x_options,X axis options,"Specifies variable options for the x-axis using the key values from measure_values (e.g. 'ALT'). When multiple options are specified, a control allowing the user to interactively change the x variable is shown. ",vector,FALSE,FALSE,NA,FALSE,,measure +TRUE,y_options,Y axis options,"Specifies variable options for the y-axis using the key values from measure_values (e.g. 'TB'). When multiple options are specified, a control allowing the user to interactively change the y variable is shown. ",vector,FALSE,FALSE,NA,FALSE,,measure +TRUE,visit_window,Default Visit Window in Days ,Default visit window used to highlight eDish points where x and y measures occurred within the specified number of days. Editable by user after render. ,numeric,FALSE,FALSE,NA,FALSE,,appearance +TRUE,r_ratio_filter,Show R Ratio Filter?,Specifies whether the R Ratio filter should be shown. R ratio is defined as: (ALT value/ULN for ALT) / (ALP value/ULN for ALP).,logical,FALSE,FALSE,NA,FALSE,,appearance +TRUE,r_ratio_cut,Default R Ratio Cut,Default cut point for R Ratio filter. Ignored when r_ratio_filter = FALSE. User can update this setting via the UI when r_ratio_filter = TRUE. ,numeric,FALSE,FALSE,NA,FALSE,,appearance +TRUE,showTitle,Show Chart Title? ,Specifies whether the title should be drawn above the controls.,logical,FALSE,FALSE,NA,FALSE,,appearance +TRUE,warningText,Warning text,"Informational text to be displayed near the top of the controls (beneath the title, if any). No warning is displayed if warningText = ''. ",character,FALSE,FALSE,NA,FALSE,,appearance \ No newline at end of file diff --git a/data-raw/standardsMetadata.csv b/data-raw/standardsMetadata.csv new file mode 100644 index 00000000..b51715e9 --- /dev/null +++ b/data-raw/standardsMetadata.csv @@ -0,0 +1,26 @@ +text_key,sdtm,adam +id_col,USUBJID,USUBJID +value_col,STRESN,AVAL +measure_col,TEST,PARAM +normal_col_low,STNRLO,A1LO +normal_col_high,STNRHI,A1HI +studyday_col,DY,ADY +visit_col,VISIT,VISIT +visitn_col,VISITNUM,VISITNUM +filters,, +group_cols,, +measure_values--ALT,"Aminotransferase, alanine (ALT)",Alanine Aminotransferase (U/L) +measure_values--AST,"Aminotransferase, aspartate (AST)",Aspartate Aminotransferase (U/L) +measure_values--TB,Total Bilirubin,Bilirubin (umol/L) +measure_values--ALP,Alkaline phosphatase (ALP),Alkaline Phosphatase (U/L) +baseline--value_col,, +baseline--values,, +analysisFlag--value_col,, +analysisFlag--values,, +x_options,, +y_options,, +visit_window,, +r_ratio_filter,, +r_ratio_cut,, +showTitle,, +warningText,, \ No newline at end of file diff --git a/data/settingsMetadata.rda b/data/settingsMetadata.rda index 80803726..525b0f1d 100644 Binary files a/data/settingsMetadata.rda and b/data/settingsMetadata.rda differ diff --git a/data/standardsMetadata.rda b/data/standardsMetadata.rda new file mode 100644 index 00000000..4aaca682 Binary files /dev/null and b/data/standardsMetadata.rda differ diff --git a/inst/eDISH_app/modules/dataUpload/dataUpload.R b/inst/eDISH_app/modules/dataUpload/dataUpload.R index 57f4de9c..781b1410 100644 --- a/inst/eDISH_app/modules/dataUpload/dataUpload.R +++ b/inst/eDISH_app/modules/dataUpload/dataUpload.R @@ -1,16 +1,16 @@ dataUpload <- function(input, output, session){ - + ns <- session$ns - + # initiate reactive values - list of uploaded data files # standard to imitate output of detectStandard.R - dd <- reactiveValues(data = list("Example data" = adlbc), current = 1, standard = list(list("standard" = "ADaM", "details" = list("ADaM"=list("match"="Full"))))) - + dd <- reactiveValues(data = list("Example data" = adlbc), current = 1, standard = list(list("standard" = "adam", "details" = list("adam"=list("match"="full"))))) + # modify reactive values when data is uploaded observeEvent(input$datafile,{ - + data_list <- list() - + ## data list for (i in 1:nrow(input$datafile)){ if (length(grep(".csv", input$datafile$name[i], ignore.case = TRUE)) > 0){ @@ -23,87 +23,87 @@ dataUpload <- function(input, output, session){ } # names names(data_list) <- input$datafile$name - + # append to existing reactiveValues list dd$data <- c(dd$data, data_list) - + # set dd$current to FALSE for previous & TRUE for current uploads dd$current <- c(rep(FALSE, length(dd$current)), rep(TRUE, length(data_list))) - + # run detectStandard on new data and save to dd$standard - + standard_list <- lapply(data_list, function(x){ detectStandard(x) }) - + #standard_list <- lapply(data_list, function(x){ detectStandard(x)$standard }) - + dd$standard <- c(dd$standard, standard_list) - + }) - - + + ### make a reactive combining dd$data & standard data_choices <- reactive({ - + req(dd$data) req(dd$standard) - + choices <- list() for (i in 1:length(dd$data)){ choices[[i]] <- names(dd$data)[i] } for (i in 1:length(dd$data)){ - + temp_standard <- dd$standard[[i]]$standard - - if(temp_standard == "None") { + standard_label <- ifelse(temp_standard=="adam","AdAM",ifelse(temp_standard=="sdtm","SDTM",temp_standard)) + if(temp_standard == "none") { names(choices)[i] <- paste0("

", names(dd$data)[i], " - No Standard Detected

") - } else if (dd$standard[[i]]$details[[temp_standard]]$match == "Full") { - names(choices)[i] <- paste0("

", names(dd$data)[i], " - ", dd$standard[[i]]$standard, "

") + } else if (dd$standard[[i]]$details[[temp_standard]]$match == "full") { + names(choices)[i] <- paste0("

", names(dd$data)[i], " - ", standard_label, "

") # If partial data spec match - give the fraction of variables matched } else { - + valid_count <- dd$standard[[i]]$details[[temp_standard]]$valid_count total_count <- dd$standard[[i]]$details[[temp_standard]]$invalid_count + valid_count - + fraction_cols <- paste0(valid_count, "/" ,total_count) names(choices)[i] <- paste0("

", names(dd$data)[i], " - ", "Partial ", - dd$standard[[i]]$standard, " (", fraction_cols, " data settings)", "

") + standard_label, " (", fraction_cols, " data settings)", "

") } } return(choices) }) - + # update radio buttons to display dataset names and standards for selection observeEvent(input$datafile, { req(data_choices()) vals <- data_choices() names(vals) <- NULL names <- lapply(names(data_choices()), HTML) - + prev_sel <- lapply(reactiveValuesToList(input), unclass)$select_file # retain previous selection - + updateRadioButtons(session, "select_file", choiceNames = names, choiceValues = vals, selected = prev_sel) - + }) - + # get selected dataset when selection changes data_selected <- eventReactive(input$select_file, { isolate({index <- which(names(dd$data)==input$select_file)[1]}) dd$data[[index]] }) - + # upon a dataset being uploaded and selected, generate data preview output$datapreview_header <- renderUI({ data_selected() isolate(data_name <- input$select_file) h3(paste("Data Preview for", data_name)) }) - + output$data_preview <- DT::renderDataTable({ DT::datatable(data = data_selected(), caption = isolate(input$select_file), @@ -112,54 +112,54 @@ dataUpload <- function(input, output, session){ class="compact", extensions = "Scroller", options = list(scrollY=400, scrollX=TRUE)) }) - - + + # upon a dataset being selected, grab its standard standard <- eventReactive(data_selected(), { index <- which(names(dd$data)==input$select_file)[1] dd$standard[[index]] }) - + # upon a dataset being selected, use generateSettings() to produce a settings obj settings <- eventReactive(c(data_selected(), standard()), { - + current_standard <- standard()$standard - - if (! current_standard=="None"){ - partial <- ifelse(standard()$details[[current_standard]]$match == "Partial", TRUE, FALSE) - + + if (! current_standard=="none"){ + partial <- ifelse(standard()$details[[current_standard]]$match == "partial", TRUE, FALSE) + if (partial) { - partial_keys <- standard()$details[[current_standard]]$checks %>% + partial_keys <- standard()$details[[current_standard]]$checks %>% filter(valid==TRUE) %>% - select(text_key) %>% + select(text_key) %>% pull() - + generateSettings(standard=current_standard, chart="eDish", partial=partial, partial_keys = partial_keys) - + } else { generateSettings(standard=current_standard, chart="eDish") - } + } } else { generateSettings(standard=current_standard, chart="eDish") } }) - + # run validateSettings(data, standard, settings) and return a status status <- reactive({ req(data_selected()) req(settings()) - validateSettings(data_selected(), + validateSettings(data_selected(), settings(), - chart="eDish") + chart="eDish") }) - + exportTestValues(status = { status() }) ### return selected data, settings, and status to server return(list(data_selected = reactive(data_selected()), settings = reactive(settings()), status = reactive(status()))) - -} \ No newline at end of file + +} diff --git a/inst/eDISH_app/modules/dataUpload/dataUploadUI.R b/inst/eDISH_app/modules/dataUpload/dataUploadUI.R index e214b5b8..3b8683bd 100644 --- a/inst/eDISH_app/modules/dataUpload/dataUploadUI.R +++ b/inst/eDISH_app/modules/dataUpload/dataUploadUI.R @@ -1,21 +1,21 @@ dataUploadUI <- function(id){ - + ns <- NS(id) - - tagList( + + tagList( fluidRow( column(3, wellPanel( - h3("Data upload"), + h3("Data upload"), fileInput(ns("datafile"), "Upload a csv or sas7bdat file",accept = c(".sas7bdat", ".csv"), multiple = TRUE), - radioButtons(ns("select_file"),"Select file for eDISH chart", + radioButtons(ns("select_file"),"Select file for eDISH chart", choiceNames = list(HTML("

Example data - ADaM

")), choiceValues = "Example data") ) ), - column(6, + column(6, fluidRow( - wellPanel( + wellPanel( uiOutput(ns("datapreview_header")), div(DT::dataTableOutput(ns("data_preview")), style = "font-size: 75%") ) @@ -23,5 +23,5 @@ dataUploadUI <- function(id){ ) ) ) - -} \ No newline at end of file + +} diff --git a/man/detectStandard.Rd b/man/detectStandard.Rd index 8536045e..ec561f35 100644 --- a/man/detectStandard.Rd +++ b/man/detectStandard.Rd @@ -14,16 +14,16 @@ detectStandard(data, includeFields = TRUE, domain = "labs") \item{domain}{The data domain for the data set provided. Default: \code{"labs"}.} } \value{ -A list containing the matching \code{"standard"} ("ADaM", "SDTM" or "None") and a list of \code{"details"} describing each standard considered. +A list containing the matching \code{"standard"} from \code{"standardMetadata"} and a list of \code{"details"} describing each standard considered. } \description{ -This function attempts to detect the data CDISC clinical standard used in a given R data frame. +This function attempts to detect the clinical data standard used in a given R data frame. } \details{ -This function compares the columns in the provided \code{"data"} with the required columns for a given data standard/domain combination. The function is designed to work with the SDTM and AdAM CDISC() standards for clinical trial data. Currently, "labs" is the only domain supported. +This function compares the columns in the provided \code{"data"} with the required columns for a given data standard/domain combination. The function is designed to work with the SDTM and AdAM CDISC() standards for clinical trial data by default. Additional standards can be added by modifying the \code{"standardMetadata"} data set included as part of this package. Currently, "labs" is the only domain supported. } \examples{ -detectStandard(adlbc)[["standard"]] #AdAM +detectStandard(adlbc)[["standard"]] #adam detectStandard(iris)[["standard"]] #none \dontrun{ diff --git a/man/evaluateStandard.Rd b/man/evaluateStandard.Rd index ac1a38ab..ecbcde34 100644 --- a/man/evaluateStandard.Rd +++ b/man/evaluateStandard.Rd @@ -16,7 +16,7 @@ evaluateStandard(data, standard, includeFields = TRUE, domain = "labs") \item{domain}{data domain. "labs" only for now.} } \value{ -a list describing to what degree the data set matches the data standard. The "match" property describes compliance with the standard as "Full", "Partial" or "None". The "checks" property is a list of the data elements expected for the standard and whether they are "valid" in the given data set. "valid_checks" and "invalid_checks" provide counts of the specified checks. +a list describing to what degree the data set matches the data standard. The "match" property describes compliance with the standard as "full", "partial" or "none". The "checks" property is a list of the data elements expected for the standard and whether they are "valid" in the given data set. "total_checks", "valid_checks" and "invalid_checks" provide counts of the specified checks. "match_percent" is calculated as valid_checks/total_checks. } \description{ Determines whether the required data elements in a data standard are found in a given data frame diff --git a/man/getSettingsMetadata.Rd b/man/getSettingsMetadata.Rd index 78809723..ac090a96 100644 --- a/man/getSettingsMetadata.Rd +++ b/man/getSettingsMetadata.Rd @@ -5,7 +5,8 @@ \title{Get metadata about chart settings} \usage{ getSettingsMetadata(charts = NULL, text_keys = NULL, cols = NULL, - filter_expr = NULL, metadata = safetyGraphics::settingsMetadata) + filter_expr = NULL, add_standards = TRUE, + metadata = safetyGraphics::settingsMetadata) } \arguments{ \item{charts}{optional vector of chart names used to filter the metadata. Exact matches only (case-insensitive). All rows returned by default.} @@ -16,6 +17,8 @@ getSettingsMetadata(charts = NULL, text_keys = NULL, cols = NULL, \item{filter_expr}{optional filter expression used to subset the data.} +\item{add_standards}{should data standard info stored in standardsMetadata be included} + \item{metadata}{metadata data frame to be queried} } \value{ diff --git a/man/settingsMetadata.Rd b/man/settingsMetadata.Rd index 1fd4c3d7..7574fe69 100644 --- a/man/settingsMetadata.Rd +++ b/man/settingsMetadata.Rd @@ -10,15 +10,13 @@ \item{text_key}{Text key indicating the setting name. \code{'--'} delimiter indicates a nested setting} \item{label}{Label} \item{description}{Description} - \item{setting_cat}{Setting category (data, measure, appearance)} \item{setting_type}{Expected type for setting value. Should be "character", "vector", "numeric" or "logical"} \item{setting_required}{Flag indicating if the setting is required} \item{column_mapping}{Flag indicating if the setting corresponds to a column in the associated data} \item{column_type}{Expected type for the data column values. Should be "character","logical" or "numeric"} \item{field_mapping}{Flag indicating whether the setting corresponds to a field-level mapping in the data} \item{field_column_key}{Key for the column that provides options for the field-level mapping in the data} - \item{adam}{Settings values for the ADaM standard} - \item{sdtm}{Settings values for the SDTM standard} + \item{setting_cat}{Setting category (data, measure, appearance)} }} \source{ Created for this package diff --git a/man/standardsMetadata.Rd b/man/standardsMetadata.Rd new file mode 100644 index 00000000..601a48c0 --- /dev/null +++ b/man/standardsMetadata.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/standardsMetadata.R +\docType{data} +\name{standardsMetadata} +\alias{standardsMetadata} +\title{Standards Metadata} +\format{A data frame with 25 rows and 3 columns +\describe{ + \item{text_key}{Text key indicating the setting name. \code{'--'} delimiter indicates a nested setting} + \item{adam}{Settings values for the ADaM standard} + \item{sdtm}{Settings values for the SDTM standard} +}} +\source{ +Created for this package +} +\usage{ +standardsMetadata +} +\description{ +Metadata about the data standards used to configure safetyGraphics charts. One record per unique setting. Columns contain default setting values for clinical data standards, like the CDISC "adam" and "sdtm" standards. +} +\keyword{datasets} diff --git a/tests/testthat/test_detectStandard.R b/tests/testthat/test_detectStandard.R index 687e71c7..931500b4 100644 --- a/tests/testthat/test_detectStandard.R +++ b/tests/testthat/test_detectStandard.R @@ -5,53 +5,54 @@ test_that("a list with the expected properties and structure is returned",{ a<- detectStandard(data.frame()) expect_is(a,"list") - expect_named(a,c("details","standard")) + expect_named(a,c("details","standard","standard_percent")) expect_is(a[["standard"]],"character") - expect_match(a[["standard"]],"SDTM|ADaM|None") + expect_match(a[["standard"]],"sdtm|adam|none") expect_is(a[["details"]],"list") - expect_named(a[["details"]],c("ADaM","SDTM")) + expect_named(a[["details"]],c("sdtm","adam")) + expect_equal(a[["standard_percent"]],0) }) test_that("correct standards are identified",{ - expect_equal(detectStandard(adlbc)[["standard"]],"ADaM") - expect_equal(detectStandard(adlbc)[["details"]][["ADaM"]][["match"]], "Full") - expect_equal(detectStandard(adlbc)[["details"]][["SDTM"]][["match"]], "Partial") + expect_equal(detectStandard(adlbc)[["standard"]],"adam") + expect_equal(detectStandard(adlbc)[["details"]][["adam"]][["match"]], "full") + expect_equal(detectStandard(adlbc)[["details"]][["sdtm"]][["match"]], "partial") adam_params <- c("Alanine Aminotransferase (U/L)","Aspartate Aminotransferase (U/L)","Bilirubin (umol/L)","Alkaline Phosphatase (U/L)") adam_test_data<-data.frame(USUBJID="001",AVAL=10,PARAM=adam_params, VISIT="Visit 1",VISITNUM=1,ADY=0,A1LO=0,A1HI=20) - expect_equal(detectStandard(adam_test_data)[["standard"]],"ADaM") - expect_equal(detectStandard(adam_test_data)[["details"]][["ADaM"]][["match"]], "Full") - expect_equal(detectStandard(adam_test_data)[["details"]][["SDTM"]][["match"]], "Partial") + expect_equal(detectStandard(adam_test_data)[["standard"]],"adam") + expect_equal(detectStandard(adam_test_data)[["details"]][["adam"]][["match"]], "full") + expect_equal(detectStandard(adam_test_data)[["details"]][["sdtm"]][["match"]], "partial") sdtm_params<-c("Aminotransferase, alanine (ALT)","Aminotransferase, aspartate (AST)","Total Bilirubin","Alkaline phosphatase (ALP)") sdtm_test_data<-data.frame(USUBJID="001",STRESN=10,TEST=sdtm_params,VISIT="Visit 1",VISITNUM=1,DY=0,STNRLO=0,STNRHI=20) - expect_equal(detectStandard(sdtm_test_data)[["standard"]],"SDTM") - expect_equal(detectStandard(sdtm_test_data)[["details"]][["ADaM"]][["match"]], "Partial") - expect_equal(detectStandard(sdtm_test_data)[["details"]][["SDTM"]][["match"]], "Full") + expect_equal(detectStandard(sdtm_test_data)[["standard"]],"sdtm") + expect_equal(detectStandard(sdtm_test_data)[["details"]][["adam"]][["match"]], "partial") + expect_equal(detectStandard(sdtm_test_data)[["details"]][["sdtm"]][["match"]], "full") empty_test_data<-data.frame("") - expect_equal(detectStandard(empty_test_data)[["standard"]],"None") - expect_equal(detectStandard(empty_test_data)[["details"]][["ADaM"]][["match"]], "None") - expect_equal(detectStandard(empty_test_data)[["details"]][["SDTM"]][["match"]], "None") + expect_equal(detectStandard(empty_test_data)[["standard"]],"none") + expect_equal(detectStandard(empty_test_data)[["details"]][["adam"]][["match"]], "none") + expect_equal(detectStandard(empty_test_data)[["details"]][["sdtm"]][["match"]], "none") case_sensitive_test_data<-data.frame(usubjid="001",AVAL=10,PARAM=adam_params, VISIT="Visit 1",VISITNUM=1,ADY=0,A1LO=0,A1HI=20) - expect_equal(detectStandard(case_sensitive_test_data)[["standard"]],"ADaM") - expect_equal(detectStandard(case_sensitive_test_data)[["details"]][["ADaM"]][["match"]], "Full") - expect_equal(detectStandard(case_sensitive_test_data)[["details"]][["SDTM"]][["match"]], "Partial") + expect_equal(detectStandard(case_sensitive_test_data)[["standard"]],"adam") + expect_equal(detectStandard(case_sensitive_test_data)[["details"]][["adam"]][["match"]], "full") + expect_equal(detectStandard(case_sensitive_test_data)[["details"]][["sdtm"]][["match"]], "partial") - #NOTE: SDTM takes precedence over ADAM + #NOTE: sdtm takes precedence over adam sdtm_and_adam_test_data<-cbind(adam_test_data,sdtm_test_data) - expect_equal(detectStandard(sdtm_and_adam_test_data)[["standard"]],"SDTM") - expect_equal(detectStandard(sdtm_and_adam_test_data)[["details"]][["ADaM"]][["match"]], "Full") - expect_equal(detectStandard(sdtm_and_adam_test_data)[["details"]][["SDTM"]][["match"]], "Full") + expect_equal(detectStandard(sdtm_and_adam_test_data)[["standard"]],"sdtm") + expect_equal(detectStandard(sdtm_and_adam_test_data)[["details"]][["adam"]][["match"]], "full") + expect_equal(detectStandard(sdtm_and_adam_test_data)[["details"]][["sdtm"]][["match"]], "full") - #NOTE: SDTM takes precedence over ADAM in partial matches as well + #NOTE: sdtm takes precedence over adam in partial matches as well sdtm_and_adam_partial_test_data<-data.frame(USUBJID="001",VISIT="Visit 1") - expect_equal(detectStandard(sdtm_and_adam_partial_test_data)[["standard"]],"SDTM") - expect_equal(detectStandard(sdtm_and_adam_partial_test_data)[["details"]][["ADaM"]][["match"]],"Partial") - expect_equal(detectStandard(sdtm_and_adam_partial_test_data)[["details"]][["SDTM"]][["match"]],"Partial") + expect_equal(detectStandard(sdtm_and_adam_partial_test_data)[["standard"]],"sdtm") + expect_equal(detectStandard(sdtm_and_adam_partial_test_data)[["details"]][["adam"]][["match"]],"partial") + expect_equal(detectStandard(sdtm_and_adam_partial_test_data)[["details"]][["sdtm"]][["match"]],"partial") }) diff --git a/tests/testthat/test_evaluateStandard.R b/tests/testthat/test_evaluateStandard.R index 72dd5ec8..352fe5e6 100644 --- a/tests/testthat/test_evaluateStandard.R +++ b/tests/testthat/test_evaluateStandard.R @@ -2,16 +2,16 @@ context("Tests for the evaluateStandard() function") library(safetyGraphics) test_that("basic test cases evaluate as expected",{ - expect_equal(evaluateStandard(data=adlbc, standard="adam")[["match"]],"Full") - expect_equal(evaluateStandard(data=adlbc, standard="sdtm")[["match"]],"Partial") - expect_equal(evaluateStandard(data=data.frame(), standard="sdtm")[["match"]],"None") + expect_equal(evaluateStandard(data=adlbc, standard="adam")[["match"]],"full") + expect_equal(evaluateStandard(data=adlbc, standard="sdtm")[["match"]],"partial") + expect_equal(evaluateStandard(data=data.frame(), standard="sdtm")[["match"]],"none") }) test_that("a list with the expected properties and structure is returned",{ a<- evaluateStandard(data=data.frame(),standard="adam") expect_is(a,"list") - expect_named(a,c('standard', 'checks', 'valid_count', 'invalid_count', 'match')) + expect_named(a,c('standard', 'checks', 'total_count','valid_count', 'invalid_count','match_percent', 'match')) expect_is(a[["standard"]],"character") expect_is(a[["match"]],"character") expect_is(a[["checks"]],"tbl") @@ -28,13 +28,16 @@ test_that("expected number of checks (in)valid",{ a<-evaluateStandard(data=adlbc_edit, standard="sdtm") expect_equal(a[["valid_count"]],2) expect_equal(a[["invalid_count"]],8) + expect_equal(a[["total_count"]],10) + expect_equal(a[["match_percent"]],.2) expect_true(a[["checks"]]%>%filter(text_key=="measure_col")%>%select(valid)%>%unlist) }) test_that("field level data is ignored when useFields=false",{ noFields<-evaluateStandard(data=adlbc, standard="adam", includeFields=FALSE) - expect_equal(noFields[["match"]],"Full") + expect_equal(noFields[["match"]],"full") + expect_equal(noFields[["match_percent"]],1) expect_equal(noFields[["valid_count"]],6) }) diff --git a/tests/testthat/test_getRequiredSettings.R b/tests/testthat/test_getRequiredSettings.R index b5d8ef11..b1d463cc 100644 --- a/tests/testthat/test_getRequiredSettings.R +++ b/tests/testthat/test_getRequiredSettings.R @@ -6,13 +6,13 @@ defaultRequiredSettings <- list( list("id_col"), list("value_col"), list("measure_col"), - list("normal_col_low"), - list("normal_col_high"), - list("studyday_col"), list("measure_values","ALT"), list("measure_values","AST"), list("measure_values","TB"), - list("measure_values","ALP") + list("measure_values","ALP"), + list("normal_col_low"), + list("normal_col_high"), + list("studyday_col") ) diff --git a/tests/testthat/test_getSettingsMetadata.R b/tests/testthat/test_getSettingsMetadata.R index 5da5c819..7d65b796 100644 --- a/tests/testthat/test_getSettingsMetadata.R +++ b/tests/testthat/test_getSettingsMetadata.R @@ -24,19 +24,19 @@ mergedMetadata = suppressWarnings(bind_rows( )) test_that("Default function copies the whole metadata dataframe",{ - default<-safetyGraphics:::getSettingsMetadata() + default<-safetyGraphics:::getSettingsMetadata(add_standards=FALSE) expect_is(default,"data.frame") expect_equal(dim(default), dim(rawMetadata)) }) test_that("Pulling from a custom metadata file works as expected",{ - custom<-safetyGraphics:::getSettingsMetadata(metadata=customMetadata) + custom<-safetyGraphics:::getSettingsMetadata(metadata=customMetadata, add_standards=FALSE) expect_is(custom,"data.frame") expect_equal(dim(custom), dim(customMetadata)) - merged<-safetyGraphics:::getSettingsMetadata(metadata=customMetadata) + merged<-safetyGraphics:::getSettingsMetadata(metadata=mergedMetadata, add_standards=FALSE) expect_is(custom,"data.frame") - expect_equal(dim(custom), dim(customMetadata)) + expect_equal(dim(merged), dim(mergedMetadata)) }) test_that("charts parameter works as expected",{ @@ -135,4 +135,13 @@ test_that("filter_expr parameters works as expected",{ expect_equal(safetyGraphics:::getSettingsMetadata(filter_expr=text_key=="id_col",cols="description"),"Unique subject identifier variable name.") expect_length(safetyGraphics:::getSettingsMetadata(filter_expr=column_type=="numeric",cols="text_key",chart="edish"),5) expect_length(safetyGraphics:::getSettingsMetadata(filter_expr=setting_required,cols="text_key",chart="edish"),10) - }) +}) + +test_that("add_standards parameters works as expected",{ + noStandards<-safetyGraphics:::getSettingsMetadata(metadata=customMetadata, add_standards=FALSE) + yesStandards<-safetyGraphics:::getSettingsMetadata(metadata=customMetadata) #included by default + expect_true(dim(noStandards)[2]< dim(yesStandards)[2]) + standardNames <- names(standardsMetadata) + expect_equal(intersect(standardNames, names(yesStandards)),standardNames) + expect_equal(intersect(standardNames, names(noStandards)),"text_key") +})