From a7468f08e5446f99bd940d88507e68bb56d1c66c Mon Sep 17 00:00:00 2001 From: Jeremy Wildfire Date: Thu, 4 Nov 2021 16:18:46 -0400 Subject: [PATCH 01/19] initial commit for makeMeta function --- NAMESPACE | 1 + R/app_startup.R | 7 ++++++- R/makeMeta.R | 43 +++++++++++++++++++++++++++++++++++++++++++ man/makeMeta.Rd | 31 +++++++++++++++++++++++++++++++ 4 files changed, 81 insertions(+), 1 deletion(-) create mode 100644 R/makeMeta.R create mode 100644 man/makeMeta.Rd diff --git a/NAMESPACE b/NAMESPACE index e8937fc7..d86d9a7e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -21,6 +21,7 @@ export(makeChartExport) export(makeChartParams) export(makeChartSummary) export(makeMapping) +export(makeMeta) export(mappingColumn) export(mappingColumnUI) export(mappingDomain) diff --git a/R/app_startup.R b/R/app_startup.R index bf9f9d90..d2ff0ddd 100644 --- a/R/app_startup.R +++ b/R/app_startup.R @@ -22,7 +22,7 @@ #' #' @export app_startup<-function(domainData=NULL, meta=NULL, charts=NULL, mapping=NULL, autoMapping=NULL, filterDomain=NULL, chartSettingsPaths=NULL){ - # Process charts metadata + # If charts are not provided, load them from chartSettingsPath or the safetyCharts package if(is.null(charts)){ if(is.null(chartSettingsPaths)){ charts <- makeChartConfig() @@ -74,6 +74,11 @@ app_startup<-function(domainData=NULL, meta=NULL, charts=NULL, mapping=NULL, aut } } + # generate a meta object if none is provided + if(is.null(meta)){ + meta<-makeMeta(charts) + } + # generate mappings and data standards mappingObj <- makeMapping(domainData, meta, autoMapping, mapping) diff --git a/R/makeMeta.R b/R/makeMeta.R new file mode 100644 index 00000000..ab728630 --- /dev/null +++ b/R/makeMeta.R @@ -0,0 +1,43 @@ +#' Create a metadata object based on the selected charts +#' +#' @param charts list of charts for which metadata is needed +#' @param package package containing needed metadata +#' +#' @return tibble of metadata with the following columns: +#' \describe{ +#' \item{domain}{Data domain} +#' \item{text_key}{Text key indicating the setting name. \code{'--'} delimiter indicates a field level data mapping} +#' \item{col_key}{Key for the column mapping} +#' \item{field_key}{Key for the field mapping (if any)} +#' \item{type}{type of mapping - "field" or "column"} +#' \item{label}{Label} +#' \item{description}{Description} +#' \item{multiple}{Mapping supports multiple columns/fields } +#' \item{standard_adam}{Default values for the ADaM data standard} +#' \item{standard_sdtm}{Default values for the SDTM data standard} +#' } +#' +#' @export + +makeMeta <- function(charts, package="safetyCharts"){ + meta<-tibble() + # get a list of domains from the charts + domains <- charts %>% map(~.x$domains) %>% unlist %>% unique() + packagePath <- paste0('package:',package) + + # Find matching metadata files in safetyCharts (or safetyData?) + for(domain in domains){ + domain_name <- paste0('meta_',domain) + domain_meta_found <- exists( + domain_name, + where=packagePath, + inherits=FALSE + ) + meta<-tibble() + if(domain_meta_found){ + meta<-rbind(meta, get(domain_name,pos=packagePath, inherits=FALSE)) + } + } + + return(meta) +} \ No newline at end of file diff --git a/man/makeMeta.Rd b/man/makeMeta.Rd new file mode 100644 index 00000000..8b71994a --- /dev/null +++ b/man/makeMeta.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/makeMeta.R +\name{makeMeta} +\alias{makeMeta} +\title{Create a metadata object based on the selected charts} +\usage{ +makeMeta(charts, package = "safetyCharts") +} +\arguments{ +\item{charts}{list of charts for which metadata is needed} + +\item{package}{package containing needed metadata} +} +\value{ +tibble of metadata with the following columns: +\describe{ +\item{domain}{Data domain} +\item{text_key}{Text key indicating the setting name. \code{'--'} delimiter indicates a field level data mapping} +\item{col_key}{Key for the column mapping} +\item{field_key}{Key for the field mapping (if any)} +\item{type}{type of mapping - "field" or "column"} +\item{label}{Label} +\item{description}{Description} +\item{multiple}{Mapping supports multiple columns/fields } +\item{standard_adam}{Default values for the ADaM data standard} +\item{standard_sdtm}{Default values for the SDTM data standard} +} +} +\description{ +Create a metadata object based on the selected charts +} From 94da5ffb07efecedd4e1b725c538da94ce666c92 Mon Sep 17 00:00:00 2001 From: Jeremy Wildfire Date: Thu, 4 Nov 2021 16:56:57 -0400 Subject: [PATCH 02/19] typo clean up --- R/makeMeta.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/makeMeta.R b/R/makeMeta.R index ab728630..03157c15 100644 --- a/R/makeMeta.R +++ b/R/makeMeta.R @@ -22,10 +22,11 @@ makeMeta <- function(charts, package="safetyCharts"){ meta<-tibble() # get a list of domains from the charts - domains <- charts %>% map(~.x$domains) %>% unlist %>% unique() + domains <- charts %>% map(~.x$domain) %>% unlist %>% unique() packagePath <- paste0('package:',package) # Find matching metadata files in safetyCharts (or safetyData?) + meta<-tibble() for(domain in domains){ domain_name <- paste0('meta_',domain) domain_meta_found <- exists( @@ -33,7 +34,6 @@ makeMeta <- function(charts, package="safetyCharts"){ where=packagePath, inherits=FALSE ) - meta<-tibble() if(domain_meta_found){ meta<-rbind(meta, get(domain_name,pos=packagePath, inherits=FALSE)) } From 334affb29a4c26f87f0b60ad46c74b13a140b2ed Mon Sep 17 00:00:00 2001 From: Jeremy Wildfire Date: Mon, 22 Nov 2021 17:58:43 -0500 Subject: [PATCH 03/19] start refactor for chart level metadata --- R/app_startup.R | 20 +++---- R/makeMeta.R | 77 +++++++++++++++++++-------- R/prepareChart.R | 118 +++++++++++++++++++++-------------------- R/safetyGraphicsApp.R | 4 +- R/safetyGraphicsInit.R | 2 +- 5 files changed, 128 insertions(+), 93 deletions(-) diff --git a/R/app_startup.R b/R/app_startup.R index d2ff0ddd..b3038a8c 100644 --- a/R/app_startup.R +++ b/R/app_startup.R @@ -3,7 +3,7 @@ #' Prepare inputs for safetyGraphics app - run before app is initialized. #' #' @param domainData named list of data.frames to be loaded in to the app. Sample AdAM data from the safetyData package used by default -#' @param meta data frame containing the metadata for use in the app. See the preloaded file (\code{?safetyGraphics::meta}) for more data specifications and details. Defaults to \code{safetyGraphics::meta}. +#' @param meta data frame containing the metadata for use in the app. #' @param charts list of charts in the format produced by safetyGraphics::makeChartConfig() #' @param mapping list specifying the initial mapping values for each data mapping for each domain (e.g. list(aes= list(id_col='USUBJID', seq_col='AESEQ')). #' @param autoMapping boolean indicating whether the app should attempt to automatically detect data standards and generate mappings for the data provided. Values specified in the `mapping` parameter overwrite automatically generated mappings when both are found. Defaults to true. @@ -31,13 +31,8 @@ app_startup<-function(domainData=NULL, meta=NULL, charts=NULL, mapping=NULL, aut } } - # Attempt to bind chart functions if none are provided - charts <- charts %>% map(function(chart){ - if(!hasName(chart,"functions")){ - chart <- prepareChart(chart) - } - return(chart) - }) + # Prepare charts - fill in defaults, build metadata, bind functions + charts <- charts %>% map(prepareChart) # Drop charts where order is negative orderDrops <- charts[purrr::map_lgl(charts, function(chart) chart$order < 0)] @@ -74,10 +69,11 @@ app_startup<-function(domainData=NULL, meta=NULL, charts=NULL, mapping=NULL, aut } } - # generate a meta object if none is provided - if(is.null(meta)){ - meta<-makeMeta(charts) - } + # generate a full list of metadata + meta <- charts %>% map(~.x$meta) %>% rbind %>% distinct + + # warning if there are duplicate rows in a domain + # TODO # generate mappings and data standards mappingObj <- makeMapping(domainData, meta, autoMapping, mapping) diff --git a/R/makeMeta.R b/R/makeMeta.R index 03157c15..845102c7 100644 --- a/R/makeMeta.R +++ b/R/makeMeta.R @@ -1,7 +1,6 @@ -#' Create a metadata object based on the selected charts +#' Create a metadata object table for a chart #' -#' @param charts list of charts for which metadata is needed -#' @param package package containing needed metadata +#' @param chart safetyGraphics chart object for which to create metadata #' #' @return tibble of metadata with the following columns: #' \describe{ @@ -19,25 +18,61 @@ #' #' @export -makeMeta <- function(charts, package="safetyCharts"){ - meta<-tibble() - # get a list of domains from the charts - domains <- charts %>% map(~.x$domain) %>% unlist %>% unique() - packagePath <- paste0('package:',package) +makeMeta <- function(chart){ + stopifnot(typeof(chart$domain) %in% c('list','character')) + if(hasName(chart, 'meta')){ + message(chart$name, " already has `meta` defined. Skipping makeMeta() processing.") + }else{ + packagePath <- paste0('package:',chart$package) + if(typeof(chart$domain) == "character"){ + domains <- chart$domain + }else if(typeof(chart$domain) == "list"){ + domains <- names(chart$domain) + } + # process metadata for all values of chart$domains + all_meta <- tibble() + for(domain in domains){ + # get chart level meta + domain_meta_found <- exists( + paste0("meta_",domain), + where=packagePath, + inherits=FALSE + ) + if(domain_meta_found) { + chart_meta <- get( + paste0("meta_",domain), + pos=packagePath, + inherits=FALSE + ) + }else{ + chart_meta <- tibble() + } - # Find matching metadata files in safetyCharts (or safetyData?) - meta<-tibble() - for(domain in domains){ - domain_name <- paste0('meta_',domain) - domain_meta_found <- exists( - domain_name, - where=packagePath, - inherits=FALSE - ) - if(domain_meta_found){ - meta<-rbind(meta, get(domain_name,pos=packagePath, inherits=FALSE)) - } + # get domains level meta + domain_meta_found <- exists( + paste0("meta_",domain), + where=packagePath, + inherits=FALSE + ) + if(domain_meta_found) { + domain_meta <- get( + paste0("meta_",domain), + pos=packagePath, + inherits=FALSE + ) + }else{ + domain_meta <- tibble() + } + dup_keys <- intersect(chart_meta$text_key, domain_meta$text_key) + this_meta<-rbind(chart_meta, domain_meta) + + if(any(duplicated(this_meta$text_key))){ + dups <- meta$text_key[duplicated(this_meta$text_key)] + message("Caution: Found ", length(dups) ," duplicate text_key(s) in the ",domain, " domain for the ",chart$name," chart: ", paste(dups,collapse=", ")) + } + all_meta <- rbind(all_meta, this_meta) + } } - return(meta) + return(all_meta) } \ No newline at end of file diff --git a/R/prepareChart.R b/R/prepareChart.R index 75410628..7724de1a 100644 --- a/R/prepareChart.R +++ b/R/prepareChart.R @@ -36,72 +36,76 @@ prepareChart <- function(chart){ FALSE, tolower(chart$env)=="safetygraphics" ) + #### Make Chart-level meta-data #### + chart$meta <- makeMeta(chart) #### Bind Workflow functions to chart object #### - - all_functions <- as.character(utils::lsf.str(".GlobalEnv")) - - if(utils::hasName(chart, "package")){ - package_functions <- as.character(utils::lsf.str(paste0("package:",chart$package))) - all_functions<-c(all_functions,package_functions) - } + if(!hasName(chart,"functions")){ - #search functions that include the charts name or the workflow function names - chart_function_names <- c() - for(query in c(chart$name, unlist(chart$workflow)) ){ - matches<-all_functions[str_detect(query, all_functions)] - chart_function_names <- c(chart_function_names, matches) - } + all_functions <- as.character(utils::lsf.str(".GlobalEnv")) + + if(utils::hasName(chart, "package")){ + package_functions <- as.character(utils::lsf.str(paste0("package:",chart$package))) + all_functions<-c(all_functions,package_functions) + } - chart$functions <- lapply(chart_function_names, match.fun) - names(chart$functions) <- chart_function_names + #search functions that include the charts name or the workflow function names + chart_function_names <- c() + for(query in c(chart$name, unlist(chart$workflow)) ){ + matches<-all_functions[str_detect(query, all_functions)] + chart_function_names <- c(chart_function_names, matches) + } + + chart$functions <- lapply(chart_function_names, match.fun) + names(chart$functions) <- chart_function_names - # Define UI function unless one is provided - if(chart$type=="plot"){ - chart$functions$ui<-plotOutput - chart$functions$server<-renderPlot - chart$functions$main<-chart$functions[[chart$workflow$main]] - }else if(chart$type=="html"){ - chart$functions$ui<-htmlOutput - chart$functions$server<-renderText - chart$functions$main<-chart$functions[[chart$workflow$main]] - }else if(chart$type=="table"){ - chart$functions$ui<-DT::dataTableOutput - chart$functions$server<-function(expr){ - DT::renderDataTable( - expr, - rownames = FALSE, - options = list( - pageLength = 20, - ordering = FALSE, - searching = FALSE + # Define UI function unless one is provided + if(chart$type=="plot"){ + chart$functions$ui<-plotOutput + chart$functions$server<-renderPlot + chart$functions$main<-chart$functions[[chart$workflow$main]] + }else if(chart$type=="html"){ + chart$functions$ui<-htmlOutput + chart$functions$server<-renderText + chart$functions$main<-chart$functions[[chart$workflow$main]] + }else if(chart$type=="table"){ + chart$functions$ui<-DT::dataTableOutput + chart$functions$server<-function(expr){ + DT::renderDataTable( + expr, + rownames = FALSE, + options = list( + pageLength = 20, + ordering = FALSE, + searching = FALSE + ) ) - ) - } - chart$functions$main<-chart$functions[[chart$workflow$main]] - }else if(chart$type=="htmlwidget"){ - # Helper functions for html widget render - widgetOutput <- function(outputId, width = "100%", height = "400px") { - htmlwidgets::shinyWidgetOutput(outputId, chart$workflow$widget, width, height, package=chart$package) - } + } + chart$functions$main<-chart$functions[[chart$workflow$main]] + }else if(chart$type=="htmlwidget"){ + # Helper functions for html widget render + widgetOutput <- function(outputId, width = "100%", height = "400px") { + htmlwidgets::shinyWidgetOutput(outputId, chart$workflow$widget, width, height, package=chart$package) + } - renderWidget <- function(expr, env = parent.frame(), quoted = FALSE) { - if (!quoted) { expr <- substitute(expr) } # force quoted - htmlwidgets::shinyRenderWidget(expr, widgetOutput, env, quoted = TRUE) + renderWidget <- function(expr, env = parent.frame(), quoted = FALSE) { + if (!quoted) { expr <- substitute(expr) } # force quoted + htmlwidgets::shinyRenderWidget(expr, widgetOutput, env, quoted = TRUE) + } + + chart$functions$ui<-widgetOutput + chart$functions$server<-renderWidget + chart$functions$main<-htmlwidgets::createWidget + chart$workflow$main <- "htmlwidgets::createWidget" + }else if(chart$type=="module"){ + chart$functions$ui<-chart$functions[[chart$workflow$ui]] + chart$functions$server<-callModule + chart$functions$main <- chart$functions[[chart$workflow$server]] } - chart$functions$ui<-widgetOutput - chart$functions$server<-renderWidget - chart$functions$main<-htmlwidgets::createWidget - chart$workflow$main <- "htmlwidgets::createWidget" - }else if(chart$type=="module"){ - chart$functions$ui<-chart$functions[[chart$workflow$ui]] - chart$functions$server<-callModule - chart$functions$main <- chart$functions[[chart$workflow$server]] + # Print a message summarizing + message<-paste0(chart$name,": Loaded ", length(chart$functions)," functions: ", paste(names(chart$functions),collapse=",")) + message(message) } - - # Print a message summarizing - message<-paste0(chart$name,": Loaded ", length(chart$functions)," functions: ", paste(names(chart$functions),collapse=",")) - return(chart) } \ No newline at end of file diff --git a/R/safetyGraphicsApp.R b/R/safetyGraphicsApp.R index 024e922c..cb664f64 100644 --- a/R/safetyGraphicsApp.R +++ b/R/safetyGraphicsApp.R @@ -1,7 +1,7 @@ #' Run the core safetyGraphics App #' #' @param domainData named list of data.frames to be loaded in to the app. Sample AdAM data from the safetyData package used by default -#' @param meta data frame containing the metadata for use in the app. See the preloaded file (\code{?safetyGraphics::meta}) for more data specifications and details. Defaults to \code{safetyGraphics::meta}. +#' @param meta data frame containing the metadata for use in the app. #' @param charts list of charts in the format produced by safetyGraphics::makeChartConfig() #' @param mapping list specifying the initial mapping values for each data mapping for each domain (e.g. list(aes= list(id_col='USUBJID', seq_col='AESEQ')). #' @param autoMapping boolean indicating whether the app should attempt to automatically detect data standards and generate mappings for the data provided. Values specified in the `mapping` parameter overwrite automatically generated mappings when both are found. Defaults to true. @@ -19,7 +19,7 @@ safetyGraphicsApp <- function( aes=safetyData::adam_adae, dm=safetyData::adam_adsl ), - meta = safetyGraphics::meta, + meta = NULL, charts=NULL, mapping=NULL, autoMapping=TRUE, diff --git a/R/safetyGraphicsInit.R b/R/safetyGraphicsInit.R index 7c136424..fa6d7709 100644 --- a/R/safetyGraphicsInit.R +++ b/R/safetyGraphicsInit.R @@ -124,7 +124,7 @@ safetyGraphicsInit <- function(charts=makeChartConfig(), delayTime=1000, maxFile shinyjs::show(id="sg-app") config<- app_startup( domainData = domainData() %>% keep(~!is.null(.x)), - meta = safetyGraphics::meta, + meta = NULL, charts= charts(), #mapping=NULL, filterDomain="dm", From 1e29d32a48b56a8604c1e6cf3569d52df14c2a3e Mon Sep 17 00:00:00 2001 From: Jeremy Wildfire Date: Sat, 4 Dec 2021 08:22:16 -0500 Subject: [PATCH 04/19] more makeMeta updates --- R/makeMeta.R | 54 ++++++++++++++++++++++++++-------------------------- 1 file changed, 27 insertions(+), 27 deletions(-) diff --git a/R/makeMeta.R b/R/makeMeta.R index 845102c7..2c3e8479 100644 --- a/R/makeMeta.R +++ b/R/makeMeta.R @@ -29,25 +29,26 @@ makeMeta <- function(chart){ }else if(typeof(chart$domain) == "list"){ domains <- names(chart$domain) } - # process metadata for all values of chart$domains - all_meta <- tibble() - for(domain in domains){ - # get chart level meta - domain_meta_found <- exists( - paste0("meta_",domain), - where=packagePath, + + # check for chart level metadata + chart_meta_found <- exists( + paste0("meta_",chart$name), + where=packagePath, + inherits=FALSE + ) + if(chart_meta_found) { + chart_meta <- get( + paste0("meta_",chart$name), + pos=packagePath, inherits=FALSE ) - if(domain_meta_found) { - chart_meta <- get( - paste0("meta_",domain), - pos=packagePath, - inherits=FALSE - ) - }else{ - chart_meta <- tibble() - } + }else{ + chart_meta <- tibble() + } + # check for domain-level metadata + domain_meta <- tibble() + for(domain in domains){ # get domains level meta domain_meta_found <- exists( paste0("meta_",domain), @@ -55,23 +56,22 @@ makeMeta <- function(chart){ inherits=FALSE ) if(domain_meta_found) { - domain_meta <- get( + this_meta <- get( paste0("meta_",domain), pos=packagePath, inherits=FALSE ) }else{ - domain_meta <- tibble() - } - dup_keys <- intersect(chart_meta$text_key, domain_meta$text_key) - this_meta<-rbind(chart_meta, domain_meta) - - if(any(duplicated(this_meta$text_key))){ - dups <- meta$text_key[duplicated(this_meta$text_key)] - message("Caution: Found ", length(dups) ," duplicate text_key(s) in the ",domain, " domain for the ",chart$name," chart: ", paste(dups,collapse=", ")) + this_meta <- tibble() } - all_meta <- rbind(all_meta, this_meta) - } + domain_meta <- rbind(domain_meta, this_meta) + } + + # Drop domain-level metadata found in charts + chart_ids <- paste0(chart_meta$domain,"-",chart_meta$text_key) + domain_meta <- domain_meta %>% + filter(!(paste0(domain_meta$domain,"-",domain_meta$text_key) %in% chart_ids)) + all_meta <- rbind(chart_meta, domain_meta) } return(all_meta) From 42e7c4cf851ff3a0ed196ecf2b2ab3098d25bd66 Mon Sep 17 00:00:00 2001 From: Jeremy Wildfire Date: Sun, 5 Dec 2021 06:57:43 -0500 Subject: [PATCH 05/19] shell for unit tests --- tests/testthat/test_makeMeta.R | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) create mode 100644 tests/testthat/test_makeMeta.R diff --git a/tests/testthat/test_makeMeta.R b/tests/testthat/test_makeMeta.R new file mode 100644 index 00000000..158a2a15 --- /dev/null +++ b/tests/testthat/test_makeMeta.R @@ -0,0 +1,17 @@ +context("Tests for the makeMeta() function") +library(safetyGraphics) +library(safetyCharts) + +# User Requirements +# - Charts with exisitng meta objects are not modified. A message is printed. +# - Chart-level metadata (e.g. meta_AEexplorer) is loaded when found +# - If no metadata is found for a chart, a warning message is printed. +# - If a chart doesn't have name or domain property no metadata is added and a message is printed. +# - Domain-level metadata is loaded for a single domain when found +# - Domain-level metadata for multiple domains is loaded when found +# - Domain-level metadata is loaded as expected when chart.domain is a named list or a character vector +# - Chart-level takes precedence over domain-level metadata when both are found + +test_that("placeholder test",{ + expect_true(FALSE) +}) From c992a6c0e22c0b502a3caf27ebc56b0022d70307 Mon Sep 17 00:00:00 2001 From: Jeremy Wildfire Date: Sun, 5 Dec 2021 07:18:00 -0500 Subject: [PATCH 06/19] test for charts with existing metadata --- R/makeMeta.R | 5 ++--- tests/testthat/test_makeMeta.R | 20 +++++++++++++++++--- 2 files changed, 19 insertions(+), 6 deletions(-) diff --git a/R/makeMeta.R b/R/makeMeta.R index 2c3e8479..2cdf0dea 100644 --- a/R/makeMeta.R +++ b/R/makeMeta.R @@ -71,8 +71,7 @@ makeMeta <- function(chart){ chart_ids <- paste0(chart_meta$domain,"-",chart_meta$text_key) domain_meta <- domain_meta %>% filter(!(paste0(domain_meta$domain,"-",domain_meta$text_key) %in% chart_ids)) - all_meta <- rbind(chart_meta, domain_meta) + chart$meta <- rbind(chart_meta, domain_meta) } - - return(all_meta) + return(chart) } \ No newline at end of file diff --git a/tests/testthat/test_makeMeta.R b/tests/testthat/test_makeMeta.R index 158a2a15..7c80781b 100644 --- a/tests/testthat/test_makeMeta.R +++ b/tests/testthat/test_makeMeta.R @@ -3,7 +3,7 @@ library(safetyGraphics) library(safetyCharts) # User Requirements -# - Charts with exisitng meta objects are not modified. A message is printed. +# - # - Chart-level metadata (e.g. meta_AEexplorer) is loaded when found # - If no metadata is found for a chart, a warning message is printed. # - If a chart doesn't have name or domain property no metadata is added and a message is printed. @@ -12,6 +12,20 @@ library(safetyCharts) # - Domain-level metadata is loaded as expected when chart.domain is a named list or a character vector # - Chart-level takes precedence over domain-level metadata when both are found -test_that("placeholder test",{ - expect_true(FALSE) +testChart <-list( + env="safetyGraphics", + name="ageDist", + label="Age Distribution", + type="plot", + domain="dm", + workflow=list( + main="ageDist" + ) +) + +test_that("Charts with exisitng meta objects are not modified. A message is printed.",{ + metaChart <- testChart + metaChart$meta <- "JustAPlaceholder" + expect_message(makeMeta(chart=metaChart)) + expect_equal(metaChart$Meta, "JustAPlaceholder") }) From 70fd7d083a8bbaca61f96da1383137321529cdad Mon Sep 17 00:00:00 2001 From: Jeremy Wildfire Date: Sun, 5 Dec 2021 07:18:08 -0500 Subject: [PATCH 07/19] test for charts with existing metadata --- tests/testthat/test_makeMeta.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test_makeMeta.R b/tests/testthat/test_makeMeta.R index 7c80781b..871e02c3 100644 --- a/tests/testthat/test_makeMeta.R +++ b/tests/testthat/test_makeMeta.R @@ -27,5 +27,5 @@ test_that("Charts with exisitng meta objects are not modified. A message is prin metaChart <- testChart metaChart$meta <- "JustAPlaceholder" expect_message(makeMeta(chart=metaChart)) - expect_equal(metaChart$Meta, "JustAPlaceholder") + expect_equal(metaChart$meta, "JustAPlaceholder") }) From 643483ca999e65fea29969e2472699bceeb36ae9 Mon Sep 17 00:00:00 2001 From: Jeremy Wildfire Date: Mon, 6 Dec 2021 22:41:07 -0500 Subject: [PATCH 08/19] add tests for domain metadata import --- R/makeMeta.R | 25 +++++++++++++++++-------- tests/testthat/test_makeMeta.R | 33 +++++++++++++++++++++++---------- 2 files changed, 40 insertions(+), 18 deletions(-) diff --git a/R/makeMeta.R b/R/makeMeta.R index 2cdf0dea..5841aba0 100644 --- a/R/makeMeta.R +++ b/R/makeMeta.R @@ -22,6 +22,7 @@ makeMeta <- function(chart){ stopifnot(typeof(chart$domain) %in% c('list','character')) if(hasName(chart, 'meta')){ message(chart$name, " already has `meta` defined. Skipping makeMeta() processing.") + all_meta <- NULL }else{ packagePath <- paste0('package:',chart$package) if(typeof(chart$domain) == "character"){ @@ -41,7 +42,8 @@ makeMeta <- function(chart){ paste0("meta_",chart$name), pos=packagePath, inherits=FALSE - ) + )%>% + mutate(source = paste0(packagePath, ":meta_", chart$name)) }else{ chart_meta <- tibble() } @@ -60,18 +62,25 @@ makeMeta <- function(chart){ paste0("meta_",domain), pos=packagePath, inherits=FALSE - ) + ) %>% + mutate(source = paste0(packagePath, ":meta_", domain)) }else{ this_meta <- tibble() } domain_meta <- rbind(domain_meta, this_meta) } - # Drop domain-level metadata found in charts - chart_ids <- paste0(chart_meta$domain,"-",chart_meta$text_key) - domain_meta <- domain_meta %>% - filter(!(paste0(domain_meta$domain,"-",domain_meta$text_key) %in% chart_ids)) - chart$meta <- rbind(chart_meta, domain_meta) + + all_meta <- rbind(chart_meta, domain_meta) + + # Remove duplicate meta data + dupes <- duplicated(all_meta%>%select(domain, text_key)) + if(any(dupes)){ + dup_meta <- all_meta[dupes,] + message("Removed ",sum(dupes)," duplicate metadata records for ", chart$name,".") + all_meta <- all_meta[!dupes,] + } } - return(chart) + + return(all_meta) } \ No newline at end of file diff --git a/tests/testthat/test_makeMeta.R b/tests/testthat/test_makeMeta.R index 871e02c3..08cb8ede 100644 --- a/tests/testthat/test_makeMeta.R +++ b/tests/testthat/test_makeMeta.R @@ -3,14 +3,14 @@ library(safetyGraphics) library(safetyCharts) # User Requirements -# - -# - Chart-level metadata (e.g. meta_AEexplorer) is loaded when found -# - If no metadata is found for a chart, a warning message is printed. -# - If a chart doesn't have name or domain property no metadata is added and a message is printed. -# - Domain-level metadata is loaded for a single domain when found -# - Domain-level metadata for multiple domains is loaded when found -# - Domain-level metadata is loaded as expected when chart.domain is a named list or a character vector -# - Chart-level takes precedence over domain-level metadata when both are found +# [*] Charts with exisiting meta objects are not modified. A message is printed. +# [ ] Chart-level metadata (e.g. meta_AEexplorer) is loaded when found +# [ ] If no metadata is found for a chart, a warning message is printed. +# [ ] If a chart doesn't have name or domain property no metadata is added and a message is printed. +# [*] Domain-level metadata is loaded for a single domain when found +# [*] Domain-level metadata for multiple domains is loaded when found +# [ ] Domain-level metadata is loaded as expected when chart domain is a named list or a character vector +# [ ] Chart-level takes precedence over domain-level metadata when both are found testChart <-list( env="safetyGraphics", @@ -18,14 +18,27 @@ testChart <-list( label="Age Distribution", type="plot", domain="dm", + package="safetyCharts" workflow=list( main="ageDist" ) ) -test_that("Charts with exisitng meta objects are not modified. A message is printed.",{ +test_that("Charts with exisiting meta objects are not modified. A message is printed.",{ metaChart <- testChart metaChart$meta <- "JustAPlaceholder" expect_message(makeMeta(chart=metaChart)) - expect_equal(metaChart$meta, "JustAPlaceholder") + expect_null(makeMeta(chart=metaChart)) +}) + +test_that("Domain-level metadata is loaded for a single domain when found.",{ + testMeta <- makeMeta(testChart) %>% select(-source) + expect_equal(testMeta, safetyCharts::meta_dm) +}) + +test_that("Domain-level metadata for multiple domains is loaded when found",{ + multiDomainChart <- testChart + multiDomainChart$domain <- c("dm","aes") + multiDomainMeta <- makeMeta(multiDomainChart) %>% select(-source) + expect_equal(multiDomainMeta, rbind(safetyCharts::meta_dm, safetyCharts::meta_aes)) }) From 1b057ec139df3d5ef9b661b30c49d9a9a9bfb825 Mon Sep 17 00:00:00 2001 From: Jeremy Wildfire Date: Thu, 9 Dec 2021 22:07:05 -0500 Subject: [PATCH 09/19] test for chart-level metadata --- tests/testthat/test_makeMeta.R | 21 +++++++++++++++++++-- 1 file changed, 19 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test_makeMeta.R b/tests/testthat/test_makeMeta.R index 08cb8ede..b4eb2d6f 100644 --- a/tests/testthat/test_makeMeta.R +++ b/tests/testthat/test_makeMeta.R @@ -4,7 +4,7 @@ library(safetyCharts) # User Requirements # [*] Charts with exisiting meta objects are not modified. A message is printed. -# [ ] Chart-level metadata (e.g. meta_AEexplorer) is loaded when found +# [*] Chart-level metadata (e.g. meta_hepExplorer) is loaded when found # [ ] If no metadata is found for a chart, a warning message is printed. # [ ] If a chart doesn't have name or domain property no metadata is added and a message is printed. # [*] Domain-level metadata is loaded for a single domain when found @@ -18,7 +18,7 @@ testChart <-list( label="Age Distribution", type="plot", domain="dm", - package="safetyCharts" + package="safetyCharts", workflow=list( main="ageDist" ) @@ -42,3 +42,20 @@ test_that("Domain-level metadata for multiple domains is loaded when found",{ multiDomainMeta <- makeMeta(multiDomainChart) %>% select(-source) expect_equal(multiDomainMeta, rbind(safetyCharts::meta_dm, safetyCharts::meta_aes)) }) + +test_that("Chart-level metadata (e.g. meta_hepExplorer) is loaded when found",{ + testChart <-list( + env="safetyGraphics", + name="hepExplorer", + package="safetyCharts", + domain="none" + ) + chartMeta <- makeMeta(testChart) %>% select(-source) + expect_equal(chartMeta, safetyCharts::meta_hepExplorer) + + #Chart that chart-level and domain-level metadata stack + testChart$domain="labs" + chartMeta <- makeMeta(testChart) %>% select(-source) + expect_equal(chartMeta, rbind(safetyCharts::meta_hepExplorer, safetyCharts::meta_labs)) +}) + From d6fc9ac958f550faec62cf5f0ab3138d5e249cdb Mon Sep 17 00:00:00 2001 From: Jeremy Wildfire Date: Fri, 25 Feb 2022 07:02:33 -0500 Subject: [PATCH 10/19] refactor makeMeta to work across all charts. #637 --- .Rbuildignore | 2 + R/app_startup.R | 9 ++-- R/makeMeta.R | 98 ++++++++++++++-------------------- R/prepareChart.R | 2 - R/safetyGraphicsApp.R | 2 +- man/app_startup.Rd | 2 +- man/makeMeta.Rd | 10 ++-- man/safetyGraphicsApp.Rd | 4 +- tests/testthat/test_makeMeta.R | 38 ++++++------- 9 files changed, 72 insertions(+), 95 deletions(-) diff --git a/.Rbuildignore b/.Rbuildignore index 893b8fef..8ef7fc5d 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -15,3 +15,5 @@ ^customSettings$ ^\.github$ ^LICENSE\.md$ +^rsconnect$ + diff --git a/R/app_startup.R b/R/app_startup.R index b3038a8c..0f23cc26 100644 --- a/R/app_startup.R +++ b/R/app_startup.R @@ -3,7 +3,7 @@ #' Prepare inputs for safetyGraphics app - run before app is initialized. #' #' @param domainData named list of data.frames to be loaded in to the app. Sample AdAM data from the safetyData package used by default -#' @param meta data frame containing the metadata for use in the app. +#' @param meta data frame containing the metadata for use in the app. If no metadata is provided (default value is NULL), metatdata is generated by `makeMeta()`. #' @param charts list of charts in the format produced by safetyGraphics::makeChartConfig() #' @param mapping list specifying the initial mapping values for each data mapping for each domain (e.g. list(aes= list(id_col='USUBJID', seq_col='AESEQ')). #' @param autoMapping boolean indicating whether the app should attempt to automatically detect data standards and generate mappings for the data provided. Values specified in the `mapping` parameter overwrite automatically generated mappings when both are found. Defaults to true. @@ -69,11 +69,8 @@ app_startup<-function(domainData=NULL, meta=NULL, charts=NULL, mapping=NULL, aut } } - # generate a full list of metadata - meta <- charts %>% map(~.x$meta) %>% rbind %>% distinct - - # warning if there are duplicate rows in a domain - # TODO + # generate a full list of metadata if none is provided + if(is.null(meta)) meta <- makeMeta(charts) # generate mappings and data standards mappingObj <- makeMapping(domainData, meta, autoMapping, mapping) diff --git a/R/makeMeta.R b/R/makeMeta.R index 5841aba0..54bf0d18 100644 --- a/R/makeMeta.R +++ b/R/makeMeta.R @@ -1,6 +1,8 @@ -#' Create a metadata object table for a chart +#' Create a metadata object table for a set of charts #' -#' @param chart safetyGraphics chart object for which to create metadata +#' Generates metadata object for a list charts. makeMeta() looks in chart$package namespace for files called meta_{chart$name} and meta_{chart$domain} for all charts, and then stacks all files. If duplicate metadata rows (domain + text_key) are found an error is thrown. +#' +#' @param charts list of safetyGraphics chart objects for which to create metadata #' #' @return tibble of metadata with the following columns: #' \describe{ @@ -18,69 +20,49 @@ #' #' @export -makeMeta <- function(chart){ - stopifnot(typeof(chart$domain) %in% c('list','character')) - if(hasName(chart, 'meta')){ - message(chart$name, " already has `meta` defined. Skipping makeMeta() processing.") - all_meta <- NULL - }else{ - packagePath <- paste0('package:',chart$package) - if(typeof(chart$domain) == "character"){ - domains <- chart$domain - }else if(typeof(chart$domain) == "list"){ - domains <- names(chart$domain) - } - - # check for chart level metadata - chart_meta_found <- exists( - paste0("meta_",chart$name), +makeMeta <- function(charts){ + sources <- charts %>% map(function(chart){ + pkg<-ifelse(is.null(chart$package), 'safetyCharts',chart$package) + files<-paste0('meta_',c(chart$name, chart$domain)) %>% map(~list(file=.x, pkg=pkg)) + return(files) + }) %>% + flatten %>% + unique + + dfs<-sources %>% map(function(src){ + packagePath <- paste0('package:',src$pkg) + file_found <- exists( + src$file, where=packagePath, inherits=FALSE ) - if(chart_meta_found) { - chart_meta <- get( - paste0("meta_",chart$name), + if(file_found){ + this_meta <- get( + src$file, pos=packagePath, inherits=FALSE - )%>% - mutate(source = paste0(packagePath, ":meta_", chart$name)) - }else{ - chart_meta <- tibble() - } - - # check for domain-level metadata - domain_meta <- tibble() - for(domain in domains){ - # get domains level meta - domain_meta_found <- exists( - paste0("meta_",domain), - where=packagePath, - inherits=FALSE ) - if(domain_meta_found) { - this_meta <- get( - paste0("meta_",domain), - pos=packagePath, - inherits=FALSE - ) %>% - mutate(source = paste0(packagePath, ":meta_", domain)) - }else{ - this_meta <- tibble() - } - domain_meta <- rbind(domain_meta, this_meta) + + if(is.data.frame(this_meta)){ + this_meta <- this_meta%>% + mutate(source = paste0(src$pkg, ":",src$file)) + return(this_meta) + } } - + }) - all_meta <- rbind(chart_meta, domain_meta) + meta<-bind_rows(dfs) + + # Throw error if duplicate records are found + dupes <- duplicated(meta%>%select(.data$domain, .data$text_key)) + if(any(dupes)){ + dupeIDs <- meta[dupes]%>% + mutate(domain_text_key=paste(.data$domain,.data$text_key,sep="-"))%>% + pull(.data$domain_text_key)%>% + paste(collapse="\n") + stop(paste("Duplicate rows in metadata for:\n",dupeIDs)) + } - # Remove duplicate meta data - dupes <- duplicated(all_meta%>%select(domain, text_key)) - if(any(dupes)){ - dup_meta <- all_meta[dupes,] - message("Removed ",sum(dupes)," duplicate metadata records for ", chart$name,".") - all_meta <- all_meta[!dupes,] - } - } + return(meta) +} - return(all_meta) -} \ No newline at end of file diff --git a/R/prepareChart.R b/R/prepareChart.R index 7724de1a..71ffebc4 100644 --- a/R/prepareChart.R +++ b/R/prepareChart.R @@ -36,8 +36,6 @@ prepareChart <- function(chart){ FALSE, tolower(chart$env)=="safetygraphics" ) - #### Make Chart-level meta-data #### - chart$meta <- makeMeta(chart) #### Bind Workflow functions to chart object #### if(!hasName(chart,"functions")){ diff --git a/R/safetyGraphicsApp.R b/R/safetyGraphicsApp.R index cb664f64..1d62348b 100644 --- a/R/safetyGraphicsApp.R +++ b/R/safetyGraphicsApp.R @@ -1,7 +1,7 @@ #' Run the core safetyGraphics App #' #' @param domainData named list of data.frames to be loaded in to the app. Sample AdAM data from the safetyData package used by default -#' @param meta data frame containing the metadata for use in the app. +#' @param meta data frame containing the metadata for use in the app. If no metadata is provided, metatdata is generated by `makeMeta()`. #' @param charts list of charts in the format produced by safetyGraphics::makeChartConfig() #' @param mapping list specifying the initial mapping values for each data mapping for each domain (e.g. list(aes= list(id_col='USUBJID', seq_col='AESEQ')). #' @param autoMapping boolean indicating whether the app should attempt to automatically detect data standards and generate mappings for the data provided. Values specified in the `mapping` parameter overwrite automatically generated mappings when both are found. Defaults to true. diff --git a/man/app_startup.Rd b/man/app_startup.Rd index 4be6aed4..cccaa5ba 100644 --- a/man/app_startup.Rd +++ b/man/app_startup.Rd @@ -17,7 +17,7 @@ app_startup( \arguments{ \item{domainData}{named list of data.frames to be loaded in to the app. Sample AdAM data from the safetyData package used by default} -\item{meta}{data frame containing the metadata for use in the app. See the preloaded file (\code{?safetyGraphics::meta}) for more data specifications and details. Defaults to \code{safetyGraphics::meta}.} +\item{meta}{data frame containing the metadata for use in the app. If no metadata is provided (default value is NULL), metatdata is generated by \code{makeMeta()}.} \item{charts}{list of charts in the format produced by safetyGraphics::makeChartConfig()} diff --git a/man/makeMeta.Rd b/man/makeMeta.Rd index 8b71994a..c6301bcf 100644 --- a/man/makeMeta.Rd +++ b/man/makeMeta.Rd @@ -2,14 +2,12 @@ % Please edit documentation in R/makeMeta.R \name{makeMeta} \alias{makeMeta} -\title{Create a metadata object based on the selected charts} +\title{Create a metadata object table for a set of charts} \usage{ -makeMeta(charts, package = "safetyCharts") +makeMeta(charts) } \arguments{ -\item{charts}{list of charts for which metadata is needed} - -\item{package}{package containing needed metadata} +\item{charts}{list of safetyGraphics chart objects for which to create metadata} } \value{ tibble of metadata with the following columns: @@ -27,5 +25,5 @@ tibble of metadata with the following columns: } } \description{ -Create a metadata object based on the selected charts +Generates metadata object for a list charts. makeMeta() looks in chart$package namespace for files called meta_{chart$name} and meta_{chart$domain} for all charts, and then stacks all files. If duplicate metadata rows (domain + text_key) are found an error is thrown. } diff --git a/man/safetyGraphicsApp.Rd b/man/safetyGraphicsApp.Rd index f5bf3615..3115379a 100644 --- a/man/safetyGraphicsApp.Rd +++ b/man/safetyGraphicsApp.Rd @@ -7,7 +7,7 @@ safetyGraphicsApp( domainData = list(labs = safetyData::adam_adlbc, aes = safetyData::adam_adae, dm = safetyData::adam_adsl), - meta = safetyGraphics::meta, + meta = NULL, charts = NULL, mapping = NULL, autoMapping = TRUE, @@ -18,7 +18,7 @@ safetyGraphicsApp( \arguments{ \item{domainData}{named list of data.frames to be loaded in to the app. Sample AdAM data from the safetyData package used by default} -\item{meta}{data frame containing the metadata for use in the app. See the preloaded file (\code{?safetyGraphics::meta}) for more data specifications and details. Defaults to \code{safetyGraphics::meta}.} +\item{meta}{data frame containing the metadata for use in the app. If no metadata is provided, metatdata is generated by \code{makeMeta()}.} \item{charts}{list of charts in the format produced by safetyGraphics::makeChartConfig()} diff --git a/tests/testthat/test_makeMeta.R b/tests/testthat/test_makeMeta.R index b4eb2d6f..46f8f5bb 100644 --- a/tests/testthat/test_makeMeta.R +++ b/tests/testthat/test_makeMeta.R @@ -3,14 +3,12 @@ library(safetyGraphics) library(safetyCharts) # User Requirements -# [*] Charts with exisiting meta objects are not modified. A message is printed. -# [*] Chart-level metadata (e.g. meta_hepExplorer) is loaded when found -# [ ] If no metadata is found for a chart, a warning message is printed. -# [ ] If a chart doesn't have name or domain property no metadata is added and a message is printed. -# [*] Domain-level metadata is loaded for a single domain when found -# [*] Domain-level metadata for multiple domains is loaded when found -# [ ] Domain-level metadata is loaded as expected when chart domain is a named list or a character vector -# [ ] Chart-level takes precedence over domain-level metadata when both are found +# [ ] Chart-level metadata (e.g. meta_hepExplorer) is loaded when found +# [ ] Domain-level metadata is loaded for a single domain when found +# [ ] Domain-level metadata for multiple domains is loaded when found +# [ ] If no metadata is found for a chart, a warning message is printed. +# [ ] An error is thrown if duplicate rows of metadata are found + testChart <-list( env="safetyGraphics", @@ -24,22 +22,15 @@ testChart <-list( ) ) -test_that("Charts with exisiting meta objects are not modified. A message is printed.",{ - metaChart <- testChart - metaChart$meta <- "JustAPlaceholder" - expect_message(makeMeta(chart=metaChart)) - expect_null(makeMeta(chart=metaChart)) -}) - test_that("Domain-level metadata is loaded for a single domain when found.",{ - testMeta <- makeMeta(testChart) %>% select(-source) + testMeta <- makeMeta(list(testChart)) %>% select(-source) expect_equal(testMeta, safetyCharts::meta_dm) }) test_that("Domain-level metadata for multiple domains is loaded when found",{ multiDomainChart <- testChart multiDomainChart$domain <- c("dm","aes") - multiDomainMeta <- makeMeta(multiDomainChart) %>% select(-source) + multiDomainMeta <- makeMeta(list(multiDomainChart)) %>% select(-source) expect_equal(multiDomainMeta, rbind(safetyCharts::meta_dm, safetyCharts::meta_aes)) }) @@ -50,12 +41,21 @@ test_that("Chart-level metadata (e.g. meta_hepExplorer) is loaded when found",{ package="safetyCharts", domain="none" ) - chartMeta <- makeMeta(testChart) %>% select(-source) + chartMeta <- makeMeta(list(testChart)) %>% select(-source) expect_equal(chartMeta, safetyCharts::meta_hepExplorer) #Chart that chart-level and domain-level metadata stack testChart$domain="labs" - chartMeta <- makeMeta(testChart) %>% select(-source) + chartMeta <- makeMeta(list(testChart)) %>% select(-source) expect_equal(chartMeta, rbind(safetyCharts::meta_hepExplorer, safetyCharts::meta_labs)) }) +test_that("metadata for multiple charts loads when found",{ + testCharts <-list( + list(name='chart1', domain=c('aes','dm'),package='safetyCharts'), + list(name='chart2', domain=c('labs','dm')) #package defaults to safetyCharts if not specified + ) + chartMeta <- makeMeta(testCharts) %>% select(-source) + expect_equal(chartMeta, rbind(safetyCharts::meta_aes, safetyCharts::meta_dm, safetyCharts::meta_labs)) +}) + From 8dd7adf9bff40cc2fbabadfe905097a47dce76bf Mon Sep 17 00:00:00 2001 From: Jeremy Wildfire Date: Fri, 25 Feb 2022 10:41:32 -0500 Subject: [PATCH 11/19] add support for chart and more tests for makeMeta. #637 --- NAMESPACE | 1 + R/makeMeta.R | 62 ++++++++++++++++----- R/meta.R | 20 ------- data-raw/makeMeta.R | 7 --- data-raw/meta.csv | 31 ----------- data/meta.rda | Bin 1543 -> 0 bytes tests/testthat/test_makeMeta.R | 95 ++++++++++++++++++++++++++++++--- 7 files changed, 138 insertions(+), 78 deletions(-) delete mode 100644 R/meta.R delete mode 100644 data-raw/makeMeta.R delete mode 100644 data-raw/meta.csv delete mode 100644 data/meta.rda diff --git a/NAMESPACE b/NAMESPACE index d86d9a7e..da98f1a3 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -77,6 +77,7 @@ importFrom(stringr,str_replace_all) importFrom(stringr,str_split) importFrom(stringr,str_to_title) importFrom(stringr,str_to_upper) +importFrom(tidyr,replace_na) importFrom(utils,hasName) importFrom(utils,zip) importFrom(yaml,as.yaml) diff --git a/R/makeMeta.R b/R/makeMeta.R index 54bf0d18..501f9ef0 100644 --- a/R/makeMeta.R +++ b/R/makeMeta.R @@ -18,9 +18,12 @@ #' \item{standard_sdtm}{Default values for the SDTM data standard} #' } #' +#' @importFrom tidyr replace_na starts_with #' @export makeMeta <- function(charts){ + message(paste0("-Generating meta data for ",length(charts), " charts.")) + # Check each chart to see if {package}::meta_{domain} or {package}::meta_{name} exists sources <- charts %>% map(function(chart){ pkg<-ifelse(is.null(chart$package), 'safetyCharts',chart$package) files<-paste0('meta_',c(chart$name, chart$domain)) %>% map(~list(file=.x, pkg=pkg)) @@ -29,7 +32,7 @@ makeMeta <- function(charts){ flatten %>% unique - dfs<-sources %>% map(function(src){ + pkg_dfs<-sources %>% map(function(src){ packagePath <- paste0('package:',src$pkg) file_found <- exists( src$file, @@ -45,24 +48,55 @@ makeMeta <- function(charts){ if(is.data.frame(this_meta)){ this_meta <- this_meta%>% - mutate(source = paste0(src$pkg, ":",src$file)) + mutate(source = paste0(src$pkg, "::",src$file)) return(this_meta) } } }) - meta<-bind_rows(dfs) - - # Throw error if duplicate records are found - dupes <- duplicated(meta%>%select(.data$domain, .data$text_key)) - if(any(dupes)){ - dupeIDs <- meta[dupes]%>% - mutate(domain_text_key=paste(.data$domain,.data$text_key,sep="-"))%>% - pull(.data$domain_text_key)%>% - paste(collapse="\n") - stop(paste("Duplicate rows in metadata for:\n",dupeIDs)) - } + ## check for meta bound directly to the charts + chart_dfs <- charts %>% map(function(chart){ + if(is.data.frame(chart$meta)){ + this_meta <- chart$meta %>% mutate(source = paste0('charts$', chart$name, "$meta")) + return(this_meta) + }else{ + if(!is.null(chart$meta)) warning(paste0("Ignoring non-data.frame object found in charts$", chart$name, "$meta")) + } + }) - return(meta) + ## make sure dfs have required columns + dfs<-c(pkg_dfs,chart_dfs) + required_cols <- c("domain","text_key","col_key","type") + dfs <- dfs%>% + keep(is.data.frame)%>% + keep(function(df){ + has_cols <- all(required_cols %in% names(df)) + if(!has_cols) warning(paste(df[1,'source'],"dropped from meta because of missing required columns.")) + return(has_cols) + }) + + ## combine list of dfs into single df + if(length(dfs)>0){ + meta<-bind_rows(dfs) %>% + mutate_at(vars(tidyr::starts_with('standard_')), ~tidyr::replace_na(., "")) + + # Throw error if duplicate records are found + dupes <- duplicated(meta%>%select(.data$domain, .data$text_key)) + if(any(dupes)){ + dupeIDs <- meta[dupes,]%>% + mutate(domain_text_key=paste(.data$domain,.data$text_key,sep="-"))%>% + pull(.data$domain_text_key)%>% + unique%>% + paste(collapse="\n") + stop(paste("Duplicate rows in metadata for:\n",dupeIDs)) + } + + sources <- meta %>% pull(source) %>% unique %>% paste(collapse=" ") + message(paste0("-Meta object created using the following source(s): ",sources)) + return(meta) + } else { + stop("No metadata found. ") + } + } diff --git a/R/meta.R b/R/meta.R deleted file mode 100644 index 8df6856a..00000000 --- a/R/meta.R +++ /dev/null @@ -1,20 +0,0 @@ -#' Metadata data frame containing information about the data mapping used to configure safetyGraphics charts. One record per unique data mapping -#' -#' @format A data frame with 31 rows and 7 columns -#' \describe{ -#' \item{domain}{Data domain} -#' \item{text_key}{Text key indicating the setting name. \code{'--'} delimiter indicates a field level data mapping} -#' \item{col_key}{Key for the column mapping} -#' \item{field_key}{Key for the field mapping (if any)} -#' \item{type}{type of mapping - "field" or "column"} -#' \item{label}{Label} -#' \item{description}{Description} -#' \item{multiple}{Mapping supports multiple columns/fields } -#' \item{standard_adam}{Default values for the ADaM data standard} -#' \item{standard_sdtm}{Default values for the SDTM data standard} -#' } -#' -#' @source Created for this package - - -"meta" diff --git a/data-raw/makeMeta.R b/data-raw/makeMeta.R deleted file mode 100644 index ff61458f..00000000 --- a/data-raw/makeMeta.R +++ /dev/null @@ -1,7 +0,0 @@ -# Note: expected to be run from the root package directory -library(tidyverse) -library(usethis) - -#Copy metadata to /data -meta<-read_csv("data-raw/meta.csv") -usethis::use_data(meta, overwrite = TRUE) diff --git a/data-raw/meta.csv b/data-raw/meta.csv deleted file mode 100644 index 4973a088..00000000 --- a/data-raw/meta.csv +++ /dev/null @@ -1,31 +0,0 @@ -text_key,domain,col_key,field_key,type,label,description,multiple,standard_adam,standard_sdtm -id_col,aes,id_col,,column,ID column,Unique subject identifier variable name.,FALSE,USUBJID,USUBJID -seq_col,aes,seq_col,,column,Sequence column,Event sequence number variable name,FALSE,AESEQ,AESEQ -stdy_col,aes,stdy_col,,column,AE Start day column,Event start day variable name,FALSE,ASTDY,AESTDY -endy_col,aes,endy_col,,column,AE End day column,Event end day variable name,FALSE,AENDY,AEENDY -term_col,aes,term_col,,column,Preferred Term Column,Dictionary-Derived Term,FALSE,AEDECOD,AEDECOD -bodsys_col,aes,bodsys_col,,column,AE Body System,Body System or Organ Class,FALSE,AEBODSYS,AEBODSYS -id_col,labs,id_col,,column,ID column,Unique subject identifier variable name.,FALSE,USUBJID,USUBJID -value_col,labs,value_col,,column,Value column,Lab result variable name.,FALSE,AVAL,LBSTRESN -measure_col,labs,measure_col,,column,Measure column,Lab measure variable name,FALSE,PARAM,LBTEST -normal_col_low,labs,normal_col_low,,column,Lower Limit of Normal column,Lower limit of normal variable name,FALSE,A1LO,LBSTNRLO -normal_col_high,labs,normal_col_high,,column,Upper Limit of Normal column,Upper limit of normal variable name,FALSE,A1HI,LBSTNRHI -studyday_col,labs,studyday_col,,column,Study Day column,Visit day variable name,FALSE,ADY,LBDY -visit_col,labs,visit_col,,column,Visit column,Visit variable name,FALSE,VISIT,VISIT -visitn_col,labs,visitn_col,,column,Visit Number column,Visit number variable name,FALSE,VISITNUM,VISITNUM -measure_values--ALT,labs,measure_col,ALT,field,Alanine Aminotransferase value,Value used for Alanine Aminotransferase in the specified measure column,FALSE,Alanine Aminotransferase (U/L),Alanine Aminotransferase -measure_values--AST,labs,measure_col,AST,field,Aspartate Aminotransferase value,Value used for Aspartate Aminotransferase in the specified measure column,FALSE,Aspartate Aminotransferase (U/L),Aspartate Aminotransferase -measure_values--TB,labs,measure_col,TB,field,Total Bilirubin value,Value used for Total Bilirubin in the specified measure column,FALSE,Bilirubin (umol/L),Bilirubin -measure_values--ALP,labs,measure_col,ALP,field,Alkaline Phosphatase value,Value used for Alkaline Phosphatase in the specified measure column,FALSE,Alkaline Phosphatase (U/L),Alkaline Phosphatase -unit_col,labs,unit_col,,column,Unit column,Unit of measure variable name,FALSE,,LBSTRESU -baseline_flag_col,labs,baseline_flag_col,,column,Baseline column,An optional list defining which column represent the baseline visit(s) of the study.,FALSE,, -baseline_flag_values,labs,baseline_flag_col,values,field,Baseline values,An optional list defining which values (one or more) represent the baseline visit(s) of the study.,TRUE,, -analysis_flag_col,labs,analysis_flag_col,,column,Analysis column,An optional list defining which column represent the analysis visit(s) of the study.,FALSE,, -analysis_flag_values,labs,analysis_flag_col,values,field,Analysis values,An optional list defining which values (one or more) represent the analysis visit(s) of the study.,TRUE,, -id_col,dm,id_col,,column,ID column,Unique subject identifier variable name.,FALSE,USUBJID,USUBJID -treatment_col,dm,treatment_col,,column,Treatment Column,Treatment Column,FALSE,ARM,ARM -treatment_values--group1,dm,treatment_col,group1,field,Treatment 1,Treatment 1,FALSE,, -treatment_values--group2,dm,treatment_col,group2,field,Treatment 2,Treatment 2,FALSE,, -sex_col,dm,sex_col,,column,Sex Column,Sex Column,FALSE,SEX,SEX -race_col,dm,race_col,,column,Race Column,Race Column,FALSE,RACE,RACE -age_col,dm,age_col,,column,Age Column,Age Column,FALSE,AGE,AGE diff --git a/data/meta.rda b/data/meta.rda deleted file mode 100644 index 8be670d4be3484a8f809777de96f5e89be718985..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 1543 zcmV+i2Kf0xT4*^jL0KkKS*0Lt!vF^9|H1$N{{Kj0umL{z|6srW|KLCX5C8xH;0FH+ zIx5U400000N-3eJnrLWkMoiHF9-zp`226*k>ODq-Y5*K$!89@%85uM*0iejj0ie;Q zLlDpbrirAc$uu$m4FCYhX{L<;1|gst0me)dLm`oolS4on42&Qe4H{%I4FEXFf@owi zGBRjr13{6513{xqh9RH%I&LSp{}z`hNc2f7c`uN4qzo;U(Qg>D1$DdZ0T$s~yJ;rvmqQ>TXhmQBPdx3#{)nCw`&6k|PpdRtcJJXz!i1;|o^jz`X2Y+slSmLkR$bjQGglQ+2<-SWI1@s{PsJc z6+q!N$j4nrOEpA@aR=UyuOZImv^>!AIQTw{mj4W&qx4`k`I#3pTGpk^pNF&AgJ0E` z+V>|E@0t8aR~JKPO6WK%1(w9q?^6ioBfMkCuW!v$kd_KGS~U3zP5 z&?`cTOpxqAz+rl9z3KG6=kT)(7Jckj&$gCevn;uNmi4A~3aYIaGB8?2}BoN#9f&XEmGDvC9k39gv)=c>Qub5c2T)JxLr% z9Zm_V6p_p;Vutq$Ub6-U+_Bc%V=Vd`pXN-ABN=7maQQYoWlM zW+js}&RqEGG&Os4+SX~F0i)HCb=uloiDGJMEm!Q;*3Uj9%I(9wfURd(>snlU!$JFU zoFmGnMvjk7R&IwxPGfO7j2_dHNt2|`oHLpY26=EKTs{PYtB?L$GCB4%~D1ihtc3s9ydmW<2G*^?xb z-{aW&D*~CJl~OJ!`r}J8<$cTsBP@}Fk09ah7tHT2j&~6)9CIQBpb`$Z>8MLgPf3sT&gn)#Bc2 zD=d?do@X8-$8!YMT5#7rMFlt2)LwTBCiTUh22|NexS@IEY^Q8y8KQM{8ZGeUHySi$ zI}ABm7Cj1>EehbZNuD@NHueIybf%Al^D$j!TtFN|Jv`%lmgP tGCZvDag0nS3Q(muoDE}*<^DYKN<`=-)`d`o+N2-+UC9*TLPC^*w+zvc-~9jp diff --git a/tests/testthat/test_makeMeta.R b/tests/testthat/test_makeMeta.R index 46f8f5bb..93aa8f1e 100644 --- a/tests/testthat/test_makeMeta.R +++ b/tests/testthat/test_makeMeta.R @@ -3,12 +3,17 @@ library(safetyGraphics) library(safetyCharts) # User Requirements -# [ ] Chart-level metadata (e.g. meta_hepExplorer) is loaded when found -# [ ] Domain-level metadata is loaded for a single domain when found -# [ ] Domain-level metadata for multiple domains is loaded when found -# [ ] If no metadata is found for a chart, a warning message is printed. -# [ ] An error is thrown if duplicate rows of metadata are found - +# [*] Chart-level metadata (e.g. meta_hepExplorer) is loaded when found +# [*] Domain-level metadata is loaded for a single domain when found +# [*] Domain-level metadata for multiple domains is loaded when found +# [*] Metadata is loaded as expected for multiple charts +# [*] Metadata saved to chart.meta is loaded +# [*] Metadata saved to chart.meta is loaded with chart-level and domain-level metadata. +# [*] Metadata that is not a dataframe is not loaded and a message is printed. +# [*] Metadata with incorrect columns is not loaded and a message is printed. +# [*] If no metadata is found for a chart, a warning message is printed. +# [*] An error is thrown if duplicate rows of metadata are found +# [*] An error is thrown if no metadata is found testChart <-list( env="safetyGraphics", @@ -59,3 +64,81 @@ test_that("metadata for multiple charts loads when found",{ expect_equal(chartMeta, rbind(safetyCharts::meta_aes, safetyCharts::meta_dm, safetyCharts::meta_labs)) }) +helloMeta <- tribble( + ~text_key, ~domain, ~label, ~description, + "x_col", "hello", "x position", "x position for points in hello world chart", + "y_col", "hello", "y position", "y position for points in hello world chart" +) %>% mutate( + col_key = text_key, + type="column" +) +helloChart <- list(name='hello',meta=helloMeta) + +test_that("metadata saved to chart.meta is loaded",{ + chartMeta <- makeMeta(list(helloChart)) %>% select(-source) + expect_equal(chartMeta,helloMeta) +}) + +test_that("Metadata saved to chart.meta is loaded with chart-level and domain-level metadata.",{ + hepChart <-list( + env="safetyGraphics", + name="hepExplorer", + package="safetyCharts", + domain="labs" + ) + charts<-list(helloChart,hepChart) + chartMeta <- makeMeta(charts) %>% select(-source) + expect_equal(chartMeta,bind_rows(safetyCharts::meta_hepExplorer, safetyCharts::meta_labs, helloMeta)) +}) + +test_that("chart.meta that is not a dataframe is not loaded and a message is printed.",{ + badHello <-list( + list(name='hello',meta="not-a-df"), + list(name="labChart",domain="labs") + ) + expect_warning(makeMeta(badHello)) + expect_equal(suppressWarnings(makeMeta(badHello))%>%select(-source), safetyCharts::meta_labs) +}) + +test_that("Metadata with incorrect columns is not loaded and a message is printed.",{ + badHello2 <- list( + list(name='hello',meta=helloMeta%>%rename(id=text_key)), + list(name="labChart",domain="labs") + ) + expect_warning(makeMeta(badHello2)) + expect_equal(suppressWarnings(makeMeta(badHello2))%>%select(-source), safetyCharts::meta_labs) +}) + +test_that("An error is thrown if duplicate rows of metadata are found",{ + dupLabMeta <- tribble( + ~text_key, ~domain, ~label, ~description, + "id_col", "labs", "ID", "ID" + ) %>% mutate( + col_key = text_key, + type="column" + ) + dupTest <- list( + list(name='myLabChart',meta=dupLabMeta), + list(name="thierLabChart",domain="labs") + ) + expect_error(makeMeta(dupTest)) + + helloDupMeta <- tribble( + ~text_key, ~domain, ~label, ~description, + "x_col", "hello", "x position", "x position for points in hello world chart", + "x_col", "hello", "x position (again)" , "x position for points in hello world chart" + ) %>% mutate( + col_key = text_key, + type="column" + ) + helloDup <- list(list(name='helloDup',meta=helloDupMeta)) + expect_error(makeMeta(helloDup)) +}) + +test_that("An error is thrown if no metadata is found",{ + noMetaTest <- list( + list(name='myLabChart',domain="slabs"), + list(name="thierLabChart",domain="crabs") + ) + expect_error(makeMeta(noMetaTest)) +}) \ No newline at end of file From 9e5b05018f8f7c032848983ac92e6a5a5cf19324 Mon Sep 17 00:00:00 2001 From: Jeremy Wildfire Date: Fri, 25 Feb 2022 13:00:18 -0500 Subject: [PATCH 12/19] fix test and check issues caused by meta migration --- DESCRIPTION | 1 + NAMESPACE | 1 + R/detectStandard.R | 8 ++-- R/evaluateStandard.R | 4 +- R/makeMapping.R | 2 +- R/makeMeta.R | 4 +- R/mod_safetyGraphicsServer.R | 2 +- R/mod_safetyGraphicsUI.R | 2 +- man/detectStandard.Rd | 8 ++-- man/evaluateStandard.Rd | 4 +- man/makeMapping.Rd | 2 +- man/meta.Rd | 31 ------------- man/safetyGraphicsServer.Rd | 2 +- man/safetyGraphicsUI.Rd | 2 +- .../testthat/module_examples/chartsTab/app.R | 10 +++- .../module_examples/mappingDomain/app.R | 28 ++++++----- .../module_examples/settingsMapping/app.R | 13 ++++-- tests/testthat/test_detectStandard.R | 46 +++++++++---------- tests/testthat/test_evaluateStandard.R | 34 +++++++------- tests/testthat/test_makeMapping.R | 21 ++++++--- tests/testthat/test_mod_mappingColumn.R | 7 +++ tests/testthat/test_mod_mappingDomain.R | 25 ++++++---- 22 files changed, 133 insertions(+), 124 deletions(-) delete mode 100644 man/meta.Rd diff --git a/DESCRIPTION b/DESCRIPTION index f1ca0619..cf0fa2fd 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -44,6 +44,7 @@ Imports: shinyjs (>= 2.0.0), sortable (>= 0.4.4), stringr (>= 1.4.0), + tidyr, yaml (>= 2.2.1) VignetteBuilder: knitr Roxygen: list(markdown = TRUE) diff --git a/NAMESPACE b/NAMESPACE index da98f1a3..7542ed76 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -78,6 +78,7 @@ importFrom(stringr,str_split) importFrom(stringr,str_to_title) importFrom(stringr,str_to_upper) importFrom(tidyr,replace_na) +importFrom(tidyr,starts_with) importFrom(utils,hasName) importFrom(utils,zip) importFrom(yaml,as.yaml) diff --git a/R/detectStandard.R b/R/detectStandard.R index 0b6ab402..ea555b77 100644 --- a/R/detectStandard.R +++ b/R/detectStandard.R @@ -5,19 +5,19 @@ #' 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{"meta"} data set included as part of this package. #' #' @param data A data frame in which to detect the data standard - required. -#' @param meta the metadata containing the data standards. - default = safetyGraphics::meta +#' @param meta the metadata containing the data standards. #' @param domain the domain to evaluate - should match a value of \code{meta$domain}. Uses the first value in \code{meta$domain} if no value is provided. #' #' @return A data frame describing the detected standard for each \code{"text_key"} in the provided metadata. Columns are \code{"domain"}, \code{"text_key"}, \code{"column"} and \code{"standard"}. #' @examples -#' detectStandard(data=safetyData::adam_adae) #aes domain evaluated by default -#' detectStandard(data=safetyData::adam_adlbc,domain="labs" ) +#' detectStandard(data=safetyData::adam_adae, meta=safetyCharts::meta_aes) +#' detectStandard(data=safetyData::adam_adlbc,meta=safetyCharts::meta_labs, domain="labs" ) #' #' @importFrom stringr str_detect #' #' @export -detectStandard <- function(data, domain=NULL, meta=safetyGraphics::meta){ +detectStandard <- function(data, domain=NULL, meta=NULL){ if(is.null(domain)){ domain<-unique(meta$domain)[1] } diff --git a/R/evaluateStandard.R b/R/evaluateStandard.R index 282a0535..97679604 100644 --- a/R/evaluateStandard.R +++ b/R/evaluateStandard.R @@ -13,7 +13,7 @@ #' # Match is TRUE #' evaluateStandard( #' data=safetyData::adam_adlbc, -#' meta=meta, +#' meta=safetyCharts::meta_labs, #' domain="labs", #' standard="adam" #' ) @@ -21,7 +21,7 @@ #' # Match is FALSE #' evaluateStandard( #' data=safetyData::adam_adlbc, -#' meta=meta, +#' meta=safetyCharts::meta_labs, #' domain="labs", #' standard="sdtm" #' ) diff --git a/R/makeMapping.R b/R/makeMapping.R index 1ae554a3..c98f66a0 100644 --- a/R/makeMapping.R +++ b/R/makeMapping.R @@ -1,7 +1,7 @@ #' Create data mapping based on data standards and user input #' #' @param domainData named list of data.frames to be loaded in to the app. Sample AdAM data from the safetyData package used by default -#' @param meta data frame containing the metadata for use in the app. See the preloaded file (\code{?safetyGraphics::meta}) for more data specifications and details. Defaults to \code{safetyGraphics::meta}. +#' @param meta data frame containing the metadata for use in the app. #' @param customMapping optional list specifying initial mapping values within each data mapping (e.g. list(aes= list(id_col='USUBJID', seq_col='AESEQ')). #' @param autoMapping boolean indicating whether the app should use `safetyGraphics::detectStandard()` to detect data standards and automatically generate mappings for the data provided. Values specified in the `customMapping` parameter overwrite auto-generated mappings when both are found. Defaults to true. #' diff --git a/R/makeMeta.R b/R/makeMeta.R index 501f9ef0..0cb5effc 100644 --- a/R/makeMeta.R +++ b/R/makeMeta.R @@ -77,8 +77,8 @@ makeMeta <- function(charts){ ## combine list of dfs into single df if(length(dfs)>0){ - meta<-bind_rows(dfs) %>% - mutate_at(vars(tidyr::starts_with('standard_')), ~tidyr::replace_na(., "")) + meta<-bind_rows(dfs) + #%>% mutate_at(vars(tidyr::starts_with('standard_')), ~tidyr::replace_na(., "")) # Throw error if duplicate records are found dupes <- duplicated(meta%>%select(.data$domain, .data$text_key)) diff --git a/R/mod_safetyGraphicsServer.R b/R/mod_safetyGraphicsServer.R index 89126bde..0d7e4b85 100644 --- a/R/mod_safetyGraphicsServer.R +++ b/R/mod_safetyGraphicsServer.R @@ -5,7 +5,7 @@ #' @param input Shiny input object #' @param output Shiny output object #' @param session Shiny session object -#' @param meta data frame containing the metadata for use in the app. See the preloaded file (\code{?safetyGraphics::meta}) for more data specifications and details. Defaults to \code{safetyGraphics::meta}. +#' @param meta data frame containing the metadata for use in the app. #' @param domainData named list of data.frames to be loaded in to the app. #' @param mapping current mapping #' @param charts list of charts to include in the app diff --git a/R/mod_safetyGraphicsUI.R b/R/mod_safetyGraphicsUI.R index 02f5dc6e..66057d8d 100644 --- a/R/mod_safetyGraphicsUI.R +++ b/R/mod_safetyGraphicsUI.R @@ -2,7 +2,7 @@ #' #' #' @param id module ID -#' @param meta data frame containing the metadata for use in the app. See the preloaded file (\code{?safetyGraphics::meta}) for more data specifications and details. Defaults to \code{safetyGraphics::meta}. +#' @param meta data frame containing the metadata for use in the app. #' @param domainData named list of data.frames to be loaded in to the app. #' @param mapping data.frame specifying the initial values for each data mapping. If no mapping is provided, the app will attempt to generate one via \code{detectStandard()} #' @param standards a list of information regarding data standards. Each list item should use the format returned by safetyGraphics::detectStandard. diff --git a/man/detectStandard.Rd b/man/detectStandard.Rd index dc021561..b627b42c 100644 --- a/man/detectStandard.Rd +++ b/man/detectStandard.Rd @@ -4,14 +4,14 @@ \alias{detectStandard} \title{Detect the data standard used for a data set} \usage{ -detectStandard(data, domain = NULL, meta = safetyGraphics::meta) +detectStandard(data, domain = NULL, meta = NULL) } \arguments{ \item{data}{A data frame in which to detect the data standard - required.} \item{domain}{the domain to evaluate - should match a value of \code{meta$domain}. Uses the first value in \code{meta$domain} if no value is provided.} -\item{meta}{the metadata containing the data standards. - default = safetyGraphics::meta} +\item{meta}{the metadata containing the data standards.} } \value{ A data frame describing the detected standard for each \code{"text_key"} in the provided metadata. Columns are \code{"domain"}, \code{"text_key"}, \code{"column"} and \code{"standard"}. @@ -23,7 +23,7 @@ This function attempts to detect the clinical data standard used in a given R da 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(\url{https://www.cdisc.org/}) standards for clinical trial data by default. Additional standards can be added by modifying the \code{"meta"} data set included as part of this package. } \examples{ -detectStandard(data=safetyData::adam_adae) #aes domain evaluated by default -detectStandard(data=safetyData::adam_adlbc,domain="labs" ) +detectStandard(data=safetyData::adam_adae, meta=safetyCharts::meta_aes) +detectStandard(data=safetyData::adam_adlbc,meta=safetyCharts::meta_labs, domain="labs" ) } diff --git a/man/evaluateStandard.Rd b/man/evaluateStandard.Rd index 5c8f97b0..f1ef1c25 100644 --- a/man/evaluateStandard.Rd +++ b/man/evaluateStandard.Rd @@ -25,7 +25,7 @@ Determines whether the required data elements in a data standard are found in a # Match is TRUE evaluateStandard( data=safetyData::adam_adlbc, - meta=meta, + meta=safetyCharts::meta_labs, domain="labs", standard="adam" ) @@ -33,7 +33,7 @@ evaluateStandard( # Match is FALSE evaluateStandard( data=safetyData::adam_adlbc, - meta=meta, + meta=safetyCharts::meta_labs, domain="labs", standard="sdtm" ) diff --git a/man/makeMapping.Rd b/man/makeMapping.Rd index 6e8168a0..e4b40b5a 100644 --- a/man/makeMapping.Rd +++ b/man/makeMapping.Rd @@ -9,7 +9,7 @@ makeMapping(domainData, meta, autoMapping, customMapping) \arguments{ \item{domainData}{named list of data.frames to be loaded in to the app. Sample AdAM data from the safetyData package used by default} -\item{meta}{data frame containing the metadata for use in the app. See the preloaded file (\code{?safetyGraphics::meta}) for more data specifications and details. Defaults to \code{safetyGraphics::meta}.} +\item{meta}{data frame containing the metadata for use in the app.} \item{autoMapping}{boolean indicating whether the app should use \code{safetyGraphics::detectStandard()} to detect data standards and automatically generate mappings for the data provided. Values specified in the \code{customMapping} parameter overwrite auto-generated mappings when both are found. Defaults to true.} diff --git a/man/meta.Rd b/man/meta.Rd deleted file mode 100644 index d38e7f71..00000000 --- a/man/meta.Rd +++ /dev/null @@ -1,31 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/meta.R -\docType{data} -\name{meta} -\alias{meta} -\title{Metadata data frame containing information about the data mapping used to configure safetyGraphics charts. One record per unique data mapping} -\format{ -A data frame with 31 rows and 7 columns -\describe{ -\item{domain}{Data domain} -\item{text_key}{Text key indicating the setting name. \code{'--'} delimiter indicates a field level data mapping} -\item{col_key}{Key for the column mapping} -\item{field_key}{Key for the field mapping (if any)} -\item{type}{type of mapping - "field" or "column"} -\item{label}{Label} -\item{description}{Description} -\item{multiple}{Mapping supports multiple columns/fields } -\item{standard_adam}{Default values for the ADaM data standard} -\item{standard_sdtm}{Default values for the SDTM data standard} -} -} -\source{ -Created for this package -} -\usage{ -meta -} -\description{ -Metadata data frame containing information about the data mapping used to configure safetyGraphics charts. One record per unique data mapping -} -\keyword{datasets} diff --git a/man/safetyGraphicsServer.Rd b/man/safetyGraphicsServer.Rd index 9ec00b23..ece88603 100644 --- a/man/safetyGraphicsServer.Rd +++ b/man/safetyGraphicsServer.Rd @@ -22,7 +22,7 @@ safetyGraphicsServer( \item{session}{Shiny session object} -\item{meta}{data frame containing the metadata for use in the app. See the preloaded file (\code{?safetyGraphics::meta}) for more data specifications and details. Defaults to \code{safetyGraphics::meta}.} +\item{meta}{data frame containing the metadata for use in the app.} \item{mapping}{current mapping} diff --git a/man/safetyGraphicsUI.Rd b/man/safetyGraphicsUI.Rd index ab47189a..99b312a5 100644 --- a/man/safetyGraphicsUI.Rd +++ b/man/safetyGraphicsUI.Rd @@ -9,7 +9,7 @@ safetyGraphicsUI(id, meta, domainData, mapping, standards) \arguments{ \item{id}{module ID} -\item{meta}{data frame containing the metadata for use in the app. See the preloaded file (\code{?safetyGraphics::meta}) for more data specifications and details. Defaults to \code{safetyGraphics::meta}.} +\item{meta}{data frame containing the metadata for use in the app.} \item{domainData}{named list of data.frames to be loaded in to the app.} diff --git a/tests/testthat/module_examples/chartsTab/app.R b/tests/testthat/module_examples/chartsTab/app.R index 013bc3f6..7dbafec6 100644 --- a/tests/testthat/module_examples/chartsTab/app.R +++ b/tests/testthat/module_examples/chartsTab/app.R @@ -14,7 +14,15 @@ domainData <- list( dm=safetyData::adam_adsl ) -mapping <- makeMapping(domainData, meta=safetyGraphics::meta, autoMapping=TRUE, customMapping=NULL) + +meta <- meta <- rbind( + safetyCharts::meta_labs, + safetyCharts::meta_aes, + safetyCharts::meta_dm, + safetyCharts::meta_hepExplorer +) + +mapping <- makeMapping(domainData, meta=meta, autoMapping=TRUE, customMapping=NULL) dataR<-reactive({domainData}) mappingR<-reactive({mapping$mapping}) diff --git a/tests/testthat/module_examples/mappingDomain/app.R b/tests/testthat/module_examples/mappingDomain/app.R index a32585d3..31344b3b 100644 --- a/tests/testthat/module_examples/mappingDomain/app.R +++ b/tests/testthat/module_examples/mappingDomain/app.R @@ -2,19 +2,25 @@ library(shiny) library(safetyGraphics) library(dplyr) +meta <- rbind( + safetyCharts::meta_labs, + safetyCharts::meta_aes, + safetyCharts::meta_dm, + safetyCharts::meta_hepExplorer +) #reactlogReset() -measure_meta <- safetyGraphics::meta%>%filter(domain=="labs")%>%filter(col_key=="measure_col") +measure_meta <- meta%>%filter(domain=="labs")%>%filter(col_key=="measure_col") mm_default<-data.frame( text_key = c("measure_col", "measure_col--ALP"), current = c("PARAM","Alkaline Phosphatase (U/L)"), stringsAsFactors = FALSE ) -labs_default <- safetyGraphics::meta %>% +labs_default <- meta %>% filter(domain=="labs")%>% mutate(current=standard_sdtm)%>% select(text_key,current) -aes_default <- safetyGraphics::meta %>% +aes_default <- meta %>% filter(domain=="aes")%>% mutate(current=standard_sdtm)%>% select(text_key,current) @@ -35,16 +41,16 @@ ui <- tagList( mappingDomainUI("ex2",measure_meta,safetyData::adam_adlbc,mm_default), tableOutput("ex2Out"), h2("Example 3: AE Domain - no defaults"), - mappingDomainUI("ex3",safetyGraphics::meta%>%filter(domain=="aes"),safetyData::adam_adae), + mappingDomainUI("ex3", meta%>%filter(domain=="aes"),safetyData::adam_adae), tableOutput("ex3Out"), h2("Example 4: AE Domain - with defaults"), - mappingDomainUI("ex4",safetyGraphics::meta%>%filter(domain=="aes"),safetyData::adam_adae, aes_default), + mappingDomainUI("ex4", meta%>%filter(domain=="aes"),safetyData::adam_adae, aes_default), tableOutput("ex4Out"), h2("Example 5: Labs Domain - no defaults"), - mappingDomainUI("ex5",safetyGraphics::meta%>%filter(domain=="labs"),safetyData::adam_adlbc), + mappingDomainUI("ex5", meta%>%filter(domain=="labs"),safetyData::adam_adlbc), tableOutput("ex5Out"), h2("Example 6: Labs Domain - with defaults"), - mappingDomainUI("ex6",safetyGraphics::meta%>%filter(domain=="labs"),safetyData::adam_adlbc,labs_default), + mappingDomainUI("ex6", meta%>%filter(domain=="labs"),safetyData::adam_adlbc,labs_default), tableOutput("ex6Out"), ) ) @@ -57,19 +63,19 @@ server <- function(input,output,session){ exportTestValues(ex2_data = { ex2() }) output$ex2Out<-renderTable(ex2()) - ex3<-callModule(mappingDomain, "ex3", safetyGraphics::meta%>%filter(domain=="aes"), safetyData::adam_adae) + ex3<-callModule(mappingDomain, "ex3", meta%>%filter(domain=="aes"), safetyData::adam_adae) exportTestValues(ex3_data = { ex3() }) output$ex3Out<-renderTable(ex3()) - ex4<-callModule(mappingDomain, "ex4", safetyGraphics::meta%>%filter(domain=="aes"), safetyData::adam_adae) + ex4<-callModule(mappingDomain, "ex4", meta%>%filter(domain=="aes"), safetyData::adam_adae) exportTestValues(ex4_data = { ex4() }) output$ex4Out<-renderTable(ex4()) - ex5<-callModule(mappingDomain, "ex5", safetyGraphics::meta%>%filter(domain=="labs"), safetyData::adam_adlbc) + ex5<-callModule(mappingDomain, "ex5", meta%>%filter(domain=="labs"), safetyData::adam_adlbc) exportTestValues(ex5_data = { ex5() }) output$ex5Out<-renderTable(ex5()) - ex6<-callModule(mappingDomain, "ex6", safetyGraphics::meta%>%filter(domain=="labs"), labsafetyData::adam_adlbcs) + ex6<-callModule(mappingDomain, "ex6", meta%>%filter(domain=="labs"), labsafetyData::adam_adlbcs) exportTestValues(ex6_data = { ex6() }) output$ex6Out<-renderTable(ex6()) diff --git a/tests/testthat/module_examples/settingsMapping/app.R b/tests/testthat/module_examples/settingsMapping/app.R index a1f597ca..50669117 100644 --- a/tests/testthat/module_examples/settingsMapping/app.R +++ b/tests/testthat/module_examples/settingsMapping/app.R @@ -7,6 +7,13 @@ partialMapping <- data.frame( current=c("ID","myID","measure") ) +meta <- rbind( + safetyCharts::meta_labs, + safetyCharts::meta_aes, + safetyCharts::meta_dm, + safetyCharts::meta_hepExplorer +) + fullMapping<-read.csv('custom_mapping.csv') ui <- tagList( @@ -27,9 +34,9 @@ ui <- tagList( ) ) server <- function(input,output,session){ - callModule(settingsMapping, "NoMapping", metaIn = safetyGraphics::meta) - callModule(settingsMapping, "PartialMapping", metaIn = safetyGraphics::meta, mapping=reactive({partialMapping}) ) - callModule(settingsMapping, "FullMapping", metaIn = safetyGraphics::meta, mapping=reactive({fullMapping})) + callModule(settingsMapping, "NoMapping", metaIn = meta) + callModule(settingsMapping, "PartialMapping", metaIn = meta, mapping=reactive({partialMapping}) ) + callModule(settingsMapping, "FullMapping", metaIn = meta, mapping=reactive({fullMapping})) } shinyApp(ui, server) \ No newline at end of file diff --git a/tests/testthat/test_detectStandard.R b/tests/testthat/test_detectStandard.R index bef136cf..69e4224f 100644 --- a/tests/testthat/test_detectStandard.R +++ b/tests/testthat/test_detectStandard.R @@ -4,7 +4,7 @@ library(safetyData) library(stringr) test_that("a list with the expected properties and structure is returned",{ - a<- detectStandard(data.frame()) + a<- detectStandard(data.frame(),meta=safetyCharts::meta_labs) expect_is(a,"list") expect_named(a,c("details","standard","label","standard_percent")) @@ -18,45 +18,43 @@ test_that("a list with the expected properties and structure is returned",{ }) test_that("correct standards are identified",{ - expect_equal(detectStandard(data=safetyData::adam_adlbc,domain='labs')[["standard"]],"adam") - expect_equal(detectStandard(data=safetyData::adam_adlbc,domain='labs')[["details"]][["sdtm"]][["match"]], "partial") - expect_equal(detectStandard(data=safetyData::adam_adlbc,domain='labs')[["details"]][["adam"]][["match"]], "full") + expect_equal(detectStandard(data=safetyData::adam_adlbc,meta=safetyCharts::meta_labs,domain='labs')[["standard"]],"adam") + expect_equal(detectStandard(data=safetyData::adam_adlbc,meta=safetyCharts::meta_labs,domain='labs')[["details"]][["sdtm"]][["match"]], "partial") + expect_equal(detectStandard(data=safetyData::adam_adlbc,meta=safetyCharts::meta_labs,domain='labs')[["details"]][["adam"]][["match"]], "full") 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,PARAMCD="K") - expect_equal(detectStandard(data=adam_test_data, domain="labs")[["standard"]],"adam") - expect_equal(detectStandard(data=adam_test_data, domain="labs")[["details"]][["adam"]][["match"]], "full") - expect_equal(detectStandard(data=adam_test_data, domain="labs")[["details"]][["sdtm"]][["match"]], "partial") + expect_equal(detectStandard(data=adam_test_data, meta=safetyCharts::meta_labs, domain="labs")[["standard"]],"adam") + expect_equal(detectStandard(data=adam_test_data, meta=safetyCharts::meta_labs, domain="labs")[["details"]][["adam"]][["match"]], "full") + expect_equal(detectStandard(data=adam_test_data, meta=safetyCharts::meta_labs, domain="labs")[["details"]][["sdtm"]][["match"]], "partial") sdtm_params<-c("Alanine Aminotransferase","Aspartate Aminotransferase","Bilirubin","Alkaline Phosphatase") sdtm_test_data<-data.frame(USUBJID="001",LBSTRESN=10,LBTEST=sdtm_params,VISIT="Visit 1",VISITNUM=1,LBDY=0,LBSTNRLO=0,LBSTNRHI=20,LBSTRESU="K") - expect_equal(detectStandard(sdtm_test_data, domain="labs")[["standard"]],"sdtm") - expect_equal(detectStandard(sdtm_test_data, domain="labs")[["details"]][["sdtm"]][["match"]], "full") - expect_equal(detectStandard(sdtm_test_data, domain="labs")[["details"]][["adam"]][["match"]], "partial") + expect_equal(detectStandard(sdtm_test_data, meta=safetyCharts::meta_labs, domain="labs")[["standard"]],"sdtm") + expect_equal(detectStandard(sdtm_test_data, meta=safetyCharts::meta_labs, domain="labs")[["details"]][["sdtm"]][["match"]], "full") + expect_equal(detectStandard(sdtm_test_data, meta=safetyCharts::meta_labs, domain="labs")[["details"]][["adam"]][["match"]], "partial") 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, meta=safetyCharts::meta_labs)[["standard"]],"none") + expect_equal(detectStandard(empty_test_data, meta=safetyCharts::meta_labs)[["details"]][["adam"]][["match"]], "none") + expect_equal(detectStandard(empty_test_data, meta=safetyCharts::meta_labs)[["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,PARAMCD="K") - expect_equal(detectStandard(case_sensitive_test_data, domain="labs")[["standard"]],"adam") - expect_equal(detectStandard(case_sensitive_test_data, domain="labs")[["details"]][["adam"]][["match"]], "full") - expect_equal(detectStandard(case_sensitive_test_data, domain="labs")[["details"]][["sdtm"]][["match"]], "partial") + expect_equal(detectStandard(case_sensitive_test_data, meta=safetyCharts::meta_labs, domain="labs")[["standard"]],"adam") + expect_equal(detectStandard(case_sensitive_test_data, meta=safetyCharts::meta_labs, domain="labs")[["details"]][["adam"]][["match"]], "full") + expect_equal(detectStandard(case_sensitive_test_data, meta=safetyCharts::meta_labs, domain="labs")[["details"]][["sdtm"]][["match"]], "partial") #NOTE: adam takes precedence over sdtm sdtm_and_adam_test_data<-cbind(adam_test_data,sdtm_test_data) - expect_equal(detectStandard(sdtm_and_adam_test_data, domain="labs")[["standard"]],"adam") - expect_equal(detectStandard(sdtm_and_adam_test_data, domain="labs")[["details"]][["adam"]][["match"]], "full") - expect_equal(detectStandard(sdtm_and_adam_test_data, domain="labs")[["details"]][["sdtm"]][["match"]], "full") + expect_equal(detectStandard(sdtm_and_adam_test_data, meta=safetyCharts::meta_labs, domain="labs")[["standard"]],"adam") + expect_equal(detectStandard(sdtm_and_adam_test_data, meta=safetyCharts::meta_labs, domain="labs")[["details"]][["adam"]][["match"]], "full") + expect_equal(detectStandard(sdtm_and_adam_test_data, meta=safetyCharts::meta_labs, domain="labs")[["details"]][["sdtm"]][["match"]], "full") #NOTE: adam takes precedence over sdtm 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, domain="labs")[["standard"]],"adam") - expect_equal(detectStandard(sdtm_and_adam_partial_test_data, domain="labs")[["details"]][["adam"]][["match"]],"partial") - expect_equal(detectStandard(sdtm_and_adam_partial_test_data, domain="labs")[["details"]][["sdtm"]][["match"]],"partial") - - + expect_equal(detectStandard(sdtm_and_adam_partial_test_data, meta=safetyCharts::meta_labs, domain="labs")[["standard"]],"adam") + expect_equal(detectStandard(sdtm_and_adam_partial_test_data, meta=safetyCharts::meta_labs, domain="labs")[["details"]][["adam"]][["match"]],"partial") + expect_equal(detectStandard(sdtm_and_adam_partial_test_data, meta=safetyCharts::meta_labs, domain="labs")[["details"]][["sdtm"]][["match"]],"partial") }) diff --git a/tests/testthat/test_evaluateStandard.R b/tests/testthat/test_evaluateStandard.R index 5879a51e..a446b6ed 100644 --- a/tests/testthat/test_evaluateStandard.R +++ b/tests/testthat/test_evaluateStandard.R @@ -2,16 +2,15 @@ context("Tests for the evaluateStandard() function") library(safetyGraphics) test_that("basic test cases evaluate as expected",{ - expect_equal(evaluateStandard(data=safetyData::adam_adlbc, domain="labs", meta= meta, standard="sdtm")[["match"]],"partial") - expect_equal(evaluateStandard(data=safetyData::adam_adlbc, domain="labs", meta= meta, standard="adam")[["match"]],"full") - expect_equal(evaluateStandard(data=safetyData::adam_adae, domain="aes", meta= meta, standard="sdtm")[["match"]],"partial") - expect_equal(evaluateStandard(data=safetyData::adam_adae, domain="aes", meta= meta, standard="adam")[["match"]],"full") - expect_equal(evaluateStandard(data=data.frame(), domain="labs", meta= meta, standard="sdtm")[["match"]],"none") + expect_equal(evaluateStandard(data=safetyData::adam_adlbc, domain="labs", meta= safetyCharts::meta_labs, standard="sdtm")[["match"]],"partial") + expect_equal(evaluateStandard(data=safetyData::adam_adlbc, domain="labs", meta= safetyCharts::meta_labs, standard="adam")[["match"]],"full") + expect_equal(evaluateStandard(data=safetyData::adam_adae, domain="aes", meta= safetyCharts::meta_aes, standard="sdtm")[["match"]],"partial") + expect_equal(evaluateStandard(data=safetyData::adam_adae, domain="aes", meta= safetyCharts::meta_aes, standard="adam")[["match"]],"full") + expect_equal(evaluateStandard(data=data.frame(), domain="labs", meta= safetyCharts::meta_labs, standard="sdtm")[["match"]],"none") }) test_that("a list with the expected properties and structure is returned",{ - a<- evaluateStandard(data=data.frame(),domain="labs", meta=meta, standard="adam") - + a<- evaluateStandard(data=data.frame(),domain="labs", meta=safetyCharts::meta_labs, standard="adam") expect_is(a,"list") expect_named(a,c('standard', 'mapping', 'total_count','valid_count', 'invalid_count','match_percent', 'match',"label")) expect_is(a[["standard"]],"character") @@ -22,26 +21,25 @@ test_that("a list with the expected properties and structure is returned",{ }) test_that("expected number of checks (in)valid",{ - expect_equal(evaluateStandard(data=safetyData::adam_adlbc, domain="labs", meta=meta, standard="sdtm")[["valid_count"]],4) - expect_equal(evaluateStandard(data=safetyData::adam_adlbc, domain="labs", meta=meta, standard="sdtm")[["invalid_count"]],9) + expect_equal(evaluateStandard(data=safetyData::adam_adlbc, domain="labs", meta=safetyCharts::meta_labs, standard="sdtm")[["valid_count"]],4) + expect_equal(evaluateStandard(data=safetyData::adam_adlbc, domain="labs", meta=safetyCharts::meta_labs, standard="sdtm")[["invalid_count"]],5) labs_edit <- safetyData::adam_adlbc labs_edit$LBTEST <- labs_edit$PARAM - a<-evaluateStandard(data=labs_edit, domain="labs", meta=meta, standard="sdtm") + a<-evaluateStandard(data=labs_edit, domain="labs", meta=safetyCharts::meta_labs, standard="sdtm") expect_equal(a[["valid_count"]],5) - expect_equal(a[["invalid_count"]],8) - expect_equal(a[["total_count"]],13) - expect_equal(round(a[["match_percent"]],3), .385) + expect_equal(a[["invalid_count"]],4) + expect_equal(a[["total_count"]],9) + expect_equal(a[["match_percent"]], 5/9) expect_true(a[["mapping"]]%>%filter(text_key=="measure_col")%>%select(valid)%>%unlist) }) test_that("invalid options throw errors",{ - expect_error(evaluateStandard(data=list(a=1,b=2), domain="labs", meta=meta, standard="sdtm")) - expect_error(evaluateStandard(data="notadataframe",domain="labs", meta=meta, standard="sdtm")) - expect_error(evaluateStandard(data=safetyData::adam_adlbc,domain="labs", meta=meta, standard=123)) - expect_error(evaluateStandard(data=safetyData::adam_adlbc,domain="labs", meta=meta, standard="notarealstandard")) - expect_error(evaluateStandard(data=safetyData::adam_adlbc,domain="labs", meta=meta, standard="adam", includeFieldsIsNotAnOptionNow="yesPlease")) + expect_error(evaluateStandard(data=list(a=1,b=2), domain="labs", meta=safetyCharts::meta_labs, standard="sdtm")) + expect_error(evaluateStandard(data="notadataframe",domain="labs", meta=safetyCharts::meta_labs, standard="sdtm")) + expect_error(evaluateStandard(data=safetyData::adam_adlbc,domain="labs", meta=safetyCharts::meta_labs, standard="notarealstandard")) + expect_error(evaluateStandard(data=safetyData::adam_adlbc,domain="labs", meta=safetyCharts::meta_labs, standard="adam", includeFieldsIsNotAnOptionNow="yesPlease")) expect_error(evaluateStandard(data=safetyData::adam_adlbc,domain="labs", meta=list(), standard="sdtm")) expect_error(evaluateStandard(data=safetyData::adam_adlbc,domain="labs", meta=safetyData::adam_adlbc, standard="sdtm")) }) \ No newline at end of file diff --git a/tests/testthat/test_makeMapping.R b/tests/testthat/test_makeMapping.R index ada8b40d..c28d962a 100644 --- a/tests/testthat/test_makeMapping.R +++ b/tests/testthat/test_makeMapping.R @@ -9,15 +9,22 @@ testData<- list( dm=safetyData::adam_adsl ) +meta <- rbind( + safetyCharts::meta_labs, + safetyCharts::meta_aes, + safetyCharts::meta_dm, + safetyCharts::meta_hepExplorer +) + myCustomMapping<-list( aes = list(id_col='USUBJID', seq_col='MY_SEQ'), labs = list(id_col='customID') ) -ex1<-makeMapping(testData, safetyGraphics::meta, TRUE, NULL) -ex2<-makeMapping(testData, safetyGraphics::meta, FALSE, NULL) -ex3<-makeMapping(testData, safetyGraphics::meta, TRUE, myCustomMapping) -ex4<-makeMapping(testData, safetyGraphics::meta, FALSE, myCustomMapping) +ex1<-makeMapping(testData, meta, TRUE, NULL) +ex2<-makeMapping(testData, meta, FALSE, NULL) +ex3<-makeMapping(testData, meta, TRUE, myCustomMapping) +ex4<-makeMapping(testData, meta, FALSE, myCustomMapping) test_that("object with the correct properties is returned",{ expect_named(ex1, c("standard", "mapping")) @@ -77,7 +84,7 @@ test_that("customMapping overwrites autoMapping values",{ test_that("unique domains in customMapping are added",{ myCustomMapping2 <- myCustomMapping myCustomMapping2$customDomain <- list(id_col="customID", other_col="other") - ex5<-makeMapping(testData, safetyGraphics::meta, TRUE, myCustomMapping2) + ex5<-makeMapping(testData, meta, TRUE, myCustomMapping2) expect_equal(unique(ex5$mapping$domain), c("aes", "labs", "customDomain", "dm")) #2 rows added @@ -93,7 +100,7 @@ test_that("unique domains in customMapping are added",{ test_that("unique mapping values for existing domains in customMapping are added",{ myCustomMapping3 <- myCustomMapping myCustomMapping3$aes$other_col <- "other" - ex6<-makeMapping(testData, safetyGraphics::meta, TRUE, myCustomMapping3) + ex6<-makeMapping(testData, meta, TRUE, myCustomMapping3) #1 row added expect_equal(nrow(ex6$mapping), nrow(ex1$mapping)+1) @@ -106,7 +113,7 @@ test_that("nested values in custom mapping work as expected",{ myCustomMapping4$labs$measure_values$ALT <- "AnotherAlt" myCustomMapping4$labs$measure_values$OTHER <- "Other" myCustomMapping4$aes$fake_values <- list(other1="Other1", other2="other2") - ex7<-makeMapping(testData, safetyGraphics::meta, TRUE, myCustomMapping4) + ex7<-makeMapping(testData, meta, TRUE, myCustomMapping4) #1 row added expect_equal(nrow(ex7$mapping), nrow(ex1$mapping)+3) diff --git a/tests/testthat/test_mod_mappingColumn.R b/tests/testthat/test_mod_mappingColumn.R index c41612d7..5f8eb487 100644 --- a/tests/testthat/test_mod_mappingColumn.R +++ b/tests/testthat/test_mod_mappingColumn.R @@ -8,6 +8,13 @@ skip_on_cran() app <- ShinyDriver$new("./module_examples/mappingColumn") initial<-app$getAllValues() +meta <- rbind( + safetyCharts::meta_labs, + safetyCharts::meta_aes, + safetyCharts::meta_dm, + safetyCharts::meta_hepExplorer +) + test_that("UI function stops with invalid inputs (non-data.frame)",{ skip_on_cran() id_meta <- meta%>%filter(domain=="labs")%>%filter(col_key=="id_col") diff --git a/tests/testthat/test_mod_mappingDomain.R b/tests/testthat/test_mod_mappingDomain.R index 51d9eeb2..01c94519 100644 --- a/tests/testthat/test_mod_mappingDomain.R +++ b/tests/testthat/test_mod_mappingDomain.R @@ -6,13 +6,20 @@ library(testthat) library(stringr) library(dplyr) +meta <- rbind( + safetyCharts::meta_labs, + safetyCharts::meta_aes, + safetyCharts::meta_dm, + safetyCharts::meta_hepExplorer +) + skip_on_cran() app <- ShinyDriver$new("./module_examples/mappingDomain") initial<-app$getAllValues() test_that("UI function stops with invalid inputs (non-data.frame)",{ skip_on_cran() - id_meta <- safetyGraphics::meta%>%filter(domain=="labs")%>%filter(col_key=="id_col") + id_meta <- meta%>%filter(domain=="labs")%>%filter(col_key=="id_col") id_mapping_list<-list(id_col="USUBJID") expect_error(mappingDomainUI("test1.1", list(id_col="USUBJID"), safetyData::adam_adlbc)) #invalid metadata expect_error(mappingDomainUI("test1.2", id_meta, "invalid_data_option")) #invalid data @@ -24,10 +31,10 @@ test_that("the correct number of inputs are created (1 per field/column)",{ inputs <- names(initial$input) expect_length(str_subset(inputs,"ex1"),5) expect_length(str_subset(inputs,"ex2"),5) - expect_length(str_subset(inputs,"ex3"),nrow(safetyGraphics::meta %>% filter(domain=="aes"))) - expect_length(str_subset(inputs,"ex4"),nrow(safetyGraphics::meta %>% filter(domain=="aes"))) - expect_length(str_subset(inputs,"ex5"),nrow(safetyGraphics::meta %>% filter(domain=="labs"))) - expect_length(str_subset(inputs,"ex6"),nrow(safetyGraphics::meta %>% filter(domain=="labs"))) + expect_length(str_subset(inputs,"ex3"),nrow( meta %>% filter(domain=="aes"))) + expect_length(str_subset(inputs,"ex4"),nrow( meta %>% filter(domain=="aes"))) + expect_length(str_subset(inputs,"ex5"),nrow( meta %>% filter(domain=="labs"))) + expect_length(str_subset(inputs,"ex6"),nrow( meta %>% filter(domain=="labs"))) }) test_that("output are data frames with the have expected values",{ @@ -41,10 +48,10 @@ test_that("output are data frames with the have expected values",{ #all exported values have the correct number of rows expect_equal(nrow(initial$export$ex1_data),5) expect_equal(nrow(initial$export$ex2_data),5) - expect_equal(nrow(initial$export$ex3_data),nrow(safetyGraphics::meta %>% filter(domain=="aes"))) - expect_equal(nrow(initial$export$ex4_data),nrow(safetyGraphics::meta %>% filter(domain=="aes"))) - expect_equal(nrow(initial$export$ex5_data),nrow(safetyGraphics::meta %>% filter(domain=="labs"))) - expect_equal(nrow(initial$export$ex6_data),nrow(safetyGraphics::meta %>% filter(domain=="labs"))) + expect_equal(nrow(initial$export$ex3_data),nrow( meta %>% filter(domain=="aes"))) + expect_equal(nrow(initial$export$ex4_data),nrow( meta %>% filter(domain=="aes"))) + expect_equal(nrow(initial$export$ex5_data),nrow( meta %>% filter(domain=="labs"))) + expect_equal(nrow(initial$export$ex6_data),nrow( meta %>% filter(domain=="labs"))) }) From e1c403856d50e93183e718dba79b1a5093d7e094 Mon Sep 17 00:00:00 2001 From: Jeremy Wildfire Date: Mon, 28 Feb 2022 10:19:09 -0500 Subject: [PATCH 13/19] update test apps --- tests/testthat/module_examples/filterTab/app.R | 8 ++++++++ tests/testthat/module_examples/mapping/app.R | 9 +++++++++ tests/testthat/module_examples/mappingColumn/app.R | 8 ++++++++ 3 files changed, 25 insertions(+) diff --git a/tests/testthat/module_examples/filterTab/app.R b/tests/testthat/module_examples/filterTab/app.R index 4bba9255..63f5575f 100644 --- a/tests/testthat/module_examples/filterTab/app.R +++ b/tests/testthat/module_examples/filterTab/app.R @@ -5,6 +5,14 @@ library(safetyGraphics) #reactlogReset() +meta <- rbind( + safetyCharts::meta_labs, + safetyCharts::meta_aes, + safetyCharts::meta_dm, + safetyCharts::meta_hepExplorer +) + + ui <- tagList( shinyjs::useShinyjs(), tags$head( diff --git a/tests/testthat/module_examples/mapping/app.R b/tests/testthat/module_examples/mapping/app.R index 743853bc..188aa6af 100644 --- a/tests/testthat/module_examples/mapping/app.R +++ b/tests/testthat/module_examples/mapping/app.R @@ -2,6 +2,15 @@ library(shiny) library(safetyGraphics) library(dplyr) + +meta <- rbind( + safetyCharts::meta_labs, + safetyCharts::meta_aes, + safetyCharts::meta_dm, + safetyCharts::meta_hepExplorer +) + + #reactlogReset() allData <- list(labs=safetyData::adam_adlbc, aes=safetyData::adam_adae) labs_default <- meta %>% diff --git a/tests/testthat/module_examples/mappingColumn/app.R b/tests/testthat/module_examples/mappingColumn/app.R index 86c813e1..c4f58159 100644 --- a/tests/testthat/module_examples/mappingColumn/app.R +++ b/tests/testthat/module_examples/mappingColumn/app.R @@ -4,6 +4,14 @@ library(dplyr) reactlogReset() +meta <- rbind( + safetyCharts::meta_labs, + safetyCharts::meta_aes, + safetyCharts::meta_dm, + safetyCharts::meta_hepExplorer +) + + id_meta <- meta%>%filter(domain=="labs")%>%filter(col_key=="id_col") measure_meta <- meta%>%filter(domain=="labs")%>%filter(col_key=="measure_col") id_default<-data.frame( From 29cae989158b9c2701d249bee9e69c65b98dab74 Mon Sep 17 00:00:00 2001 From: Jeremy Wildfire Date: Mon, 28 Feb 2022 10:39:59 -0500 Subject: [PATCH 14/19] return placeholder object for evaluation of data when no defaults are provided for a given standard --- R/evaluateStandard.R | 45 +++++++++++++++++++++++++++----------------- 1 file changed, 28 insertions(+), 17 deletions(-) diff --git a/R/evaluateStandard.R b/R/evaluateStandard.R index 97679604..55c8a128 100644 --- a/R/evaluateStandard.R +++ b/R/evaluateStandard.R @@ -74,32 +74,43 @@ evaluateStandard <- function(data, meta, domain, standard){ )%>% select(.data$text_key, .data$current, .data$valid) - stopifnot(nrow(compare_summary[["mapping"]])>0) - - # count valid/invalid data elements - compare_summary[["total_count"]] <- compare_summary[["mapping"]] %>% nrow() - compare_summary[["valid_count"]] <- compare_summary[["mapping"]] %>% filter(.data$valid) %>% nrow() - compare_summary[["invalid_count"]] <- compare_summary[["mapping"]] %>% filter(!.data$valid) %>% nrow() - compare_summary[["match_percent"]] <- compare_summary[["valid_count"]] / compare_summary[["total_count"]] - - standard_formatted <- standard + standard_formatted <- standard if(standard=="adam"){ standard_formatted = "ADaM" }else if(standard=="sdtm"){ standard_formatted="SDTM" } - if (compare_summary[["invalid_count"]]==0) { - compare_summary[["match"]] <- "full" - compare_summary[["label"]] <- standard_formatted - } else if(compare_summary[["valid_count"]]>0) { - compare_summary[["match"]] <- "partial" - compare_summary[["label"]] <- paste0("Partial ",standard_formatted) - compare_summary[["details"]]<-paste0("(", compare_summary[["valid_count"]], "/" ,compare_summary[["total_count"]], " cols/fields matched)") - } else { + if(nrow(compare_summary[["mapping"]])>0){ + # count valid/invalid data elements + compare_summary[["total_count"]] <- compare_summary[["mapping"]] %>% nrow() + compare_summary[["valid_count"]] <- compare_summary[["mapping"]] %>% filter(.data$valid) %>% nrow() + compare_summary[["invalid_count"]] <- compare_summary[["mapping"]] %>% 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[["label"]] <- standard_formatted + } else if(compare_summary[["valid_count"]]>0) { + compare_summary[["match"]] <- "partial" + compare_summary[["label"]] <- paste0("Partial ",standard_formatted) + compare_summary[["details"]]<-paste0("(", compare_summary[["valid_count"]], "/" ,compare_summary[["total_count"]], " cols/fields matched)") + } else { + compare_summary[["match"]] <- "none" + compare_summary[["label"]] <- "No Match" + } + }else{ + # No values provided for standard in this domain + compare_summary[["total_count"]] <- 0 + compare_summary[["valid_count"]] <- NA + compare_summary[["invalid_count"]] <- NA + compare_summary[["match_percent"]] <- 0 compare_summary[["match"]] <- "none" compare_summary[["label"]] <- "No Match" } + + + return(compare_summary) } \ No newline at end of file From 7c1e52cc3b47f976cfd263542d9f7b3174abd9ba Mon Sep 17 00:00:00 2001 From: jwildfire Date: Sat, 19 Mar 2022 06:04:35 -0400 Subject: [PATCH 15/19] Update R/makeMeta.R Co-authored-by: Eli Miller --- R/makeMeta.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/makeMeta.R b/R/makeMeta.R index 0cb5effc..bebe067d 100644 --- a/R/makeMeta.R +++ b/R/makeMeta.R @@ -1,6 +1,6 @@ #' Create a metadata object table for a set of charts #' -#' Generates metadata object for a list charts. makeMeta() looks in chart$package namespace for files called meta_{chart$name} and meta_{chart$domain} for all charts, and then stacks all files. If duplicate metadata rows (domain + text_key) are found an error is thrown. +#' Generates metadata object for a list of charts. makeMeta() looks in chart$package namespace for files called meta_{chart$name} and meta_{chart$domain} for all charts, and then stacks all files. If duplicate metadata rows (domain + text_key) are found an error is thrown. #' #' @param charts list of safetyGraphics chart objects for which to create metadata #' From aeff1b7b947340276f00e083f075d5a201534d03 Mon Sep 17 00:00:00 2001 From: jwildfire Date: Sat, 19 Mar 2022 06:04:45 -0400 Subject: [PATCH 16/19] Update DESCRIPTION Co-authored-by: Eli Miller --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 7f6b463c..af322d79 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -44,7 +44,7 @@ Imports: shinyjs (>= 2.0.0), sortable (>= 0.4.4), stringr (>= 1.4.0), - tidyr, + tidyr (>= 1.2.0), yaml (>= 2.2.1) VignetteBuilder: knitr Roxygen: list(markdown = TRUE) From 691a3bb9a4cbe6a9c7ad5609c52e37a2dad8c623 Mon Sep 17 00:00:00 2001 From: jwildfire Date: Sat, 19 Mar 2022 06:05:23 -0400 Subject: [PATCH 17/19] Update tests/testthat/module_examples/chartsTab/app.R Co-authored-by: Eli Miller --- tests/testthat/module_examples/chartsTab/app.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/module_examples/chartsTab/app.R b/tests/testthat/module_examples/chartsTab/app.R index 7dbafec6..b7feeeec 100644 --- a/tests/testthat/module_examples/chartsTab/app.R +++ b/tests/testthat/module_examples/chartsTab/app.R @@ -15,7 +15,7 @@ domainData <- list( ) -meta <- meta <- rbind( +meta <- rbind( safetyCharts::meta_labs, safetyCharts::meta_aes, safetyCharts::meta_dm, From b477a0037e676aab14f0338b814c9ebed4eb2e0a Mon Sep 17 00:00:00 2001 From: Jeremy Wildfire Date: Sat, 19 Mar 2022 06:13:27 -0400 Subject: [PATCH 18/19] update docs --- man/makeMeta.Rd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/man/makeMeta.Rd b/man/makeMeta.Rd index c6301bcf..e88bf660 100644 --- a/man/makeMeta.Rd +++ b/man/makeMeta.Rd @@ -25,5 +25,5 @@ tibble of metadata with the following columns: } } \description{ -Generates metadata object for a list charts. makeMeta() looks in chart$package namespace for files called meta_{chart$name} and meta_{chart$domain} for all charts, and then stacks all files. If duplicate metadata rows (domain + text_key) are found an error is thrown. +Generates metadata object for a list of charts. makeMeta() looks in chart$package namespace for files called meta_{chart$name} and meta_{chart$domain} for all charts, and then stacks all files. If duplicate metadata rows (domain + text_key) are found an error is thrown. } From d98b86480a6a9c68a3ee5b126e1955280372f292 Mon Sep 17 00:00:00 2001 From: Jeremy Wildfire Date: Sat, 19 Mar 2022 06:53:14 -0400 Subject: [PATCH 19/19] update docs --- R/makeMeta.R | 6 +++++- man/makeMeta.Rd | 8 +++++++- 2 files changed, 12 insertions(+), 2 deletions(-) diff --git a/R/makeMeta.R b/R/makeMeta.R index bebe067d..d26e9a82 100644 --- a/R/makeMeta.R +++ b/R/makeMeta.R @@ -1,6 +1,10 @@ #' Create a metadata object table for a set of charts #' -#' Generates metadata object for a list of charts. makeMeta() looks in chart$package namespace for files called meta_{chart$name} and meta_{chart$domain} for all charts, and then stacks all files. If duplicate metadata rows (domain + text_key) are found an error is thrown. +#' Generates metadata object for a list of charts. `makeMeta()` looks for metadata in 3 locations for each `chart` object: +#' - Domain-level metadata saved as meta_{chart$name} in the chart$package namespace +#' - Chart-specific metadata saved as meta_{chart$domain} in the chart$package namespace +#' - Chart-specific metadata saved directly to the chart object as chart$meta +#' After checking all charts, all metadata files are stacked in to a single dataframe and returned. If duplicate metadata rows (domain + text_key) are found, an error is thrown. #' #' @param charts list of safetyGraphics chart objects for which to create metadata #' diff --git a/man/makeMeta.Rd b/man/makeMeta.Rd index e88bf660..60050fa2 100644 --- a/man/makeMeta.Rd +++ b/man/makeMeta.Rd @@ -25,5 +25,11 @@ tibble of metadata with the following columns: } } \description{ -Generates metadata object for a list of charts. makeMeta() looks in chart$package namespace for files called meta_{chart$name} and meta_{chart$domain} for all charts, and then stacks all files. If duplicate metadata rows (domain + text_key) are found an error is thrown. +Generates metadata object for a list of charts. \code{makeMeta()} looks for metadata in 3 locations for each \code{chart} object: +\itemize{ +\item Domain-level metadata saved as meta_{chart$name} in the chart$package namespace +\item Chart-specific metadata saved as meta_{chart$domain} in the chart$package namespace +\item Chart-specific metadata saved directly to the chart object as chart$meta +After checking all charts, all metadata files are stacked in to a single dataframe and returned. If duplicate metadata rows (domain + text_key) are found, an error is thrown. +} }