From 5ea401a464fb13438ebed11621c33e404d45d3a4 Mon Sep 17 00:00:00 2001 From: Matt Roumaya Date: Fri, 3 Jun 2022 14:45:26 +0000 Subject: [PATCH 01/87] fix table --- R/Study_AssessmentReport.R | 104 ++++++++++++++--------------------- R/util-ReportHelpers.R | 6 +- R/util-RunAssessment.R | 4 +- inst/report/studySummary.rmd | 2 +- 4 files changed, 48 insertions(+), 68 deletions(-) diff --git a/R/Study_AssessmentReport.R b/R/Study_AssessmentReport.R index c94cc1966..06bc3f795 100644 --- a/R/Study_AssessmentReport.R +++ b/R/Study_AssessmentReport.R @@ -20,73 +20,48 @@ #' @export Study_AssessmentReport <- function(lAssessments, bViewReport = FALSE) { - allChecks <- names(lAssessments) %>% - map(function(assessment_name) { - assessment <- lAssessments[[assessment_name]] - assessment_checks <- names(assessment$checks) %>% - map(function(domain_name) { - domain <- assessment$checks[[domain_name]] - - domain_check <- tibble( - assessment = assessment_name, - step = domain_name - ) - - domain_details <- names(domain)[names(domain) != "status"] %>% - map(function(test_name) { - check <- domain[[test_name]][["status"]] - details <- domain[[test_name]][["tests_if"]] %>% - bind_rows(.id = "names") %>% - mutate(status = ifelse(is.na(warning), NA_character_, warning)) %>% - select(-warning) %>% - t() %>% - as_tibble(.name_repair = "minimal") %>% - janitor::row_to_names(1) - - - return( - bind_cols( - tibble( - assessment = assessment_name, - step = domain_name, - check = check, - domain = test_name - ), - details - ) - ) - }) %>% - bind_rows() %>% - suppressMessages() - - return(left_join(domain_check, domain_details, by = c("assessment", "step"))) - }) - - return(bind_rows(assessment_checks)) - }) %>% - bind_rows() - - workflow <- map(lAssessments, ~ .x %>% pluck("workflow")) %>% - map(function(workflow) { - step <- map(workflow, ~ .x %>% pluck("name")) %>% - enframe() %>% - unnest(cols = .data$value) %>% - rename("step" = .data$value) - - domain <- map(workflow, ~ .x %>% pluck("inputs")) %>% - enframe() %>% - unnest(cols = .data$value) %>% - rename("domain" = .data$value) - - left_join(domain, step, by = "name") %>% - select(-.data$name) + + allChecks <- map(names(lAssessments), function(assessment){ + + workflow <- map_df(lAssessments[[assessment]][['workflow']], + ~bind_cols(step = .x[['name']], domain = .x[['inputs']])) %>% + mutate(assessment = assessment, + index = as.character(row_number())) + + allChecks <- map(lAssessments[[assessment]][['checks']], function(step){ + + domains <- names(step[names(step) != 'status']) + + + map(domains, function(test){ + domain <- test + status <- step[[domain]][['status']] + step[[domain]][['tests_if']] %>% + bind_rows(.id = "names") %>% + mutate(status = ifelse(is.na(warning), NA_character_, warning)) %>% + select(-warning) %>% + t() %>% + as_tibble(.name_repair = "minimal") %>% + janitor::row_to_names(1) %>% + mutate(domain = domain, + status = status) %>% + select(domain, everything()) + }) + }) %>% - bind_rows(.id = "assessment") + bind_rows(.id = 'index') + + left_join(workflow, allChecks, by = c("index", "domain")) - allChecks <- left_join(workflow, allChecks, by = c("assessment", "domain", "step")) + + }) %>% + bind_rows() %>% + select(assessment, step, check = status, domain, everything(), -index) %>% + suppressWarnings() found_data <- map(names(lAssessments), ~ lAssessments[[.x]][["lData"]]) %>% flatten() %>% + discard(~'logical' %in% class(.)) %>% names() %>% unique() @@ -108,7 +83,9 @@ Study_AssessmentReport <- function(lAssessments, bViewReport = FALSE) { apply(allChecks[6:length(allChecks)], 1, function(x) paste(x[!is.na(x)], collapse = "
")), .data$notes ), - check = ifelse(is.na(.data$check), 3, .data$check), + check = case_when(.data$check == TRUE ~ 1, + .data$check == FALSE ~ 2, + is.na(.data$check) ~ 3), notes = ifelse(check == 3, "Check not run.", .data$notes) ) @@ -116,6 +93,7 @@ Study_AssessmentReport <- function(lAssessments, bViewReport = FALSE) { mutate(check = map(.data$check, rank_chg)) %>% select(.data$assessment, .data$step, .data$check, .data$domain, .data$notes) + if (!bViewReport) { return(list(dfAllChecks = allChecks, dfSummary = dfSummary)) } else { diff --git a/R/util-ReportHelpers.R b/R/util-ReportHelpers.R index 9965a4e50..820b987b6 100644 --- a/R/util-ReportHelpers.R +++ b/R/util-ReportHelpers.R @@ -8,13 +8,13 @@ #' @export rank_chg <- function(status) { - if (status == TRUE) { + if (status == 1) { logo_out <- fontawesome::fa("check-circle", fill = "green") } - if (status == FALSE) { + if (status == 2) { logo_out <- fontawesome::fa("times-circle", fill = "red") } - if (!status %in% c(TRUE, FALSE)) { + if (status == 3) { logo_out <- fontawesome::fa("minus-circle", fill = "#EED202") } gt::html(as.character(logo_out)) diff --git a/R/util-RunAssessment.R b/R/util-RunAssessment.R index 76b9f129b..cbf57a326 100644 --- a/R/util-RunAssessment.R +++ b/R/util-RunAssessment.R @@ -54,7 +54,8 @@ RunAssessment <- function(lAssessment, lData, lMapping, lTags = NULL, bQuiet = F bQuiet = bQuiet ) - lAssessment$checks[[step$name]] <- result$lChecks + lAssessment$checks[[stepCount]] <- result$lChecks + names(lAssessment$checks)[[stepCount]] <- step$name lAssessment$bStatus <- result$lChecks$status if (result$lChecks$status) { cli::cli_alert_success("{.fn {step$name}} Successful") @@ -76,5 +77,6 @@ RunAssessment <- function(lAssessment, lData, lMapping, lTags = NULL, bQuiet = F stepCount <- stepCount + 1 } + return(lAssessment) } diff --git a/inst/report/studySummary.rmd b/inst/report/studySummary.rmd index d722df5fb..9dc7aad06 100644 --- a/inst/report/studySummary.rmd +++ b/inst/report/studySummary.rmd @@ -191,7 +191,7 @@ AssessmentReport$dfSummary %>% ## Issue List ```{r, results='asis', echo = FALSE, message=FALSE, warning = FALSE} AssessmentReport$dfAllChecks %>% - filter(check==F) %>% + filter(check > 1) %>% mutate(check = map(check, rank_chg), across(where(is.character), ~replace_na(., ""))) %>% gt::gt() %>% From b1e901a8c478302896932e22ca0f2be83e7ca7e5 Mon Sep 17 00:00:00 2001 From: Matt Roumaya Date: Fri, 3 Jun 2022 15:06:06 +0000 Subject: [PATCH 02/87] add .data --- R/Study_AssessmentReport.R | 58 ++++++++++++++++++-------------------- 1 file changed, 28 insertions(+), 30 deletions(-) diff --git a/R/Study_AssessmentReport.R b/R/Study_AssessmentReport.R index 06bc3f795..20489377c 100644 --- a/R/Study_AssessmentReport.R +++ b/R/Study_AssessmentReport.R @@ -21,34 +21,33 @@ Study_AssessmentReport <- function(lAssessments, bViewReport = FALSE) { - allChecks <- map(names(lAssessments), function(assessment){ - - workflow <- map_df(lAssessments[[assessment]][['workflow']], - ~bind_cols(step = .x[['name']], domain = .x[['inputs']])) %>% - mutate(assessment = assessment, - index = as.character(row_number())) - - allChecks <- map(lAssessments[[assessment]][['checks']], function(step){ - - domains <- names(step[names(step) != 'status']) - - - map(domains, function(test){ - domain <- test - status <- step[[domain]][['status']] - step[[domain]][['tests_if']] %>% - bind_rows(.id = "names") %>% - mutate(status = ifelse(is.na(warning), NA_character_, warning)) %>% - select(-warning) %>% - t() %>% - as_tibble(.name_repair = "minimal") %>% - janitor::row_to_names(1) %>% - mutate(domain = domain, - status = status) %>% - select(domain, everything()) - }) - - }) %>% + allChecks <- map(names(lAssessments), function(assessment) { + + workflow <- map_df(lAssessments[[assessment]][['workflow']], ~ bind_cols(step = .x[['name']], domain = .x[['inputs']])) %>% + mutate( + assessment = assessment, + index = as.character(row_number()) + ) + + allChecks <- map(lAssessments[[assessment]][['checks']], function(step) { + domains <- names(step[names(step) != 'status']) + + map(domains, function(test) { + domain <- test + status <- step[[domain]][['status']] + step[[domain]][['tests_if']] %>% + bind_rows(.id = "names") %>% + mutate(status = ifelse(is.na(.data$warning), NA_character_, .data$warning)) %>% + select(-.data$warning) %>% + t() %>% + as_tibble(.name_repair = "minimal") %>% + janitor::row_to_names(1) %>% + mutate(domain = domain, + status = status) %>% + select(.data$domain, everything()) + }) + + }) %>% bind_rows(.id = 'index') left_join(workflow, allChecks, by = c("index", "domain")) @@ -56,7 +55,7 @@ Study_AssessmentReport <- function(lAssessments, bViewReport = FALSE) { }) %>% bind_rows() %>% - select(assessment, step, check = status, domain, everything(), -index) %>% + select(.data$assessment, .data$step, check = .data$status, .data$domain, everything(),-.data$index) %>% suppressWarnings() found_data <- map(names(lAssessments), ~ lAssessments[[.x]][["lData"]]) %>% @@ -93,7 +92,6 @@ Study_AssessmentReport <- function(lAssessments, bViewReport = FALSE) { mutate(check = map(.data$check, rank_chg)) %>% select(.data$assessment, .data$step, .data$check, .data$domain, .data$notes) - if (!bViewReport) { return(list(dfAllChecks = allChecks, dfSummary = dfSummary)) } else { From e2ac02f8b63733372b4a0ccb77d19f92e2e803c4 Mon Sep 17 00:00:00 2001 From: Li Ge Date: Fri, 3 Jun 2022 08:57:54 -0700 Subject: [PATCH 03/87] fix #472 --- R/Study_Report.R | 6 +++--- vignettes/Cookbook.Rmd | 4 ++-- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/R/Study_Report.R b/R/Study_Report.R index 04c7dcda8..ebdd8a078 100644 --- a/R/Study_Report.R +++ b/R/Study_Report.R @@ -2,7 +2,7 @@ #' #' Pulls needed study data and runs one or more assessments #' -#' @param strAssessments character vector listing assessments +#' @param lAssessments character vector listing assessments #' @param lMeta list of metadata related to study #' @param strOutpath path to safe the report #' @@ -16,7 +16,7 @@ #' #' @export -Study_Report <- function(strAssessments, lMeta = list(Project = "My Project"), strOutpath = NULL) { +Study_Report <- function(lAssessments, lMeta = list(Project = "My Project"), strOutpath = NULL) { if (is.null(strOutpath)) strOutpath <- paste0(getwd(), "/gsm_report.html") if (!hasName(lMeta, "Project")) lMeta$Project <- "My Project" projectTemplate <- system.file("report", "studySummary.rmd", package = "gsm") @@ -24,7 +24,7 @@ Study_Report <- function(strAssessments, lMeta = list(Project = "My Project"), s projectTemplate, output_file = strOutpath, params = list( - assessments = strAssessments, + assessments = lAssessments, meta = lMeta ), envir = new.env(parent = globalenv()) ## eval in child of global env diff --git a/vignettes/Cookbook.Rmd b/vignettes/Cookbook.Rmd index f41127182..49d691767 100644 --- a/vignettes/Cookbook.Rmd +++ b/vignettes/Cookbook.Rmd @@ -235,7 +235,7 @@ library(clindata) multiple_assessments <- Study_Assess() -Study_Report(strAssessments = multiple_assessments, lMeta = list(label = "My Study")) +Study_Report(lAssessments = multiple_assessments, lMeta = list(label = "My Study")) ``` The report will render and be saved to your current working directory. You can optionally set an output directory using the `strOutpath` parameter. @@ -398,4 +398,4 @@ lMappingCustom$dfCONSENT$strTypeVal <- "MAINCONSENT" # 7. run the Study_Assess workflow customStudy <- Study_Assess(lMapping = lMappingCustom, lAssessments = lAssessmentsCustom) -``` \ No newline at end of file +``` From b72cdea32367cb3f7fec8d1cde60b090af7ba569 Mon Sep 17 00:00:00 2001 From: Nathan Kosiba Date: Fri, 3 Jun 2022 16:14:27 +0000 Subject: [PATCH 04/87] update pkgdown workflow trigger --- .github/workflows/pkgdown.yaml | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml index 509cc7602..b44fe7382 100644 --- a/.github/workflows/pkgdown.yaml +++ b/.github/workflows/pkgdown.yaml @@ -1,6 +1,7 @@ on: - release: - types: [published] + push: + branches: + - main name: pkgdown From ccbf0e5e3c4681d391b6c3184e8ad271c6fb6e07 Mon Sep 17 00:00:00 2001 From: Li Ge Date: Fri, 3 Jun 2022 09:54:36 -0700 Subject: [PATCH 05/87] fix #472 update docs --- DESCRIPTION | 2 +- R/Study_Report.R | 2 +- man/Study_Report.Rd | 6 +++--- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index b4451053b..cb062fff1 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -48,6 +48,6 @@ Suggests: pkgdown LazyData: true Roxygen: list(markdown = TRUE) -RoxygenNote: 7.1.2 +RoxygenNote: 7.2.0 Config/testthat/edition: 3 VignetteBuilder: knitr diff --git a/R/Study_Report.R b/R/Study_Report.R index ebdd8a078..a26dad55a 100644 --- a/R/Study_Report.R +++ b/R/Study_Report.R @@ -4,7 +4,7 @@ #' #' @param lAssessments character vector listing assessments #' @param lMeta list of metadata related to study -#' @param strOutpath path to safe the report +#' @param strOutpath path to save the report #' #' @return HTML report of study data. #' diff --git a/man/Study_Report.Rd b/man/Study_Report.Rd index 5317aea85..faf30d7d1 100644 --- a/man/Study_Report.Rd +++ b/man/Study_Report.Rd @@ -5,17 +5,17 @@ \title{Study Report} \usage{ Study_Report( - strAssessments, + lAssessments, lMeta = list(Project = "My Project"), strOutpath = NULL ) } \arguments{ -\item{strAssessments}{character vector listing assessments} +\item{lAssessments}{character vector listing assessments} \item{lMeta}{list of metadata related to study} -\item{strOutpath}{path to safe the report} +\item{strOutpath}{path to save the report} } \value{ HTML report of study data. From 0ba049c72166d982bca12fbd5091d34bc9c43ba5 Mon Sep 17 00:00:00 2001 From: Matt Roumaya Date: Fri, 3 Jun 2022 20:22:36 +0000 Subject: [PATCH 06/87] add unit tests + add .data where missing --- R/Analyze_Poisson_PredictBounds.R | 4 +-- R/Analyze_Wilcoxon.R | 2 +- R/Study_AssessmentReport.R | 2 +- R/util-parse_data_mapping.R | 4 +-- tests/testthat/test_Study_AssessmentReport.R | 31 ++++++++++++++++ tests/testthat/test_util-runAssessment.R | 37 ++++++++++++++++++++ 6 files changed, 74 insertions(+), 6 deletions(-) diff --git a/R/Analyze_Poisson_PredictBounds.R b/R/Analyze_Poisson_PredictBounds.R index 96f899abf..e3045a093 100644 --- a/R/Analyze_Poisson_PredictBounds.R +++ b/R/Analyze_Poisson_PredictBounds.R @@ -68,11 +68,11 @@ Analyze_Poisson_PredictBounds <- function(dfTransformed, vThreshold = c(-5, 5), # Calculate lower bound of expected event count given specified threshold. vLo = vThreshold[1]^2 - 2 * .data$vMu, - vWLo = vLo / (2 * exp(1) * .data$vMu), + vWLo = .data$vLo / (2 * exp(1) * .data$vMu), # Calculate upper bound of expected event count given specified threshold. vHi = vThreshold[2]^2 - 2 * .data$vMu, - vWHi = vHi / (2 * exp(1) * .data$vMu) + vWHi = .data$vHi / (2 * exp(1) * .data$vMu) ) # {lamW} is required to run this code block. diff --git a/R/Analyze_Wilcoxon.R b/R/Analyze_Wilcoxon.R index 8dc609e7a..8598a8716 100644 --- a/R/Analyze_Wilcoxon.R +++ b/R/Analyze_Wilcoxon.R @@ -125,6 +125,6 @@ Analyze_Wilcoxon <- function( return( dfAnalyzed %>% - select(names(dfTransformed), Estimate, PValue) + select(names(dfTransformed), .data$Estimate, .data$PValue) ) } diff --git a/R/Study_AssessmentReport.R b/R/Study_AssessmentReport.R index 20489377c..d611161ca 100644 --- a/R/Study_AssessmentReport.R +++ b/R/Study_AssessmentReport.R @@ -85,7 +85,7 @@ Study_AssessmentReport <- function(lAssessments, bViewReport = FALSE) { check = case_when(.data$check == TRUE ~ 1, .data$check == FALSE ~ 2, is.na(.data$check) ~ 3), - notes = ifelse(check == 3, "Check not run.", .data$notes) + notes = ifelse(.data$check == 3, "Check not run.", .data$notes) ) dfSummary <- allChecks %>% diff --git a/R/util-parse_data_mapping.R b/R/util-parse_data_mapping.R index cac40426f..6c8a46d9e 100644 --- a/R/util-parse_data_mapping.R +++ b/R/util-parse_data_mapping.R @@ -38,7 +38,7 @@ parse_data_mapping <- function( value = "col_value" ) %>% dplyr::mutate( - col_value = as.character(col_value) + col_value = as.character(.data$col_value) ) %>% tidyr::unnest( cols = "col_value" @@ -47,7 +47,7 @@ parse_data_mapping <- function( domain = domain ) %>% dplyr::select( - domain, col_key, col_value + .data$domain, .data$col_key, .data$col_value ) # Append domain metadata to domain list. diff --git a/tests/testthat/test_Study_AssessmentReport.R b/tests/testthat/test_Study_AssessmentReport.R index d931cc4d7..f1481c3c2 100644 --- a/tests/testthat/test_Study_AssessmentReport.R +++ b/tests/testthat/test_Study_AssessmentReport.R @@ -43,3 +43,34 @@ test_that("bViewReport works", { view_true <- Study_AssessmentReport(lAssessments = lAssessments, bViewReport = TRUE) expect_true("gt_tbl" %in% class(view_true)) }) + +test_that("correct messages show when data is not found", { + ldata <- list( + dfAE = dfAE, + dfSUBJ = dfSUBJ + ) + + lAssessments <- Study_Assess(lData = ldata) + + report <- Study_AssessmentReport(lAssessments) + + expect_equal( + report$dfAllChecks %>% filter(domain == 'dfCONSENT') %>% pull(notes), + "Data not found for consent assessment" + ) + + expect_equal( + report$dfAllChecks %>% filter(domain == 'dfIE') %>% pull(notes), + "Data not found for ie assessment" + ) + + expect_equal( + report$dfAllChecks %>% filter(domain == 'dfPD' & step == 'FilterDomain') %>% pull(notes), + "Data not found for importantpd assessment" + ) + + expect_equal( + report$dfAllChecks %>% filter(assessment == 'pd' & domain == 'dfPD' & step == 'PD_Map_Raw') %>% pull(notes), + "Data not found for pd assessment" + ) +}) diff --git a/tests/testthat/test_util-runAssessment.R b/tests/testthat/test_util-runAssessment.R index 3ff7d758f..7d609c87d 100644 --- a/tests/testthat/test_util-runAssessment.R +++ b/tests/testthat/test_util-runAssessment.R @@ -36,3 +36,40 @@ test_that("Assessment correctly labeled as valid", { expect_true(sae$bStatus) expect_false(sae_inv$bStatus) }) + +test_that("workflow with multiple FilterDomain steps is reported correctly", { + + + dfAE <- data.frame( + stringsAsFactors = FALSE, + SubjectID = c("1234", "1234", "5678", "5678"), + AE_SERIOUS = c("Yes", "Yes", "Yes", "Yes"), + AE_TE_FLAG = c(TRUE, TRUE, FALSE, TRUE), + AE_GRADE = c(1, 3, 1, 4) + ) + + dfSUBJ <- data.frame( + stringsAsFactors = FALSE, + SubjectID = c("1234", "5678", "9876"), + SiteID = c("X010X", "X102X", "X999X"), + TimeOnTreatment = c(3455, 1745, 1233), + TimeOnStudy = c(1234, 2345, 4567), + RandDate = c("2012-09-02", "2017-05-08", "2018-05-20") + ) + + lAssessments <- MakeAssessmentList() + + lData <- list( + dfAE = dfAE, + dfSUBJ = dfSUBJ + ) + lTags <- list( + Study = "myStudy" + ) + lMapping <- clindata::mapping_rawplus + + + sae_assessment <- RunAssessment(lAssessments$sae, lData = lData, lMapping = lMapping, lTags = lTags) + + expect_equal(names(sae_assessment$checks), c("FilterDomain", "FilterDomain", "AE_Map_Raw", "AE_Assess")) +}) From 56a849d93cc279492c0055e2a557ec8f9354fc5f Mon Sep 17 00:00:00 2001 From: Matt Roumaya Date: Fri, 3 Jun 2022 21:30:37 +0000 Subject: [PATCH 07/87] remove .lintr file --- .lintr | 3 --- 1 file changed, 3 deletions(-) delete mode 100644 .lintr diff --git a/.lintr b/.lintr deleted file mode 100644 index f1dc16270..000000000 --- a/.lintr +++ /dev/null @@ -1,3 +0,0 @@ -linters: with_defaults( - line_length_linter(100) - ) From fcf30684e637d41a2ec688346bc5efaf6e044964 Mon Sep 17 00:00:00 2001 From: Li Ge Date: Fri, 3 Jun 2022 16:43:47 -0700 Subject: [PATCH 08/87] fix #496 --- R/util-generate_md_table.R | 14 +++++++++++++- man/AE_Assess.Rd | 2 +- man/AE_Map_Adam.Rd | 2 +- man/AE_Map_Raw.Rd | 2 +- man/Consent_Assess.Rd | 2 +- man/Consent_Map_Raw.Rd | 2 +- man/IE_Assess.Rd | 2 +- man/IE_Map_Raw.Rd | 2 +- man/PD_Assess.Rd | 2 +- man/PD_Map_Raw.Rd | 2 +- man/md/AE_Assess.md | 14 +++++++------- man/md/AE_Map_Adam.md | 14 +++++++------- man/md/AE_Map_Raw.md | 12 ++++++------ man/md/Consent_Assess.md | 10 +++++----- man/md/Consent_Map_Raw.md | 18 +++++++++--------- man/md/IE_Assess.md | 10 +++++----- man/md/IE_Map_Raw.md | 14 +++++++------- man/md/PD_Assess.md | 14 +++++++------- man/md/PD_Map_Raw.md | 12 ++++++------ 19 files changed, 81 insertions(+), 69 deletions(-) diff --git a/R/util-generate_md_table.R b/R/util-generate_md_table.R index b9a7eff88..8f6c7a5f0 100644 --- a/R/util-generate_md_table.R +++ b/R/util-generate_md_table.R @@ -89,7 +89,19 @@ generate_md_table <- function( # Reformat data frame as HTML table. knitr.kable.NA <- options(knitr.kable.NA = "") on.exit(knitr.kable.NA) - md <- knitr::kable(table, format = "markdown") %>% + col_name_dict = c( + domain = "Domain", + col_key = "Column Key", + col_value = "Default Value", + vRequired = "Required?", + vUniqueCols = "Require Unique Values?", + vNACols = "Accept NA/Empty Values?" + ) + col_name_dict_bold <- paste0("**", col_name_dict, "**") + names(col_name_dict_bold) <- names(col_name_dict) # paste won't keep names + md <- knitr::kable(table, + format = "markdown", + col.names = col_name_dict_bold[names(table)]) %>% paste(collapse = "\n") # Append markdown header to HTML table. diff --git a/man/AE_Assess.Rd b/man/AE_Assess.Rd index 3c442a29c..684ceb30b 100644 --- a/man/AE_Assess.Rd +++ b/man/AE_Assess.Rd @@ -65,7 +65,7 @@ methods are described below. } \section{Data specification}{ \tabular{lllll}{ - domain \tab col_key \tab col_value \tab vRequired \tab vUniqueCols \cr + \strong{Domain} \tab \strong{Column Key} \tab \strong{Default Value} \tab \strong{Required?} \tab \strong{Require Unique Values?} \cr dfInput \tab strIDCol \tab SubjectID \tab TRUE \tab TRUE \cr dfInput \tab strSiteCol \tab SiteID \tab TRUE \tab FALSE \cr dfInput \tab strCountCol \tab Count \tab TRUE \tab FALSE \cr diff --git a/man/AE_Map_Adam.Rd b/man/AE_Map_Adam.Rd index a7878d68a..e00e3d7a4 100644 --- a/man/AE_Map_Adam.Rd +++ b/man/AE_Map_Adam.Rd @@ -45,7 +45,7 @@ AEs by passing filtered AE data to \code{dfADAE}. } \section{Data specification}{ \tabular{lllll}{ - domain \tab col_key \tab col_value \tab vRequired \tab vUniqueCols \cr + \strong{Domain} \tab \strong{Column Key} \tab \strong{Default Value} \tab \strong{Required?} \tab \strong{Require Unique Values?} \cr dfADSL \tab strIDCol \tab USUBJID \tab TRUE \tab TRUE \cr dfADSL \tab strSiteCol \tab SITEID \tab TRUE \tab FALSE \cr dfADSL \tab strStartCol \tab TRTSDT \tab TRUE \tab FALSE \cr diff --git a/man/AE_Map_Raw.Rd b/man/AE_Map_Raw.Rd index 4919c7113..ab267bbfe 100644 --- a/man/AE_Map_Raw.Rd +++ b/man/AE_Map_Raw.Rd @@ -45,7 +45,7 @@ AEs by passing filtered AE data to \code{dfAE}. } \section{Data specification}{ \tabular{lllll}{ - domain \tab col_key \tab col_value \tab vRequired \tab vUniqueCols \cr + \strong{Domain} \tab \strong{Column Key} \tab \strong{Default Value} \tab \strong{Required?} \tab \strong{Require Unique Values?} \cr dfSUBJ \tab strIDCol \tab SubjectID \tab TRUE \tab TRUE \cr dfSUBJ \tab strSiteCol \tab SiteID \tab TRUE \tab FALSE \cr dfSUBJ \tab strTimeOnTreatmentCol \tab TimeOnTreatment \tab TRUE \tab FALSE \cr diff --git a/man/Consent_Assess.Rd b/man/Consent_Assess.Rd index 36bf4c6ae..5d1935064 100644 --- a/man/Consent_Assess.Rd +++ b/man/Consent_Assess.Rd @@ -73,7 +73,7 @@ Additional details regarding the data pipeline and statistical methods are descr } \section{Data specification}{ \tabular{lllll}{ - domain \tab col_key \tab col_value \tab vRequired \tab vUniqueCols \cr + \strong{Domain} \tab \strong{Column Key} \tab \strong{Default Value} \tab \strong{Required?} \tab \strong{Require Unique Values?} \cr dfInput \tab strIDCol \tab SubjectID \tab TRUE \tab TRUE \cr dfInput \tab strSiteCol \tab SiteID \tab TRUE \tab FALSE \cr dfInput \tab strCountCol \tab Count \tab TRUE \tab FALSE \cr diff --git a/man/Consent_Map_Raw.Rd b/man/Consent_Map_Raw.Rd index ee177c358..532a713b9 100644 --- a/man/Consent_Map_Raw.Rd +++ b/man/Consent_Map_Raw.Rd @@ -45,7 +45,7 @@ types of consent by customizing \code{lMapping$dfCONSENT}. } \section{Data specification}{ \tabular{llllll}{ - domain \tab col_key \tab col_value \tab vRequired \tab vNACols \tab vUniqueCols \cr + \strong{Domain} \tab \strong{Column Key} \tab \strong{Default Value} \tab \strong{Required?} \tab \strong{Accept NA/Empty Values?} \tab \strong{Require Unique Values?} \cr dfSUBJ \tab strIDCol \tab SubjectID \tab TRUE \tab \tab TRUE \cr dfSUBJ \tab strSiteCol \tab SiteID \tab TRUE \tab \tab FALSE \cr dfSUBJ \tab strRandDateCol \tab RandDate \tab TRUE \tab \tab FALSE \cr diff --git a/man/IE_Assess.Rd b/man/IE_Assess.Rd index dbebdd4a3..fec7185ac 100644 --- a/man/IE_Assess.Rd +++ b/man/IE_Assess.Rd @@ -60,7 +60,7 @@ details regarding the data pipeline and statistical methods are described below. } \section{Data specification}{ \tabular{lllll}{ - domain \tab col_key \tab col_value \tab vRequired \tab vUniqueCols \cr + \strong{Domain} \tab \strong{Column Key} \tab \strong{Default Value} \tab \strong{Required?} \tab \strong{Require Unique Values?} \cr dfInput \tab strIDCol \tab SubjectID \tab TRUE \tab TRUE \cr dfInput \tab strSiteCol \tab SiteID \tab TRUE \tab FALSE \cr dfInput \tab strCountCol \tab Count \tab TRUE \tab FALSE \cr diff --git a/man/IE_Map_Raw.Rd b/man/IE_Map_Raw.Rd index d46751c1a..5cd880a32 100644 --- a/man/IE_Map_Raw.Rd +++ b/man/IE_Map_Raw.Rd @@ -45,7 +45,7 @@ specific types of IE criteria by passing filtered IE data to \code{dfIE}. } \section{Data specification}{ \tabular{lllll}{ - domain \tab col_key \tab col_value \tab vRequired \tab vUniqueCols \cr + \strong{Domain} \tab \strong{Column Key} \tab \strong{Default Value} \tab \strong{Required?} \tab \strong{Require Unique Values?} \cr dfSUBJ \tab strIDCol \tab SubjectID \tab TRUE \tab TRUE \cr dfSUBJ \tab strSiteCol \tab SiteID \tab TRUE \tab FALSE \cr dfIE \tab strIDCol \tab SubjectID \tab TRUE \tab \cr diff --git a/man/PD_Assess.Rd b/man/PD_Assess.Rd index a274271ab..1b5fbd337 100644 --- a/man/PD_Assess.Rd +++ b/man/PD_Assess.Rd @@ -61,7 +61,7 @@ methods are described below. } \section{Data specification}{ \tabular{lllll}{ - domain \tab col_key \tab col_value \tab vRequired \tab vUniqueCols \cr + \strong{Domain} \tab \strong{Column Key} \tab \strong{Default Value} \tab \strong{Required?} \tab \strong{Require Unique Values?} \cr dfInput \tab strIDCol \tab SubjectID \tab TRUE \tab TRUE \cr dfInput \tab strSiteCol \tab SiteID \tab TRUE \tab FALSE \cr dfInput \tab strCountCol \tab Count \tab TRUE \tab FALSE \cr diff --git a/man/PD_Map_Raw.Rd b/man/PD_Map_Raw.Rd index c5aae2e29..81cd879a4 100644 --- a/man/PD_Map_Raw.Rd +++ b/man/PD_Map_Raw.Rd @@ -45,7 +45,7 @@ PDs by passing filtered PD data to \code{dfPD}. } \section{Data specification}{ \tabular{lllll}{ - domain \tab col_key \tab col_value \tab vRequired \tab vUniqueCols \cr + \strong{Domain} \tab \strong{Column Key} \tab \strong{Default Value} \tab \strong{Required?} \tab \strong{Require Unique Values?} \cr dfSUBJ \tab strIDCol \tab SubjectID \tab TRUE \tab TRUE \cr dfSUBJ \tab strSiteCol \tab SiteID \tab TRUE \tab FALSE \cr dfSUBJ \tab strTimeOnStudyCol \tab TimeOnStudy \tab TRUE \tab FALSE \cr diff --git a/man/md/AE_Assess.md b/man/md/AE_Assess.md index 5d4b60fb8..bdb809e2e 100644 --- a/man/md/AE_Assess.md +++ b/man/md/AE_Assess.md @@ -1,9 +1,9 @@ # Data specification -|domain |col_key |col_value |vRequired |vUniqueCols | -|:-------|:--------------|:---------|:---------|:-----------| -|dfInput |strIDCol |SubjectID |TRUE |TRUE | -|dfInput |strSiteCol |SiteID |TRUE |FALSE | -|dfInput |strCountCol |Count |TRUE |FALSE | -|dfInput |strExposureCol |Exposure |TRUE |FALSE | -|dfInput |strRateCol |Rate |TRUE |FALSE | +|**Domain** |**Column Key** |**Default Value** |**Required?** |**Require Unique Values?** | +|:----------|:--------------|:-----------------|:-------------|:--------------------------| +|dfInput |strIDCol |SubjectID |TRUE |TRUE | +|dfInput |strSiteCol |SiteID |TRUE |FALSE | +|dfInput |strCountCol |Count |TRUE |FALSE | +|dfInput |strExposureCol |Exposure |TRUE |FALSE | +|dfInput |strRateCol |Rate |TRUE |FALSE | diff --git a/man/md/AE_Map_Adam.md b/man/md/AE_Map_Adam.md index f5d677702..4ee09b009 100644 --- a/man/md/AE_Map_Adam.md +++ b/man/md/AE_Map_Adam.md @@ -1,9 +1,9 @@ # Data specification -|domain |col_key |col_value |vRequired |vUniqueCols | -|:------|:-----------|:---------|:---------|:-----------| -|dfADSL |strIDCol |USUBJID |TRUE |TRUE | -|dfADSL |strSiteCol |SITEID |TRUE |FALSE | -|dfADSL |strStartCol |TRTSDT |TRUE |FALSE | -|dfADSL |strEndCol |TRTEDT |TRUE |FALSE | -|dfADAE |strIDCol |USUBJID |TRUE | | +|**Domain** |**Column Key** |**Default Value** |**Required?** |**Require Unique Values?** | +|:----------|:--------------|:-----------------|:-------------|:--------------------------| +|dfADSL |strIDCol |USUBJID |TRUE |TRUE | +|dfADSL |strSiteCol |SITEID |TRUE |FALSE | +|dfADSL |strStartCol |TRTSDT |TRUE |FALSE | +|dfADSL |strEndCol |TRTEDT |TRUE |FALSE | +|dfADAE |strIDCol |USUBJID |TRUE | | diff --git a/man/md/AE_Map_Raw.md b/man/md/AE_Map_Raw.md index 09b55c976..2e9a4bb84 100644 --- a/man/md/AE_Map_Raw.md +++ b/man/md/AE_Map_Raw.md @@ -1,8 +1,8 @@ # Data specification -|domain |col_key |col_value |vRequired |vUniqueCols | -|:------|:---------------------|:---------------|:---------|:-----------| -|dfSUBJ |strIDCol |SubjectID |TRUE |TRUE | -|dfSUBJ |strSiteCol |SiteID |TRUE |FALSE | -|dfSUBJ |strTimeOnTreatmentCol |TimeOnTreatment |TRUE |FALSE | -|dfAE |strIDCol |SubjectID |TRUE | | +|**Domain** |**Column Key** |**Default Value** |**Required?** |**Require Unique Values?** | +|:----------|:---------------------|:-----------------|:-------------|:--------------------------| +|dfSUBJ |strIDCol |SubjectID |TRUE |TRUE | +|dfSUBJ |strSiteCol |SiteID |TRUE |FALSE | +|dfSUBJ |strTimeOnTreatmentCol |TimeOnTreatment |TRUE |FALSE | +|dfAE |strIDCol |SubjectID |TRUE | | diff --git a/man/md/Consent_Assess.md b/man/md/Consent_Assess.md index 7d1a7dc1e..687e96ff9 100644 --- a/man/md/Consent_Assess.md +++ b/man/md/Consent_Assess.md @@ -1,7 +1,7 @@ # Data specification -|domain |col_key |col_value |vRequired |vUniqueCols | -|:-------|:-----------|:---------|:---------|:-----------| -|dfInput |strIDCol |SubjectID |TRUE |TRUE | -|dfInput |strSiteCol |SiteID |TRUE |FALSE | -|dfInput |strCountCol |Count |TRUE |FALSE | +|**Domain** |**Column Key** |**Default Value** |**Required?** |**Require Unique Values?** | +|:----------|:--------------|:-----------------|:-------------|:--------------------------| +|dfInput |strIDCol |SubjectID |TRUE |TRUE | +|dfInput |strSiteCol |SiteID |TRUE |FALSE | +|dfInput |strCountCol |Count |TRUE |FALSE | diff --git a/man/md/Consent_Map_Raw.md b/man/md/Consent_Map_Raw.md index 9971ad2a2..a4b1897ae 100644 --- a/man/md/Consent_Map_Raw.md +++ b/man/md/Consent_Map_Raw.md @@ -1,11 +1,11 @@ # Data specification -|domain |col_key |col_value |vRequired |vNACols |vUniqueCols | -|:---------|:--------------|:-------------|:---------|:-------|:-----------| -|dfSUBJ |strIDCol |SubjectID |TRUE | |TRUE | -|dfSUBJ |strSiteCol |SiteID |TRUE | |FALSE | -|dfSUBJ |strRandDateCol |RandDate |TRUE | |FALSE | -|dfCONSENT |strIDCol |SubjectID |TRUE |FALSE | | -|dfCONSENT |strTypeCol |CONSENT_TYPE |TRUE |FALSE | | -|dfCONSENT |strValueCol |CONSENT_VALUE |TRUE |FALSE | | -|dfCONSENT |strDateCol |CONSENT_DATE |TRUE |TRUE | | +|**Domain** |**Column Key** |**Default Value** |**Required?** |**Accept NA/Empty Values?** |**Require Unique Values?** | +|:----------|:--------------|:-----------------|:-------------|:---------------------------|:--------------------------| +|dfSUBJ |strIDCol |SubjectID |TRUE | |TRUE | +|dfSUBJ |strSiteCol |SiteID |TRUE | |FALSE | +|dfSUBJ |strRandDateCol |RandDate |TRUE | |FALSE | +|dfCONSENT |strIDCol |SubjectID |TRUE |FALSE | | +|dfCONSENT |strTypeCol |CONSENT_TYPE |TRUE |FALSE | | +|dfCONSENT |strValueCol |CONSENT_VALUE |TRUE |FALSE | | +|dfCONSENT |strDateCol |CONSENT_DATE |TRUE |TRUE | | diff --git a/man/md/IE_Assess.md b/man/md/IE_Assess.md index 7d1a7dc1e..687e96ff9 100644 --- a/man/md/IE_Assess.md +++ b/man/md/IE_Assess.md @@ -1,7 +1,7 @@ # Data specification -|domain |col_key |col_value |vRequired |vUniqueCols | -|:-------|:-----------|:---------|:---------|:-----------| -|dfInput |strIDCol |SubjectID |TRUE |TRUE | -|dfInput |strSiteCol |SiteID |TRUE |FALSE | -|dfInput |strCountCol |Count |TRUE |FALSE | +|**Domain** |**Column Key** |**Default Value** |**Required?** |**Require Unique Values?** | +|:----------|:--------------|:-----------------|:-------------|:--------------------------| +|dfInput |strIDCol |SubjectID |TRUE |TRUE | +|dfInput |strSiteCol |SiteID |TRUE |FALSE | +|dfInput |strCountCol |Count |TRUE |FALSE | diff --git a/man/md/IE_Map_Raw.md b/man/md/IE_Map_Raw.md index 1c3ea7db3..b3d44f7f9 100644 --- a/man/md/IE_Map_Raw.md +++ b/man/md/IE_Map_Raw.md @@ -1,9 +1,9 @@ # Data specification -|domain |col_key |col_value |vRequired |vUniqueCols | -|:------|:--------------|:-----------|:---------|:-----------| -|dfSUBJ |strIDCol |SubjectID |TRUE |TRUE | -|dfSUBJ |strSiteCol |SiteID |TRUE |FALSE | -|dfIE |strIDCol |SubjectID |TRUE | | -|dfIE |strCategoryCol |IE_CATEGORY |TRUE | | -|dfIE |strValueCol |IE_VALUE |TRUE | | +|**Domain** |**Column Key** |**Default Value** |**Required?** |**Require Unique Values?** | +|:----------|:--------------|:-----------------|:-------------|:--------------------------| +|dfSUBJ |strIDCol |SubjectID |TRUE |TRUE | +|dfSUBJ |strSiteCol |SiteID |TRUE |FALSE | +|dfIE |strIDCol |SubjectID |TRUE | | +|dfIE |strCategoryCol |IE_CATEGORY |TRUE | | +|dfIE |strValueCol |IE_VALUE |TRUE | | diff --git a/man/md/PD_Assess.md b/man/md/PD_Assess.md index 5d4b60fb8..bdb809e2e 100644 --- a/man/md/PD_Assess.md +++ b/man/md/PD_Assess.md @@ -1,9 +1,9 @@ # Data specification -|domain |col_key |col_value |vRequired |vUniqueCols | -|:-------|:--------------|:---------|:---------|:-----------| -|dfInput |strIDCol |SubjectID |TRUE |TRUE | -|dfInput |strSiteCol |SiteID |TRUE |FALSE | -|dfInput |strCountCol |Count |TRUE |FALSE | -|dfInput |strExposureCol |Exposure |TRUE |FALSE | -|dfInput |strRateCol |Rate |TRUE |FALSE | +|**Domain** |**Column Key** |**Default Value** |**Required?** |**Require Unique Values?** | +|:----------|:--------------|:-----------------|:-------------|:--------------------------| +|dfInput |strIDCol |SubjectID |TRUE |TRUE | +|dfInput |strSiteCol |SiteID |TRUE |FALSE | +|dfInput |strCountCol |Count |TRUE |FALSE | +|dfInput |strExposureCol |Exposure |TRUE |FALSE | +|dfInput |strRateCol |Rate |TRUE |FALSE | diff --git a/man/md/PD_Map_Raw.md b/man/md/PD_Map_Raw.md index 3ac2e5659..d63c78fd0 100644 --- a/man/md/PD_Map_Raw.md +++ b/man/md/PD_Map_Raw.md @@ -1,8 +1,8 @@ # Data specification -|domain |col_key |col_value |vRequired |vUniqueCols | -|:------|:-----------------|:-----------|:---------|:-----------| -|dfSUBJ |strIDCol |SubjectID |TRUE |TRUE | -|dfSUBJ |strSiteCol |SiteID |TRUE |FALSE | -|dfSUBJ |strTimeOnStudyCol |TimeOnStudy |TRUE |FALSE | -|dfPD |strIDCol |SubjectID |TRUE | | +|**Domain** |**Column Key** |**Default Value** |**Required?** |**Require Unique Values?** | +|:----------|:-----------------|:-----------------|:-------------|:--------------------------| +|dfSUBJ |strIDCol |SubjectID |TRUE |TRUE | +|dfSUBJ |strSiteCol |SiteID |TRUE |FALSE | +|dfSUBJ |strTimeOnStudyCol |TimeOnStudy |TRUE |FALSE | +|dfPD |strIDCol |SubjectID |TRUE | | From abecf674f1850081dba99007cbae60de118f6992 Mon Sep 17 00:00:00 2001 From: Matt Roumaya Date: Mon, 6 Jun 2022 18:12:37 +0000 Subject: [PATCH 09/87] add @importFrom --- NAMESPACE | 30 ++++++++++++++++++++---- R/AE_Assess.R | 3 +++ R/AE_Map_Adam.R | 1 + R/AE_Map_Raw.R | 1 + R/Analyze_Poisson.R | 11 +++++---- R/Analyze_Wilcoxon.R | 3 ++- R/Consent_Assess.R | 3 +++ R/Consent_Map_Raw.R | 5 ++-- R/IE_Assess.R | 4 ++++ R/IE_Map_Raw.R | 1 + R/PD_Assess.R | 3 +++ R/PD_Map_Raw.R | 1 + R/Study_Assess.R | 5 ++-- R/Study_AssessmentReport.R | 5 ++-- R/Study_Report.R | 2 ++ R/Study_Table.R | 2 +- R/build-md.R | 4 ++++ R/util-CheckInputs.R | 7 +++--- R/util-FilterDomain.R | 1 + R/util-MakeAssessmentList.R | 1 + R/util-MergeSubjects.R | 6 +++-- R/util-ReportHelpers.R | 3 +++ R/util-RunAssessment.R | 8 +++---- R/util-RunStep.R | 9 ++++--- R/util-generate_md_table.R | 3 +++ R/util-is_mapping_valid.R | 5 ++-- R/util-parse_data_mapping.R | 5 ++++ R/util-parse_data_spec.R | 5 ++++ tests/testthat/test_Study_Table.R | 2 +- tests/testthat/test_util-runAssessment.R | 4 ++-- 30 files changed, 109 insertions(+), 34 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 04e0257f8..a2239c94d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -36,24 +36,42 @@ export(is_mapping_valid) export(parse_data_mapping) export(parse_data_spec) export(rank_chg) -import(cli) import(dplyr) import(ggplot2) -import(purrr) -import(stringr) -import(tidyr) importFrom(broom,augment) importFrom(broom,glance) +importFrom(cli,cli_alert_danger) +importFrom(cli,cli_alert_info) +importFrom(cli,cli_alert_success) +importFrom(cli,cli_alert_warning) +importFrom(cli,cli_h1) +importFrom(cli,cli_h2) +importFrom(cli,cli_text) +importFrom(cli,col_br_yellow) +importFrom(dplyr,bind_rows) importFrom(dplyr,left_join) +importFrom(dplyr,right_join) importFrom(fontawesome,fa) importFrom(glue,glue) importFrom(gt,fmt_markdown) importFrom(gt,gt) +importFrom(janitor,row_to_names) +importFrom(knitr,kable) importFrom(lifecycle,deprecated) importFrom(magrittr,"%>%") +importFrom(purrr,discard) importFrom(purrr,flatten) +importFrom(purrr,keep) importFrom(purrr,map) +importFrom(purrr,map_chr) +importFrom(purrr,map_dbl) +importFrom(purrr,map_df) +importFrom(purrr,map_lgl) +importFrom(purrr,modify_if) importFrom(purrr,pluck) +importFrom(purrr,reduce) +importFrom(purrr,set_names) +importFrom(rmarkdown,render) importFrom(stats,as.formula) importFrom(stats,chisq.test) importFrom(stats,fisher.test) @@ -68,8 +86,12 @@ importFrom(stats,wilcox.test) importFrom(stringr,str_detect) importFrom(stringr,str_pad) importFrom(stringr,str_subset) +importFrom(stringr,word) importFrom(tibble,enframe) +importFrom(tibble,tibble) +importFrom(tidyr,pivot_longer) importFrom(tidyr,replace_na) +importFrom(tidyr,spread) importFrom(tidyr,unnest) importFrom(utils,hasName) importFrom(yaml,read_yaml) diff --git a/R/AE_Assess.R b/R/AE_Assess.R index 00598a540..1a5bc5df9 100644 --- a/R/AE_Assess.R +++ b/R/AE_Assess.R @@ -43,6 +43,9 @@ #' ae_assessment_poisson <- AE_Assess(dfInput) #' ae_assessment_wilcoxon <- AE_Assess(dfInput, strMethod = "wilcoxon") #' +#' @importFrom purrr map map_dbl +#' @importFrom cli cli_h2 cli_text cli_alert_success cli_alert_warning +#' #' @export AE_Assess <- function( diff --git a/R/AE_Map_Adam.R b/R/AE_Map_Adam.R index a30979526..7ed7fbe45 100644 --- a/R/AE_Map_Adam.R +++ b/R/AE_Map_Adam.R @@ -33,6 +33,7 @@ #' dfInput <- AE_Map_Adam(bReturnChecks = TRUE, bQuiet = FALSE) #' #' @import dplyr +#' @importFrom cli cli_h2 cli_alert_success cli_alert_warning #' #' @export diff --git a/R/AE_Map_Raw.R b/R/AE_Map_Raw.R index 782289c54..4e998396f 100644 --- a/R/AE_Map_Raw.R +++ b/R/AE_Map_Raw.R @@ -33,6 +33,7 @@ #' dfInput <- AE_Map_Raw(bReturnChecks = TRUE, bQuiet = FALSE) #' #' @import dplyr +#' @importFrom cli cli_h2 cli_alert_success cli_alert_warning #' #' @export diff --git a/R/Analyze_Poisson.R b/R/Analyze_Poisson.R index c124c96bd..7a5eee51b 100644 --- a/R/Analyze_Poisson.R +++ b/R/Analyze_Poisson.R @@ -20,11 +20,6 @@ #' @param dfTransformed data.frame in format produced by \code{\link{Transform_EventCount}}. Must include SubjectID, SiteID, TotalCount and TotalExposure. #' @param bQuiet `logical` Suppress warning messages? Default: `TRUE` #' -#' @import dplyr -#' @importFrom glue glue -#' @importFrom stats glm offset poisson pnorm -#' @importFrom broom augment -#' #' @return input data.frame with columns added for "Residuals" and "PredictedCount" #' #' @examples @@ -32,6 +27,12 @@ #' dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strExposureCol = "Exposure") #' dfAnalyzed <- Analyze_Poisson(dfTransformed) #' +#' @import dplyr +#' @importFrom glue glue +#' @importFrom stats glm offset poisson pnorm +#' @importFrom broom augment +#' @importFrom cli cli_alert_info +#' #' @export Analyze_Poisson <- function(dfTransformed, bQuiet = TRUE) { diff --git a/R/Analyze_Wilcoxon.R b/R/Analyze_Wilcoxon.R index 8598a8716..4fbbacff8 100644 --- a/R/Analyze_Wilcoxon.R +++ b/R/Analyze_Wilcoxon.R @@ -30,6 +30,7 @@ #' @importFrom purrr map #' @importFrom broom glance #' @importFrom tidyr unnest +#' @importFrom cli cli_alert_info #' #' @return `data.frame` with one row per site, columns: SiteID, N, TotalCount, TotalExposure, Rate, #' Estimate, PValue @@ -65,7 +66,7 @@ Analyze_Wilcoxon <- function( ) wilcoxon_model <- function(predictorValue) { - form <- as.formula( + form <- stats::as.formula( paste0( strOutcomeCol, " ~ as.character(", diff --git a/R/Consent_Assess.R b/R/Consent_Assess.R index a336aff66..9598922c8 100644 --- a/R/Consent_Assess.R +++ b/R/Consent_Assess.R @@ -48,6 +48,9 @@ #' dfInput <- Consent_Map_Raw() #' consent_assessment <- Consent_Assess(dfInput) #' +#' @importFrom purrr map map_dbl +#' @importFrom cli cli_h2 cli_text cli_alert_success cli_alert_info cli_alert_warning +#' #' @export Consent_Assess <- function( diff --git a/R/Consent_Map_Raw.R b/R/Consent_Map_Raw.R index fe21d7db6..d6f4058bd 100644 --- a/R/Consent_Map_Raw.R +++ b/R/Consent_Map_Raw.R @@ -25,8 +25,6 @@ #' #' @includeRmd ./man/md/Consent_Map_Raw.md #' -#' @import dplyr -#' #' @examples #' # Run with defaults #' dfInput <- Consent_Map_Raw() @@ -34,6 +32,9 @@ #' # Run with error checking and message log #' dfInput <- Consent_Map_Raw(bReturnChecks = TRUE, bQuiet = FALSE) #' +#' @import dplyr +#' @importFrom cli cli_h2 cli_alert_success cli_alert_warning +#' #' @export Consent_Map_Raw <- function( diff --git a/R/IE_Assess.R b/R/IE_Assess.R index eeac91b2e..21f0498e8 100644 --- a/R/IE_Assess.R +++ b/R/IE_Assess.R @@ -38,6 +38,10 @@ #' dfInput <- IE_Map_Raw() #' ie_assessment <- IE_Assess(dfInput) #' +#' @import dplyr +#' @importFrom purrr map map_dbl +#' @importFrom cli cli_h2 cli_text cli_alert_success cli_alert_info cli_alert_warning +#' #' @export IE_Assess <- function( diff --git a/R/IE_Map_Raw.R b/R/IE_Map_Raw.R index 330387a4f..be36ad95f 100644 --- a/R/IE_Map_Raw.R +++ b/R/IE_Map_Raw.R @@ -33,6 +33,7 @@ #' dfInput <- IE_Map_Raw(bReturnChecks = TRUE, bQuiet = FALSE) #' #' @import dplyr +#' @importFrom cli cli_h2 cli_alert_success cli_alert_warning #' #' @export diff --git a/R/PD_Assess.R b/R/PD_Assess.R index e000a9ce1..41a1614da 100644 --- a/R/PD_Assess.R +++ b/R/PD_Assess.R @@ -39,6 +39,9 @@ #' pd_assessment_poisson <- PD_Assess(dfInput) #' pd_assessment_wilcoxon <- PD_Assess(dfInput, strMethod = "wilcoxon") #' +#' @importFrom purrr map map_dbl +#' @importFrom cli cli_h2 cli_text cli_alert_success cli_alert_warning +#' #' @export PD_Assess <- function( diff --git a/R/PD_Map_Raw.R b/R/PD_Map_Raw.R index b8386cc3e..509cce003 100644 --- a/R/PD_Map_Raw.R +++ b/R/PD_Map_Raw.R @@ -33,6 +33,7 @@ #' dfInput <- PD_Map_Raw(bReturnChecks = TRUE, bQuiet = FALSE) #' #' @import dplyr +#' @importFrom cli cli_h2 cli_alert_success cli_alert_warning #' #' @export diff --git a/R/Study_Assess.R b/R/Study_Assess.R index 1337cf1fe..97a9d5208 100644 --- a/R/Study_Assess.R +++ b/R/Study_Assess.R @@ -12,11 +12,12 @@ #' @examples #' results <- Study_Assess() # run using defaults #' +#' @return A list of assessments containing status information and results. +#' #' @import dplyr #' @importFrom purrr map #' @importFrom yaml read_yaml -#' -#' @return A list of assessments containing status information and results. +#' @importFrom cli cli_alert_danger #' #' @export diff --git a/R/Study_AssessmentReport.R b/R/Study_AssessmentReport.R index d611161ca..5a352d9c7 100644 --- a/R/Study_AssessmentReport.R +++ b/R/Study_AssessmentReport.R @@ -5,11 +5,12 @@ #' @param lAssessments List of 1+ assessments like those created by `runAssessment()` or `Study_Assess()` #' @param bViewReport HTML table of dfSummary that can be viewed in most IDEs. #' -#' @importFrom gt gt fmt_markdown #' @importFrom fontawesome fa +#' @importFrom gt gt fmt_markdown +#' @importFrom janitor row_to_names +#' @importFrom purrr map map_df flatten pluck discard #' @importFrom tibble enframe #' @importFrom tidyr unnest -#' @importFrom purrr map flatten pluck #' #' @return `list` Returns a list containing a data.frame summarizing the checks `dfSummary` and a dataframe listing all checks (`dfAllChecks`) #' diff --git a/R/Study_Report.R b/R/Study_Report.R index a26dad55a..f786aefe0 100644 --- a/R/Study_Report.R +++ b/R/Study_Report.R @@ -14,6 +14,8 @@ #' Study_Report(assessment, lMeta = list(study = "my study name")) #' } #' +#' @importFrom rmarkdown render +#' #' @export Study_Report <- function(lAssessments, lMeta = list(Project = "My Project"), strOutpath = NULL) { diff --git a/R/Study_Table.R b/R/Study_Table.R index 024034271..2abbda821 100644 --- a/R/Study_Table.R +++ b/R/Study_Table.R @@ -9,10 +9,10 @@ #' @param bShowCounts Show site counts? Uses first value of N for each site given in dfFindings. #' @param bColCollapse Combine the Assessment and Label columns into a single "Title Column" #' -#' @import tidyr #' @import dplyr #' @importFrom fontawesome fa #' @importFrom stringr str_pad +#' @importFrom tidyr spread #' #' @examples #' library(dplyr) diff --git a/R/build-md.R b/R/build-md.R index 2a468c9f5..4a902b1c1 100644 --- a/R/build-md.R +++ b/R/build-md.R @@ -2,6 +2,10 @@ #' #' @param yaml_path path to adam mapping yaml #' +#' @importFrom yaml read_yaml +#' @importFrom stringr word +#' @importFrom purrr map +#' #' @noRd build_markdown <- function(yaml_path) { specs <- list.files( diff --git a/R/util-CheckInputs.R b/R/util-CheckInputs.R index e11284feb..1ee1110ec 100644 --- a/R/util-CheckInputs.R +++ b/R/util-CheckInputs.R @@ -5,9 +5,6 @@ #' @param mapping `list` YAML mapping for a given context. #' @param bQuiet `logical` Suppress warning messages? Default: `TRUE` #' -#' @import purrr -#' @importFrom yaml read_yaml -#' #' @examples #' checks <- CheckInputs( #' context = "AE_Assess", @@ -21,6 +18,10 @@ #' - tests_if `list` - a named list containing status and warnings for all checks #' - status `logical` - did all checked data pass the checks? #' +#' @importFrom cli cli_h2 cli_alert_success cli_alert_warning +#' @importFrom purrr map map_lgl modify_if set_names +#' @importFrom yaml read_yaml +#' #' @export CheckInputs <- function(context, dfs, mapping = NULL, bQuiet = TRUE) { if (!bQuiet) cli::cli_h2("Checking Input Data for {.fn {context}}") diff --git a/R/util-FilterDomain.R b/R/util-FilterDomain.R index 1244e3a0c..b05bfe365 100644 --- a/R/util-FilterDomain.R +++ b/R/util-FilterDomain.R @@ -26,6 +26,7 @@ #' @return `data.frame` Data frame provided as `df` and filtered on `strColParam` == `strValParam`. #' If `bReturnChecks` is `TRUE`, a `list` is returned with a filtered `df`, and a list of checks run on input data (`lChecks`). #' +#' @importFrom cli cli_text cli_alert_info cli_alert_success cli_alert_warning #' #' @export diff --git a/R/util-MakeAssessmentList.R b/R/util-MakeAssessmentList.R index f592b3769..82530ac6e 100644 --- a/R/util-MakeAssessmentList.R +++ b/R/util-MakeAssessmentList.R @@ -10,6 +10,7 @@ #' @examples #' MakeAssessmentList(path = "assessments", package = "gsm") #' +#' @importFrom purrr map_chr #' @importFrom utils hasName #' @importFrom yaml read_yaml #' diff --git a/R/util-MergeSubjects.R b/R/util-MergeSubjects.R index dc388c5bc..c52620244 100644 --- a/R/util-MergeSubjects.R +++ b/R/util-MergeSubjects.R @@ -8,8 +8,6 @@ #' #' @return data set with one record per IDCol #' -#' @importFrom dplyr left_join -#' @importFrom tidyr replace_na #' #' @examples #' MergeSubjects( @@ -18,6 +16,10 @@ #' strIDCol = "SubjectID" #' ) #' +#' @importFrom cli cli_alert_warning cli_alert_info +#' @importFrom dplyr left_join +#' @importFrom tidyr replace_na +#' #' @export MergeSubjects <- function(dfDomain, dfSubjects, strIDCol = "SubjectID", vFillZero = NULL, bQuiet = TRUE) { diff --git a/R/util-ReportHelpers.R b/R/util-ReportHelpers.R index 820b987b6..f51fab87a 100644 --- a/R/util-ReportHelpers.R +++ b/R/util-ReportHelpers.R @@ -5,6 +5,9 @@ #' #' @param status boolean status #' +#' @importFrom fontawesome fa +#' @importFrom gt gt +#' #' @export rank_chg <- function(status) { diff --git a/R/util-RunAssessment.R b/R/util-RunAssessment.R index cbf57a326..e0dfdc080 100644 --- a/R/util-RunAssessment.R +++ b/R/util-RunAssessment.R @@ -9,10 +9,6 @@ #' @param lTags `list` A named list of tags describing the assessment. `lTags` is returned as part of the assessment (`lAssess$lTags`) and each tag is added as columns in `lassess$dfSummary`. #' @param bQuiet `logical` Suppress warning messages? Default: `TRUE` #' -#' @importFrom yaml read_yaml -#' @import cli -#' @import stringr -#' #' @return `list` Returns `lAssessment` with `label`, `tags`, `workflow`, `path`, `name`, `lData`, `lChecks`, `bStatus`, `checks`, and `lResults` added based on the results of the execution of `assessment$workflow`. #' #' @examples @@ -32,6 +28,10 @@ #' #' ae_assessment <- RunAssessment(lAssessments$ae, lData = lData, lMapping = lMapping, lTags = lTags) #' +#' @importFrom cli cli_h1 cli_h2 cli_alert_success cli_alert_warning cli_text +#' @importFrom stringr str_detect +#' @importFrom yaml read_yaml +#' #' @export RunAssessment <- function(lAssessment, lData, lMapping, lTags = NULL, bQuiet = FALSE) { diff --git a/R/util-RunStep.R b/R/util-RunStep.R index f494d2456..cdab91a08 100644 --- a/R/util-RunStep.R +++ b/R/util-RunStep.R @@ -8,11 +8,10 @@ #' @param lTags tags #' @param bQuiet Default is TRUE, which means warning messages are suppressed. Set to FALSE to see warning messages. #' -#' @importFrom yaml read_yaml -#' @importFrom stringr str_detect -#' #' @return A list containing the results of the `lStep$name` function call should contain `.$checks` parameter with results from `is_mapping_vald` for each domain in `lStep$inputs`. #' +#' +#' #' @examples #' lStep <- MakeAssessmentList()[["ae"]][["workflow"]][[1]] #' @@ -30,6 +29,10 @@ #' #' ae_step <- RunStep(lStep = lStep, lMapping = lMapping, lData = lData, lTags = lTags, bQuiet = FALSE) #' +#' @importFrom cli cli_text +#' @importFrom stringr str_detect +#' @importFrom yaml read_yaml +#' #' @export RunStep <- function(lStep, lMapping, lData, lTags, bQuiet) { diff --git a/R/util-generate_md_table.R b/R/util-generate_md_table.R index b9a7eff88..ff1828818 100644 --- a/R/util-generate_md_table.R +++ b/R/util-generate_md_table.R @@ -10,6 +10,9 @@ #' @param out_path `character` file path of .md file #' @param header `character` section header #' +#' @importFrom dplyr right_join +#' @importFrom knitr kable +#' #' @export generate_md_table <- function( diff --git a/R/util-is_mapping_valid.R b/R/util-is_mapping_valid.R index c39ed7fe9..175442d88 100644 --- a/R/util-is_mapping_valid.R +++ b/R/util-is_mapping_valid.R @@ -9,9 +9,10 @@ #' @param bQuiet `logical` Suppress warning messages? Default: `TRUE` #' #' @import dplyr -#' @import tidyr -#' @import purrr +#' @importFrom cli cli_alert_danger col_br_yellow +#' @importFrom purrr map map_dbl map_lgl keep #' @importFrom stringr str_subset +#' @importFrom tidyr pivot_longer #' #' @examples #' subj_mapping <- list( diff --git a/R/util-parse_data_mapping.R b/R/util-parse_data_mapping.R index 6c8a46d9e..466768753 100644 --- a/R/util-parse_data_mapping.R +++ b/R/util-parse_data_mapping.R @@ -5,6 +5,11 @@ #' @param content `list` data mapping #' @param file `character` file path of .yaml file #' +#' @importFrom purrr reduce +#' @importFrom tibble enframe +#' @importFrom tidyr unnest +#' @importFrom yaml read_yaml +#' #' @export parse_data_mapping <- function( diff --git a/R/util-parse_data_spec.R b/R/util-parse_data_spec.R index f8b75f1fd..f98c54b96 100644 --- a/R/util-parse_data_spec.R +++ b/R/util-parse_data_spec.R @@ -5,6 +5,11 @@ #' @param content `list` data specification #' @param file `character` file path of .yaml file #' +#' @importFrom dplyr bind_rows +#' @importFrom purrr reduce +#' @importFrom tibble tibble +#' @importFrom yaml read_yaml +#' #' @export parse_data_spec <- function( diff --git a/tests/testthat/test_Study_Table.R b/tests/testthat/test_Study_Table.R index 360519091..57766037a 100644 --- a/tests/testthat/test_Study_Table.R +++ b/tests/testthat/test_Study_Table.R @@ -1,6 +1,6 @@ results <- Study_Assess(bQuiet = TRUE) %>% purrr::map(~ .x$lResults) %>% - compact() %>% + purrr::compact() %>% purrr::map_df(~ .x$dfSummary) %>% suppressMessages() diff --git a/tests/testthat/test_util-runAssessment.R b/tests/testthat/test_util-runAssessment.R index 7d609c87d..36f66a940 100644 --- a/tests/testthat/test_util-runAssessment.R +++ b/tests/testthat/test_util-runAssessment.R @@ -3,10 +3,10 @@ sae_meta <- yaml::read_yaml(system.file("assessments/sae.yaml", package = "gsm") rawDataMap <- clindata::mapping_rawplus dfAE <- dfAE %>% - expand(dfAE, ae_serious = dfAE$AE_SERIOUS) + tidyr::expand(dfAE, ae_serious = dfAE$AE_SERIOUS) dfAE <- dfAE %>% - expand(dfAE, ae_te_flag = dfAE$AE_TE_FLAG) %>% + tidyr::expand(dfAE, ae_te_flag = dfAE$AE_TE_FLAG) %>% select(-c(AE_SERIOUS, AE_TE_FLAG)) %>% rename( AE_SERIOUS = ae_serious, From ef912b2e41b4461f8591c3f6f8b3eb6c7a654c83 Mon Sep 17 00:00:00 2001 From: Matt Roumaya Date: Mon, 6 Jun 2022 18:37:21 +0000 Subject: [PATCH 10/87] alphabetize --- R/AE_Assess.R | 2 +- R/AE_Map_Adam.R | 2 +- R/AE_Map_Raw.R | 2 +- R/Analyze_Chisq.R | 11 ++++++----- R/Analyze_Fisher.R | 12 ++++++------ R/Analyze_Poisson.R | 4 ++-- R/Analyze_Poisson_PredictBounds.R | 4 +--- R/Analyze_Wilcoxon.R | 16 ++++++++-------- R/Consent_Assess.R | 2 +- R/Consent_Map_Raw.R | 2 +- R/IE_Assess.R | 2 +- R/IE_Map_Raw.R | 2 +- R/PD_Assess.R | 2 +- R/PD_Map_Raw.R | 2 +- R/Study_Assess.R | 2 +- R/Study_AssessmentReport.R | 14 +++++++------- R/Study_Table.R | 10 +++++----- R/build-md.R | 4 ++-- R/util-CheckInputs.R | 2 +- R/util-FilterDomain.R | 2 +- R/util-MakeAssessmentList.R | 4 ++-- R/util-MergeSubjects.R | 2 +- R/util-RunAssessment.R | 2 +- R/util-is_mapping_valid.R | 12 ++++++------ 24 files changed, 59 insertions(+), 60 deletions(-) diff --git a/R/AE_Assess.R b/R/AE_Assess.R index 1a5bc5df9..f0817c7bb 100644 --- a/R/AE_Assess.R +++ b/R/AE_Assess.R @@ -43,8 +43,8 @@ #' ae_assessment_poisson <- AE_Assess(dfInput) #' ae_assessment_wilcoxon <- AE_Assess(dfInput, strMethod = "wilcoxon") #' +#' @importFrom cli cli_alert_success cli_alert_warning cli_h2 cli_text #' @importFrom purrr map map_dbl -#' @importFrom cli cli_h2 cli_text cli_alert_success cli_alert_warning #' #' @export diff --git a/R/AE_Map_Adam.R b/R/AE_Map_Adam.R index 7ed7fbe45..05b50b302 100644 --- a/R/AE_Map_Adam.R +++ b/R/AE_Map_Adam.R @@ -33,7 +33,7 @@ #' dfInput <- AE_Map_Adam(bReturnChecks = TRUE, bQuiet = FALSE) #' #' @import dplyr -#' @importFrom cli cli_h2 cli_alert_success cli_alert_warning +#' @importFrom cli cli_alert_success cli_alert_warning cli_h2 #' #' @export diff --git a/R/AE_Map_Raw.R b/R/AE_Map_Raw.R index 4e998396f..d729e15de 100644 --- a/R/AE_Map_Raw.R +++ b/R/AE_Map_Raw.R @@ -33,7 +33,7 @@ #' dfInput <- AE_Map_Raw(bReturnChecks = TRUE, bQuiet = FALSE) #' #' @import dplyr -#' @importFrom cli cli_h2 cli_alert_success cli_alert_warning +#' @importFrom cli cli_alert_success cli_alert_warning cli_h2 #' #' @export diff --git a/R/Analyze_Chisq.R b/R/Analyze_Chisq.R index 8d6d8a4f3..eae1be379 100644 --- a/R/Analyze_Chisq.R +++ b/R/Analyze_Chisq.R @@ -22,11 +22,6 @@ #' @param strOutcome `character` required, name of column in dfTransformed dataset to perform the chi-squared test on. Default is "TotalCount". #' @param bQuiet `logical` Suppress warning messages? Default: `TRUE` #' -#' @import dplyr -#' @importFrom tidyr unnest -#' @importFrom stats chisq.test -#' @importFrom purrr map -#' @importFrom broom glance #' #' @return data.frame with one row per site, columns: SiteID, TotalCount, TotalCount_Other, N, N_Other, Prop, Prop_Other, Statistic, PValue #' @@ -35,6 +30,12 @@ #' dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count") #' dfAnalyzed <- Analyze_Chisq(dfTransformed) #' +#' @import dplyr +#' @importFrom broom glance +#' @importFrom purrr map +#' @importFrom stats chisq.test +#' @importFrom tidyr unnest +#' #' @export Analyze_Chisq <- function( diff --git a/R/Analyze_Fisher.R b/R/Analyze_Fisher.R index 09405e872..7d2193974 100644 --- a/R/Analyze_Fisher.R +++ b/R/Analyze_Fisher.R @@ -22,12 +22,6 @@ #' @param strOutcome `character` required, name of column in dfTransformed dataset to perform Fisher test on. Default is "TotalCount". #' @param bQuiet `logical` Suppress warning messages? Default: `TRUE` #' -#' @import dplyr -#' @importFrom stats fisher.test -#' @importFrom purrr map -#' @importFrom broom glance -#' @importFrom tidyr unnest -#' #' @return data.frame with one row per site, columns: SiteID, TotalCount, TotalCount_Other, N, N_Other, Prop, Prop_Other, Estimate, PValue #' #' @examples @@ -35,6 +29,12 @@ #' dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count") #' dfAnalyzed <- Analyze_Fisher(dfTransformed) #' +#' @import dplyr +#' @importFrom broom glance +#' @importFrom purrr map +#' @importFrom stats fisher.test +#' @importFrom tidyr unnest +#' #' @export Analyze_Fisher <- function( diff --git a/R/Analyze_Poisson.R b/R/Analyze_Poisson.R index 7a5eee51b..424b1473a 100644 --- a/R/Analyze_Poisson.R +++ b/R/Analyze_Poisson.R @@ -28,10 +28,10 @@ #' dfAnalyzed <- Analyze_Poisson(dfTransformed) #' #' @import dplyr -#' @importFrom glue glue -#' @importFrom stats glm offset poisson pnorm #' @importFrom broom augment #' @importFrom cli cli_alert_info +#' @importFrom glue glue +#' @importFrom stats glm offset poisson pnorm #' #' @export diff --git a/R/Analyze_Poisson_PredictBounds.R b/R/Analyze_Poisson_PredictBounds.R index e3045a093..2682c676f 100644 --- a/R/Analyze_Poisson_PredictBounds.R +++ b/R/Analyze_Poisson_PredictBounds.R @@ -25,8 +25,6 @@ #' the thresholds used AE_Assess(). #' @param bQuiet `logical` Suppress warning messages? Default: `TRUE` #' -#' @importFrom stats glm offset poisson -#' #' @return data frame containing predicted boundary values with upper and lower bounds across the #' range of observed values #' @@ -35,7 +33,7 @@ #' dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strExposureCol = "Exposure") #' dfBounds <- Analyze_Poisson_PredictBounds(dfTransformed, c(-5, 5)) #' -#' @importFrom stats qchisq +#' @importFrom stats glm offset poisson qchisq #' #' @export diff --git a/R/Analyze_Wilcoxon.R b/R/Analyze_Wilcoxon.R index 4fbbacff8..5c51057d2 100644 --- a/R/Analyze_Wilcoxon.R +++ b/R/Analyze_Wilcoxon.R @@ -24,14 +24,6 @@ #' Default: `"SiteID"` #' @param bQuiet `logical` Suppress warning messages? Default: `TRUE` #' -#' @import dplyr -#' @importFrom stats wilcox.test as.formula -#' @importFrom glue glue -#' @importFrom purrr map -#' @importFrom broom glance -#' @importFrom tidyr unnest -#' @importFrom cli cli_alert_info -#' #' @return `data.frame` with one row per site, columns: SiteID, N, TotalCount, TotalExposure, Rate, #' Estimate, PValue #' @@ -40,6 +32,14 @@ #' dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strExposureCol = "Exposure") #' dfAnalyzed <- Analyze_Wilcoxon(dfTransformed, strOutcomeCol = "Rate") #' +#' @import dplyr +#' @importFrom broom glance +#' @importFrom cli cli_alert_info +#' @importFrom glue glue +#' @importFrom purrr map +#' @importFrom stats as.formula wilcox.test +#' @importFrom tidyr unnest +#' #' @export Analyze_Wilcoxon <- function( diff --git a/R/Consent_Assess.R b/R/Consent_Assess.R index 9598922c8..da384cac9 100644 --- a/R/Consent_Assess.R +++ b/R/Consent_Assess.R @@ -48,8 +48,8 @@ #' dfInput <- Consent_Map_Raw() #' consent_assessment <- Consent_Assess(dfInput) #' +#' @importFrom cli cli_alert_info cli_alert_success cli_alert_warning cli_h2 cli_text #' @importFrom purrr map map_dbl -#' @importFrom cli cli_h2 cli_text cli_alert_success cli_alert_info cli_alert_warning #' #' @export diff --git a/R/Consent_Map_Raw.R b/R/Consent_Map_Raw.R index d6f4058bd..2c9e8161b 100644 --- a/R/Consent_Map_Raw.R +++ b/R/Consent_Map_Raw.R @@ -33,7 +33,7 @@ #' dfInput <- Consent_Map_Raw(bReturnChecks = TRUE, bQuiet = FALSE) #' #' @import dplyr -#' @importFrom cli cli_h2 cli_alert_success cli_alert_warning +#' @importFrom cli cli_alert_success cli_alert_warning cli_h2 #' #' @export diff --git a/R/IE_Assess.R b/R/IE_Assess.R index 21f0498e8..f13228a40 100644 --- a/R/IE_Assess.R +++ b/R/IE_Assess.R @@ -39,8 +39,8 @@ #' ie_assessment <- IE_Assess(dfInput) #' #' @import dplyr +#' @importFrom cli cli_alert_info cli_alert_success cli_alert_warning cli_h2 cli_text #' @importFrom purrr map map_dbl -#' @importFrom cli cli_h2 cli_text cli_alert_success cli_alert_info cli_alert_warning #' #' @export diff --git a/R/IE_Map_Raw.R b/R/IE_Map_Raw.R index be36ad95f..da8b26f37 100644 --- a/R/IE_Map_Raw.R +++ b/R/IE_Map_Raw.R @@ -33,7 +33,7 @@ #' dfInput <- IE_Map_Raw(bReturnChecks = TRUE, bQuiet = FALSE) #' #' @import dplyr -#' @importFrom cli cli_h2 cli_alert_success cli_alert_warning +#' @importFrom cli cli_alert_success cli_alert_warning cli_h2 #' #' @export diff --git a/R/PD_Assess.R b/R/PD_Assess.R index 41a1614da..6ab1208f9 100644 --- a/R/PD_Assess.R +++ b/R/PD_Assess.R @@ -39,8 +39,8 @@ #' pd_assessment_poisson <- PD_Assess(dfInput) #' pd_assessment_wilcoxon <- PD_Assess(dfInput, strMethod = "wilcoxon") #' +#' @importFrom cli cli_alert_success cli_alert_warning cli_h2 cli_text #' @importFrom purrr map map_dbl -#' @importFrom cli cli_h2 cli_text cli_alert_success cli_alert_warning #' #' @export diff --git a/R/PD_Map_Raw.R b/R/PD_Map_Raw.R index 509cce003..26f7b130a 100644 --- a/R/PD_Map_Raw.R +++ b/R/PD_Map_Raw.R @@ -33,7 +33,7 @@ #' dfInput <- PD_Map_Raw(bReturnChecks = TRUE, bQuiet = FALSE) #' #' @import dplyr -#' @importFrom cli cli_h2 cli_alert_success cli_alert_warning +#' @importFrom cli cli_alert_success cli_alert_warning cli_h2 #' #' @export diff --git a/R/Study_Assess.R b/R/Study_Assess.R index 97a9d5208..0407fb53e 100644 --- a/R/Study_Assess.R +++ b/R/Study_Assess.R @@ -15,9 +15,9 @@ #' @return A list of assessments containing status information and results. #' #' @import dplyr +#' @importFrom cli cli_alert_danger #' @importFrom purrr map #' @importFrom yaml read_yaml -#' @importFrom cli cli_alert_danger #' #' @export diff --git a/R/Study_AssessmentReport.R b/R/Study_AssessmentReport.R index 5a352d9c7..a5032a023 100644 --- a/R/Study_AssessmentReport.R +++ b/R/Study_AssessmentReport.R @@ -5,19 +5,19 @@ #' @param lAssessments List of 1+ assessments like those created by `runAssessment()` or `Study_Assess()` #' @param bViewReport HTML table of dfSummary that can be viewed in most IDEs. #' -#' @importFrom fontawesome fa -#' @importFrom gt gt fmt_markdown -#' @importFrom janitor row_to_names -#' @importFrom purrr map map_df flatten pluck discard -#' @importFrom tibble enframe -#' @importFrom tidyr unnest -#' #' @return `list` Returns a list containing a data.frame summarizing the checks `dfSummary` and a dataframe listing all checks (`dfAllChecks`) #' #' @examples #' assessment <- Study_Assess() #' report <- Study_AssessmentReport(lAssessments = assessment) #' +#' @importFrom fontawesome fa +#' @importFrom gt fmt_markdown gt +#' @importFrom janitor row_to_names +#' @importFrom purrr discard flatten map map_df pluck +#' @importFrom tibble enframe +#' @importFrom tidyr unnest +#' #' @export Study_AssessmentReport <- function(lAssessments, bViewReport = FALSE) { diff --git a/R/Study_Table.R b/R/Study_Table.R index 2abbda821..da73eff40 100644 --- a/R/Study_Table.R +++ b/R/Study_Table.R @@ -9,11 +9,6 @@ #' @param bShowCounts Show site counts? Uses first value of N for each site given in dfFindings. #' @param bColCollapse Combine the Assessment and Label columns into a single "Title Column" #' -#' @import dplyr -#' @importFrom fontawesome fa -#' @importFrom stringr str_pad -#' @importFrom tidyr spread -#' #' @examples #' library(dplyr) #' library(purrr) @@ -26,6 +21,11 @@ #' #' @return `data.frame` Returns a data.frame giving assessment status (rows) by Site (column) #' +#' @import dplyr +#' @importFrom fontawesome fa +#' @importFrom stringr str_pad +#' @importFrom tidyr spread +#' #' @export Study_Table <- function(dfFindings, bFormat = TRUE, bShowCounts = TRUE, bShowSiteScore = TRUE, vSiteScoreThreshold = 1, bColCollapse = TRUE) { diff --git a/R/build-md.R b/R/build-md.R index 4a902b1c1..df48763fd 100644 --- a/R/build-md.R +++ b/R/build-md.R @@ -2,9 +2,9 @@ #' #' @param yaml_path path to adam mapping yaml #' -#' @importFrom yaml read_yaml -#' @importFrom stringr word #' @importFrom purrr map +#' @importFrom stringr word +#' @importFrom yaml read_yaml #' #' @noRd build_markdown <- function(yaml_path) { diff --git a/R/util-CheckInputs.R b/R/util-CheckInputs.R index 1ee1110ec..4a0f1bc47 100644 --- a/R/util-CheckInputs.R +++ b/R/util-CheckInputs.R @@ -18,7 +18,7 @@ #' - tests_if `list` - a named list containing status and warnings for all checks #' - status `logical` - did all checked data pass the checks? #' -#' @importFrom cli cli_h2 cli_alert_success cli_alert_warning +#' @importFrom cli cli_alert_success cli_alert_warning cli_h2 #' @importFrom purrr map map_lgl modify_if set_names #' @importFrom yaml read_yaml #' diff --git a/R/util-FilterDomain.R b/R/util-FilterDomain.R index b05bfe365..d831a5e5e 100644 --- a/R/util-FilterDomain.R +++ b/R/util-FilterDomain.R @@ -26,7 +26,7 @@ #' @return `data.frame` Data frame provided as `df` and filtered on `strColParam` == `strValParam`. #' If `bReturnChecks` is `TRUE`, a `list` is returned with a filtered `df`, and a list of checks run on input data (`lChecks`). #' -#' @importFrom cli cli_text cli_alert_info cli_alert_success cli_alert_warning +#' @importFrom cli cli_alert_info cli_alert_success cli_alert_warning cli_text #' #' @export diff --git a/R/util-MakeAssessmentList.R b/R/util-MakeAssessmentList.R index 82530ac6e..c7c14786a 100644 --- a/R/util-MakeAssessmentList.R +++ b/R/util-MakeAssessmentList.R @@ -10,12 +10,12 @@ #' @examples #' MakeAssessmentList(path = "assessments", package = "gsm") #' +#' @return `list` A list of assessments with workflow and parameter metadata. +#' #' @importFrom purrr map_chr #' @importFrom utils hasName #' @importFrom yaml read_yaml #' -#' @return `list` A list of assessments with workflow and parameter metadata. -#' #' @export MakeAssessmentList <- function(path = "assessments", package = "gsm") { diff --git a/R/util-MergeSubjects.R b/R/util-MergeSubjects.R index c52620244..1accf96c0 100644 --- a/R/util-MergeSubjects.R +++ b/R/util-MergeSubjects.R @@ -16,7 +16,7 @@ #' strIDCol = "SubjectID" #' ) #' -#' @importFrom cli cli_alert_warning cli_alert_info +#' @importFrom cli cli_alert_info cli_alert_warning #' @importFrom dplyr left_join #' @importFrom tidyr replace_na #' diff --git a/R/util-RunAssessment.R b/R/util-RunAssessment.R index e0dfdc080..47acab0b7 100644 --- a/R/util-RunAssessment.R +++ b/R/util-RunAssessment.R @@ -28,7 +28,7 @@ #' #' ae_assessment <- RunAssessment(lAssessments$ae, lData = lData, lMapping = lMapping, lTags = lTags) #' -#' @importFrom cli cli_h1 cli_h2 cli_alert_success cli_alert_warning cli_text +#' @importFrom cli cli_alert_success cli_alert_warning cli_h1 cli_h2 cli_text #' @importFrom stringr str_detect #' @importFrom yaml read_yaml #' diff --git a/R/util-is_mapping_valid.R b/R/util-is_mapping_valid.R index 175442d88..69b7eae84 100644 --- a/R/util-is_mapping_valid.R +++ b/R/util-is_mapping_valid.R @@ -8,12 +8,6 @@ #' - `spec$vNACols` - list of column parameters where NA and empty string values are acceptable. #' @param bQuiet `logical` Suppress warning messages? Default: `TRUE` #' -#' @import dplyr -#' @importFrom cli cli_alert_danger col_br_yellow -#' @importFrom purrr map map_dbl map_lgl keep -#' @importFrom stringr str_subset -#' @importFrom tidyr pivot_longer -#' #' @examples #' subj_mapping <- list( #' strIDCol = "SubjectID", @@ -42,6 +36,12 @@ #' @return `list` A list is returned with `status` (`TRUE` or `FALSE`), and `tests_if`, #' a list containing checks and a `status` and `warning` (if check does not pass). #' +#' @import dplyr +#' @importFrom cli cli_alert_danger col_br_yellow +#' @importFrom purrr keep map map_dbl map_lgl +#' @importFrom stringr str_subset +#' @importFrom tidyr pivot_longer +#' #' @export is_mapping_valid <- function(df, mapping, spec, bQuiet = TRUE) { From 3f3500323e0715de68f75dde92bf39a5583f9b1c Mon Sep 17 00:00:00 2001 From: Matt Roumaya Date: Mon, 6 Jun 2022 18:45:50 +0000 Subject: [PATCH 11/87] update DESCRIPTION --- DESCRIPTION | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index cb062fff1..905a007f6 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -21,9 +21,12 @@ Imports: glue, gt, ggplot2, + janitor, + knitr, lifecycle (>= 1.0.1), magrittr, purrr, + rmarkdown, stringr, tibble, tidyr, @@ -34,13 +37,10 @@ Suggests: covr, devtools, here, - janitor, kableExtra, - knitr, lamW, pander, rlang, - rmarkdown, safetyData, testthat (>= 3.0.0), usethis, From 5936af9a015973131b597db23743ceed18a190aa Mon Sep 17 00:00:00 2001 From: Matt Roumaya Date: Mon, 6 Jun 2022 20:33:41 +0000 Subject: [PATCH 12/87] change Rate to KRI --- R/AE_Assess.R | 2 +- R/Analyze_Poisson.R | 4 ++-- R/Analyze_Wilcoxon.R | 2 +- R/Summarize.R | 6 +++--- R/Transform_EventCount.R | 2 +- 5 files changed, 8 insertions(+), 8 deletions(-) diff --git a/R/AE_Assess.R b/R/AE_Assess.R index 00598a540..a0b313ea2 100644 --- a/R/AE_Assess.R +++ b/R/AE_Assess.R @@ -124,7 +124,7 @@ AE_Assess <- function( ) } - lAssess$dfAnalyzed <- gsm::Analyze_Wilcoxon(lAssess$dfTransformed, "Rate", bQuiet = bQuiet) + lAssess$dfAnalyzed <- gsm::Analyze_Wilcoxon(lAssess$dfTransformed, "KRI", bQuiet = bQuiet) if (!bQuiet) cli::cli_alert_success("{.fn Analyze_Wilcoxon} returned output with {nrow(lAssess$dfAnalyzed)} rows.") lAssess$dfFlagged <- gsm::Flag(lAssess$dfAnalyzed, strColumn = "PValue", vThreshold = vThreshold, strValueColumn = "Estimate") diff --git a/R/Analyze_Poisson.R b/R/Analyze_Poisson.R index c124c96bd..fb8444ceb 100644 --- a/R/Analyze_Poisson.R +++ b/R/Analyze_Poisson.R @@ -37,7 +37,7 @@ Analyze_Poisson <- function(dfTransformed, bQuiet = TRUE) { stopifnot( "dfTransformed is not a data.frame" = is.data.frame(dfTransformed), - "One or more of these columns: SiteID, N, TotalExposure, TotalCount, Rate" = all(c("SiteID", "N", "TotalExposure", "TotalCount", "Rate") %in% names(dfTransformed)), + "One or more of these columns: SiteID, N, TotalExposure, TotalCount, KRI" = all(c("SiteID", "N", "TotalExposure", "TotalCount", "KRI") %in% names(dfTransformed)), "NA value(s) found in SiteID" = all(!is.na(dfTransformed[["SiteID"]])) ) @@ -63,7 +63,7 @@ Analyze_Poisson <- function(dfTransformed, bQuiet = TRUE) { Residuals = .data$.resid, PredictedCount = .data$.fitted, ) %>% - select(.data$SiteID, .data$N, .data$TotalExposure, .data$TotalCount, .data$Rate, .data$Residuals, .data$PredictedCount) %>% + select(.data$SiteID, .data$N, .data$TotalExposure, .data$TotalCount, .data$KRI, .data$Residuals, .data$PredictedCount) %>% arrange(.data$Residuals) return(dfAnalyzed) diff --git a/R/Analyze_Wilcoxon.R b/R/Analyze_Wilcoxon.R index 8598a8716..75801f04c 100644 --- a/R/Analyze_Wilcoxon.R +++ b/R/Analyze_Wilcoxon.R @@ -37,7 +37,7 @@ #' @examples #' dfInput <- AE_Map_Raw() #' dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strExposureCol = "Exposure") -#' dfAnalyzed <- Analyze_Wilcoxon(dfTransformed, strOutcomeCol = "Rate") +#' dfAnalyzed <- Analyze_Wilcoxon(dfTransformed, strOutcomeCol = "KRI") #' #' @export diff --git a/R/Summarize.R b/R/Summarize.R index 44ec7e737..20f3a9cea 100644 --- a/R/Summarize.R +++ b/R/Summarize.R @@ -45,9 +45,9 @@ Summarize <- function(dfFlagged, strScoreCol = "PValue", lTags = NULL) { } dfSummary <- dfFlagged %>% - rename(Score = strScoreCol) %>% - select(.data$SiteID, .data$N, .data$Score, .data$Flag) %>% - arrange(desc(abs(.data$Score))) %>% + select(.data$SiteID, .data$N, strScoreCol, .data$Flag) %>% + rename(KRI = strScoreCol) %>% + arrange(desc(abs(.data$KRI))) %>% arrange(match(.data$Flag, c(1, -1, 0))) %>% bind_cols(lTags) diff --git a/R/Transform_EventCount.R b/R/Transform_EventCount.R index 5ef366f70..b58c0a0d8 100644 --- a/R/Transform_EventCount.R +++ b/R/Transform_EventCount.R @@ -73,7 +73,7 @@ Transform_EventCount <- function(dfInput, strCountCol, strExposureCol = NULL) { TotalCount = sum(.data[[strCountCol]]), TotalExposure = sum(.data[[strExposureCol]]) ) %>% - mutate(Rate = .data$TotalCount / .data$TotalExposure) + mutate(KRI = .data$TotalCount / .data$TotalExposure) } return(dfTransformed) From 09d1f9d8f070f4409f3c2bdc0b89278f78e2496b Mon Sep 17 00:00:00 2001 From: Matt Roumaya Date: Mon, 6 Jun 2022 20:55:08 +0000 Subject: [PATCH 13/87] return bStatus == FALSE --- R/util-RunAssessment.R | 64 ++++++++++++++++++++++-------------------- 1 file changed, 34 insertions(+), 30 deletions(-) diff --git a/R/util-RunAssessment.R b/R/util-RunAssessment.R index cbf57a326..3378b38c7 100644 --- a/R/util-RunAssessment.R +++ b/R/util-RunAssessment.R @@ -41,42 +41,46 @@ RunAssessment <- function(lAssessment, lData, lMapping, lTags = NULL, bQuiet = F lAssessment$lChecks <- list() lAssessment$bStatus <- TRUE - # Run through each step in lAssessment$workflow - stepCount <- 1 - for (step in lAssessment$workflow) { - if (!bQuiet) cli::cli_h2(paste0("Workflow Step ", stepCount, " of ", length(lAssessment$workflow), ": `", step$name, "`")) - if (lAssessment$bStatus) { - result <- gsm::RunStep( - lStep = step, - lMapping = lMapping, - lData = lAssessment$lData, - lTags = c(lTags, lAssessment$tags), - bQuiet = bQuiet - ) + if(exists("workflow", where = lAssessment)) { + # Run through each step in lAssessment$workflow + stepCount <- 1 + for (step in lAssessment$workflow) { + if (!bQuiet) cli::cli_h2(paste0("Workflow Step ", stepCount, " of ", length(lAssessment$workflow), ": `", step$name, "`")) + if (lAssessment$bStatus) { + result <- gsm::RunStep( + lStep = step, + lMapping = lMapping, + lData = lAssessment$lData, + lTags = c(lTags, lAssessment$tags), + bQuiet = bQuiet + ) - lAssessment$checks[[stepCount]] <- result$lChecks - names(lAssessment$checks)[[stepCount]] <- step$name - lAssessment$bStatus <- result$lChecks$status - if (result$lChecks$status) { - cli::cli_alert_success("{.fn {step$name}} Successful") - } else { - cli::cli_alert_warning("{.fn {step$name}} Failed - Skipping remaining steps") - } + lAssessment$checks[[stepCount]] <- result$lChecks + names(lAssessment$checks)[[stepCount]] <- step$name + lAssessment$bStatus <- result$lChecks$status + if (result$lChecks$status) { + cli::cli_alert_success("{.fn {step$name}} Successful") + } else { + cli::cli_alert_warning("{.fn {step$name}} Failed - Skipping remaining steps") + } - if (stringr::str_detect(step$output, "^df")) { - cli::cli_text("Saving {step$output} to `lAssessment$lData`") - lAssessment$lData[[step$output]] <- result$df + if (stringr::str_detect(step$output, "^df")) { + cli::cli_text("Saving {step$output} to `lAssessment$lData`") + lAssessment$lData[[step$output]] <- result$df + } else { + cli::cli_text("Saving {step$output} to `lAssessment`") + lAssessment[[step$output]] <- result + } } else { - cli::cli_text("Saving {step$output} to `lAssessment`") - lAssessment[[step$output]] <- result + cli::cli_text("Skipping {.fn {step$name}} ...") } - } else { - cli::cli_text("Skipping {.fn {step$name}} ...") - } - stepCount <- stepCount + 1 + stepCount <- stepCount + 1 + } + } else { + cli::cli_alert_warning("Workflow not found for {lAssessment$name} assessment - Skipping remaining steps") + lAssessment$bStatus <- FALSE } - return(lAssessment) } From 84d06613b360985095420886547579d7a25afa66 Mon Sep 17 00:00:00 2001 From: Matt Roumaya Date: Tue, 7 Jun 2022 13:50:58 +0000 Subject: [PATCH 14/87] add unit test for bStatus --- tests/testthat/test_Study_Assess.R | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/tests/testthat/test_Study_Assess.R b/tests/testthat/test_Study_Assess.R index 3e9c24c71..e0b5a4f4d 100644 --- a/tests/testthat/test_Study_Assess.R +++ b/tests/testthat/test_Study_Assess.R @@ -222,3 +222,15 @@ test_that("lSubjFilters with 0 rows returns NULL", { expect_null(tmp) }) + +test_that("correct bStatus is returned when workflow is missing", { + + custom_assessments <- MakeAssessmentList() + custom_assessments$ie$workflow <- NULL + result <- Study_Assess( + lData = lData, + lAssessments = custom_assessments + ) + + expect_false(result$ie$bStatus) +}) From 08526fa529b7d00fc9e25bbbfc37fcc1fd3bf27c Mon Sep 17 00:00:00 2001 From: Spencer Childress Date: Tue, 7 Jun 2022 11:49:20 -0400 Subject: [PATCH 15/87] fix #435 --- R/Study_Assess.R | 12 +++++++++++ tests/testthat/_snaps/Study_Assess.md | 20 +++++++++++++++++ tests/testthat/test_Study_Assess.R | 31 ++++++++++++--------------- 3 files changed, 46 insertions(+), 17 deletions(-) diff --git a/R/Study_Assess.R b/R/Study_Assess.R index 1337cf1fe..d5761df49 100644 --- a/R/Study_Assess.R +++ b/R/Study_Assess.R @@ -28,6 +28,18 @@ Study_Assess <- function( lTags = list(Study = "myStudy"), bQuiet = FALSE ) { + if (!is.null(lTags)) { + stopifnot( + "lTags is not named" = (!is.null(names(lTags))), + "lTags has unnamed elements" = all(names(lTags) != ""), + "lTags cannot contain elements named: 'Assessment', 'Label'" = !names(lTags) %in% c("Assessment", "Label") + ) + + if (any(unname(purrr::map_dbl(lTags, ~ length(.))) > 1)) { + lTags <- purrr::map(lTags, ~ paste(.x, collapse = ", ")) + } + } + #### --- load defaults --- ### # lData from clindata if (is.null(lData)) { diff --git a/tests/testthat/_snaps/Study_Assess.md b/tests/testthat/_snaps/Study_Assess.md index b0d298b6f..1dc07e91f 100644 --- a/tests/testthat/_snaps/Study_Assess.md +++ b/tests/testthat/_snaps/Study_Assess.md @@ -378,3 +378,23 @@ v `AE_Assess()` Successful Saving lResults to `lAssessment` +# incorrect lTags throw errors + + lTags is not named + +--- + + lTags is not named + +--- + + lTags has unnamed elements + +--- + + lTags cannot contain elements named: 'Assessment', 'Label' + +--- + + lTags cannot contain elements named: 'Assessment', 'Label' + diff --git a/tests/testthat/test_Study_Assess.R b/tests/testthat/test_Study_Assess.R index 3e9c24c71..596070128 100644 --- a/tests/testthat/test_Study_Assess.R +++ b/tests/testthat/test_Study_Assess.R @@ -125,8 +125,7 @@ test_that("lTags are carried through", { lTags = list( Study = "test study", Q = "Q2 2022", - Region = "Northwest", - Assessment = "none" + Region = "Northwest" ) ) @@ -134,7 +133,7 @@ test_that("lTags are carried through", { result$ae$lResults$lTags, list( Study = "test study", Q = "Q2 2022", Region = "Northwest", - Assessment = "none", Assessment = "Safety", Label = "AEs" + Assessment = "Safety", Label = "AEs" ) ) @@ -142,7 +141,7 @@ test_that("lTags are carried through", { result$consent$lResults$lTags, list( Study = "test study", Q = "Q2 2022", Region = "Northwest", - Assessment = "none", Assessment = "Consent", Label = "Consent" + Assessment = "Consent", Label = "Consent" ) ) @@ -150,7 +149,7 @@ test_that("lTags are carried through", { result$ie$lResults$lTags, list( Study = "test study", Q = "Q2 2022", Region = "Northwest", - Assessment = "none", Assessment = "IE", Label = "IE" + Assessment = "IE", Label = "IE" ) ) @@ -158,7 +157,7 @@ test_that("lTags are carried through", { result$importantpd$lResults$lTags, list( Study = "test study", Q = "Q2 2022", Region = "Northwest", - Assessment = "none", Assessment = "PD", Label = "Important PD" + Assessment = "PD", Label = "Important PD" ) ) @@ -166,7 +165,7 @@ test_that("lTags are carried through", { result$pd$lResults$lTags, list( Study = "test study", Q = "Q2 2022", Region = "Northwest", - Assessment = "none", Assessment = "PD", Label = "PD" + Assessment = "PD", Label = "PD" ) ) @@ -174,19 +173,17 @@ test_that("lTags are carried through", { result$sae$lResults$lTags, list( Study = "test study", Q = "Q2 2022", Region = "Northwest", - Assessment = "none", Assessment = "Safety", Label = "AEs Serious" + Assessment = "Safety", Label = "AEs Serious" ) ) +}) - - - # Issue #435: duplicate lTags - # result <- Study_Assess(lData = lData, - # lTags = list(Study = "test study", - # Q = "Q2 2022", - # Region = "Northwest", - # Assessment = "none", - # Label = "my label")) +test_that("incorrect lTags throw errors", { + expect_snapshot_error(Study_Assess(lTags = "hi mom")) + expect_snapshot_error(Study_Assess(lTags = list("hi", "mom"))) + expect_snapshot_error(Study_Assess(lTags = list(greeting = "hi", "mom"))) + expect_snapshot_error(Study_Assess(lTags = list(Assessment = "this is not an assessment"))) + expect_snapshot_error(Study_Assess(lTags = list(Label = "this is not a label"))) }) test_that("Map + Assess yields same result as Study_Assess()", { From 5fd598df2fc74db8571f2772dc774ba283a90528 Mon Sep 17 00:00:00 2001 From: Matt Roumaya Date: Tue, 7 Jun 2022 15:53:19 +0000 Subject: [PATCH 16/87] don't importFrom dplyr --- NAMESPACE | 3 --- R/util-MergeSubjects.R | 1 - R/util-generate_md_table.R | 1 - R/util-parse_data_spec.R | 1 - 4 files changed, 6 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index a2239c94d..bffbe6ee3 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -48,9 +48,6 @@ importFrom(cli,cli_h1) importFrom(cli,cli_h2) importFrom(cli,cli_text) importFrom(cli,col_br_yellow) -importFrom(dplyr,bind_rows) -importFrom(dplyr,left_join) -importFrom(dplyr,right_join) importFrom(fontawesome,fa) importFrom(glue,glue) importFrom(gt,fmt_markdown) diff --git a/R/util-MergeSubjects.R b/R/util-MergeSubjects.R index 1accf96c0..2650d4cdf 100644 --- a/R/util-MergeSubjects.R +++ b/R/util-MergeSubjects.R @@ -17,7 +17,6 @@ #' ) #' #' @importFrom cli cli_alert_info cli_alert_warning -#' @importFrom dplyr left_join #' @importFrom tidyr replace_na #' #' @export diff --git a/R/util-generate_md_table.R b/R/util-generate_md_table.R index ff1828818..06f123a5a 100644 --- a/R/util-generate_md_table.R +++ b/R/util-generate_md_table.R @@ -10,7 +10,6 @@ #' @param out_path `character` file path of .md file #' @param header `character` section header #' -#' @importFrom dplyr right_join #' @importFrom knitr kable #' #' @export diff --git a/R/util-parse_data_spec.R b/R/util-parse_data_spec.R index f98c54b96..1095b0202 100644 --- a/R/util-parse_data_spec.R +++ b/R/util-parse_data_spec.R @@ -5,7 +5,6 @@ #' @param content `list` data specification #' @param file `character` file path of .yaml file #' -#' @importFrom dplyr bind_rows #' @importFrom purrr reduce #' @importFrom tibble tibble #' @importFrom yaml read_yaml From 16f03e98a26cde32a6187a0252fa838d59d90dd0 Mon Sep 17 00:00:00 2001 From: Spencer Childress Date: Tue, 7 Jun 2022 12:31:26 -0400 Subject: [PATCH 17/87] fix #498 --- vignettes/{ => articles}/ContributorGuidelines.Rmd | 0 vignettes/{ => articles}/Qualification.Rmd | 1 + vignettes/{ => articles}/QualificationWorkflow.Rmd | 0 3 files changed, 1 insertion(+) rename vignettes/{ => articles}/ContributorGuidelines.Rmd (100%) rename vignettes/{ => articles}/Qualification.Rmd (99%) rename vignettes/{ => articles}/QualificationWorkflow.Rmd (100%) diff --git a/vignettes/ContributorGuidelines.Rmd b/vignettes/articles/ContributorGuidelines.Rmd similarity index 100% rename from vignettes/ContributorGuidelines.Rmd rename to vignettes/articles/ContributorGuidelines.Rmd diff --git a/vignettes/Qualification.Rmd b/vignettes/articles/Qualification.Rmd similarity index 99% rename from vignettes/Qualification.Rmd rename to vignettes/articles/Qualification.Rmd index 14a96f1c0..2ca11ab73 100644 --- a/vignettes/Qualification.Rmd +++ b/vignettes/articles/Qualification.Rmd @@ -75,6 +75,7 @@ for (a in assessments){ select(-Assessment) create_assessment_section(a, a_df) } +print(here::here()) ``` # Unit Tests diff --git a/vignettes/QualificationWorkflow.Rmd b/vignettes/articles/QualificationWorkflow.Rmd similarity index 100% rename from vignettes/QualificationWorkflow.Rmd rename to vignettes/articles/QualificationWorkflow.Rmd From 8c2fb6c166b2c76d53099778f268cbe61af4e673 Mon Sep 17 00:00:00 2001 From: Spencer Childress Date: Tue, 7 Jun 2022 13:06:49 -0400 Subject: [PATCH 18/87] remove stray --- vignettes/articles/Qualification.Rmd | 1 - 1 file changed, 1 deletion(-) diff --git a/vignettes/articles/Qualification.Rmd b/vignettes/articles/Qualification.Rmd index 2ca11ab73..14a96f1c0 100644 --- a/vignettes/articles/Qualification.Rmd +++ b/vignettes/articles/Qualification.Rmd @@ -75,7 +75,6 @@ for (a in assessments){ select(-Assessment) create_assessment_section(a, a_df) } -print(here::here()) ``` # Unit Tests From 8c9d05c4becd9bbb28ac9068a0e9f71804aa7deb Mon Sep 17 00:00:00 2001 From: Spencer Childress Date: Tue, 7 Jun 2022 13:13:29 -0400 Subject: [PATCH 19/87] update .Rbuildignore to... ignore vignettes/articles/ --- .Rbuildignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.Rbuildignore b/.Rbuildignore index 5ffd7122c..9c9dcf368 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -4,6 +4,7 @@ ^codecov\.yml$ ^doc$ ^Meta$ +^vignettes/articles$ ^vignettes/qualification\.Rmd$ ^vignettes/qualification\.log$ ^_pkgdown\.yml$ From 9a011cab58046c6db929a173b942c106e784d1e9 Mon Sep 17 00:00:00 2001 From: Jeremy Wildfire Date: Tue, 7 Jun 2022 14:33:07 -0400 Subject: [PATCH 20/87] updates to data pipeline vignette. fix #505 --- vignettes/DataPipeline.Rmd | 285 ++++++++++++------------------------- 1 file changed, 91 insertions(+), 194 deletions(-) diff --git a/vignettes/DataPipeline.Rmd b/vignettes/DataPipeline.Rmd index bdebdfa47..9fb6169cf 100644 --- a/vignettes/DataPipeline.Rmd +++ b/vignettes/DataPipeline.Rmd @@ -16,103 +16,115 @@ knitr::opts_chunk$set( ``` # Intro -The {gsm} package provides a standardized workflow that leverages Key Risk Indicators (KRIs) and -thresholds to conduct study-level Risk Based Monitoring (RBM) for clinical trials. This vignette -provides an overview of the {gsm} data model. First, we provide an overview of standardized data -pipeline used to calculate KRIs and evaluate thresholds to set site-level flags. We also discuss -workflows and reports that allow users to run multiple KRIs concurrently on a study. +The {gsm} package provides a standardized workflow that leverages Key Risk Indicators (KRIs) and thresholds to conduct study-level Risk Based Monitoring (RBM) for clinical trials. This vignette provides an overview of the {gsm} data model. First, we provide an overview of standardized data pipeline used to calculate KRIs and evaluate thresholds to set site-level flags. We also discuss workflows and reports that allow users to run multiple KRIs concurrently on a study. # KRI Data Pipeline image -In the context of clinical research a KRI is a measure of risk associated with the conduct of a -clinical trial. Examples of KRIs include the rate of adverse events or amount of missing data at a -site or across sites. Defining and deploying KRIs during study start-up allows sponsors to -continually monitor risks to the integrity of the trial and take corrective actions accordingly. +In the context of clinical research a KRI, is a measure of risk associated with the conduct of a clinical trial. Examples of KRIs include the rate of adverse events or amount of missing data at a site or across sites. Defining and deploying KRIs during study start-up allows sponsors to continually monitor risks to the integrity of the trial and take corrective actions accordingly. -The KRI data pipeline begins with one or more clinical datasets related to the KRI. An optional -participant-level subset is then applied to each dataset before aggregating by participant to -quantify the KRI at the participant level. This aggregated dataset is then further summarized by -site to obtain site-level metrics. +The KRI data pipeline begins with one or more clinical datasets related to the KRI. An optional participant-level subset is then applied to each dataset before aggregating by participant to quantify the KRI at the participant level. This aggregated dataset is then further summarized by site to obtain site-level metrics. ## Assessment Data Pipeline image -The image above provides an overview of the KRI assessment pipeline. The pipeline is a standardized -four-step process for **assessing** data issues by going from participant-level `input` data to a -standardized site-level `summary` of model results. The functions used in each step of the data -pipeline along with the input and output datasets are described in more detail below. +The image above provides an overview of the KRI assessment pipeline. The pipeline is a standardized four-step process for **assessing** data issues by going from participant-level `input` data to a standardized site-level `summary` of model results. The functions used in each step of the data pipeline along with the input and output datasets are described in more detail below. 1. `input` data - Cross-domain participant-level input data with all needed data for KRI derivation. -2. `transformed` data - Site-level transformed data including KRI calculation. Created by - `Transform` functions. +2. `transformed` data - Site-level transformed data including KRI calculation. Created by `Transform` functions. 3. `analyzed` data - Site-level analysis result data. Created by `Analyze` functions. -4. `flagged` data - Site-level analysis results with flags added. Created by passing numeric - `thresholds` to a `Flag` function. -5. `summary` data - Standardized subset the flagged data. This summary data has the same structure - for all assessments and always includes both `KRI` and `Flag` values so that we can easily look - at trends for any given site across multiple assessments. Created using a `Summarize` Function. +4. `flagged` data - Site-level analysis results with flags added. Created by passing numeric `thresholds` to a `Flag` function. +5. `summary` data - Standardized subset the flagged data. This summary data has the same structure for all assessments and always includes both `KRI` and `Flag` values so that we can easily look at trends for any given site across multiple assessments. Created using a `Summarize` Function. -Finally, each assessment has an `Assess` function that sequentially executes all 4 of the functions -and returns a list containing all 5 data sets listed above. +Finally, each assessment has an `Assess` function that sequentially executes all 4 of the functions and returns a list containing all 5 data sets listed above. ## Generating `input` data -Creating input data is outside the scope of the assessment pipeline. The specifications for `input` -data are designed so that the data can easily be generated from multiple clinical data standards -(e.g. Raw, ADaM or SDTM). Most assessments have `Map` functions that can be used to generate `input` -data. For example, the Adverse Event assessment has 2 map functions, `AE_Map_Raw()` and -`AE_Map_Adam()` which create `input` data from Raw and ADaM data respectively. - -These `map` functions are provided for convenience but may not work for all clinical studies. When -no `map` function is available for a given assessment, the user is expected to manually create -`input` data following the specifications for that assessment. - -# Appendix - -## Metadata Technical Specifications - -Running multiple assessments in {gsm} involves a number of YAML files that provide metadata to -orchestrate the workflow that is triggered by `Study_Assess()`. The YAML file for any given -assessment provides expected values for the names of input data, required columns, column properties -(e.g. unique values or non-missing values), and optionally one or more subsets. - -Below is an overview of each YAML specification for the Adverse Events assessment. - -### Assessment Specification - -Below is an example assessment specification in YAML format for the Adverse Events assessment, as -well as a nested list describing the required metadata that can be customized as needed. - -* `label`: Label used to describe the assessment, in this case "Treatment-Emergent Adverse Events" -* `tags`: Labels to be appended as a column to summary data. The first value will be the column - name, and the second value will be the row value for all rows in the summary data. - * `Assessment`: Creates a column "Assessment" with the value "Safety" in the summary data. - * `Label`: Creates a column "Label" with the value "AEs" in the summary data. -* `workflow`: The workflow specification begins the steps in a given assessment. - * `-name`: Initiates the {gsm} function FilterDomain(). - * `inputs`: Specifies the required input data for FilterDomain(). - * `output`: Specifies the required output data for FilterDomain() to be used as input data in - the next step in the workflow. - * `params`: Specifies parameters to be passed to FilterDomain(). - * `strDomain`: Specifies the domain that will be filtered. - * `strColParam`: Specifies that the strTreatmentEmergentCol will be used to filter dfAE. - * `strValParam`: Specifies the value that strTreatmentEmergentCol will be filtered on. - * `-name`: Initiates the {gsm} function AE_Map_Raw(). - * `inputs`: Because AE_Map_Raw() requires two inputs, a colon is used to list multiple inputs. - * `-dfAE`: Specifies event-level data to be used in AE_Map_Raw(). - * `-dfSUBJ`: Specifies subject-level data to be used in AE_Map_Raw(). - * `output`: Specifies the required output data for AE_Map_Raw() to be used as input data in the - next step in the workflow. - * `-name`: Initiates the {gsm} function AE_Assess(). - * `inputs`: Specifies the required input data for AE_Assess(). - * `output`: Specifies the required output data for AE_Assess(). - * `params`: Specifies parameters to be passed to AE_Assess(). - * `strMethod`: Specifies that a Poisson model will be used in AE_Assess(). - -**The nested list (above) describes the Assessment YAML mapping (below).** +Creating input data is outside the scope of the assessment pipeline. The specifications for `input` data are designed so that the data can easily be generated from multiple clinical data standards (e.g. Raw, ADaM or SDTM). Most assessments have `Map` functions that can be used to generate `input` data. For example, the Adverse Event assessment has 2 map functions, `AE_Map_Raw()` and `AE_Map_Adam()` which create `input` data from Raw and ADaM data respectively. + +These `map` functions are provided for convenience but may not work for all clinical studies. When no `map` function is available for a given assessment, the user is expected to manually create `input` data following the specifications for that assessment. + +# Running Multiple Assessments + +Running multiple assessments for a single study is a common use case and {gsm} provides workflow and reporting functions to streamline this process. + +`Study_Assess()` attempts to run one or more assessment workflows using shared data and metadata. The metadata used for this study-level assessment is described in detail in this appendix for this vignette. The function returns a a list of assessments containing status information and results that is used as input for the reporting functions described below. +`Study_Assess`. + +`Study_Report()` creates a detailed report showing both charts and listings summarizing each KRI that was run for the study along with a study-level table (via `Study_Table()`) and a summary of the workflow run to generate each KRI (via `Study_AssessmentTable()`) + +To see a sample report, simply run: + +``` +results<-Study_Assess() +StudyReport(results) +``` + +Many additional examples are provided in the `Cookbook` Vignette. + +# Appendix 1 - Metadata Technical Specifications + +{gsm} has several standardized metadata models that are use to facilitate a standardized, reusable workflow for RBM. The default metadata used by the package are stored as YAML files in the `inst` folder, and can be customized for any given study. Detailed specification for each type of metadata is provided below, and example data for the AE domain is provided. + +## Data Specification Metadata + +Input data specifications define the data requirements for a given {gsm} function and are saved in `inst/specs`. Each spec lists the data domains required for the function defines the following parameters for each domain: + +- `vRequired` - list of parameters that should be defined in `mapping` (see more details in the following section). +- `vUniqueCols` - list of column parameters that should not contain duplicate values +- `vNACols` - list of column parameters where NA and empty string values are acceptable. + +The specification for the AE mapping function (`inst/mapping/AE_Map_Raw.yaml`) is shown below: + +``` +dfAE: + vRequired: + - strIDCol +dfSUBJ: + vRequired: + - strIDCol + - strSiteCol + - strTimeOnTreatmentCol + vUniqueCols: + - strIDCol +``` + +## Data Mappings Metadata + +Mapping Specifications in {gsm} define a "mapping" of column and field-level inputs needed for function. This mapping can be used in combination with a specification to confirm that input data meets the requirements for a function. + +Each mapping object lists the required parameters for all required data domains and specifies the column and field values for specific data sets. For example, the following could be passed to the `mapping` parameter for `AE_Map_Raw` for use with `clindata::rawplus_AE` and `clindata::rawplus_SUBJ`: + +``` +list( + dfAE=list(strIDCol= 'SubjectID'), + dfSUBJ= list( + strIDCol= 'SubjectID', + strSiteCol= 'SiteID', + strTimeOnTreatmentCol= 'TimeOnTreatment' + ) +) +``` + +Note that `Study_Assess` is designed to share a `mapping` object across multiple assessments. The default mapping is saved as `clindata::mapping_rawplus`, but users can also create a custom mapping object for thier use cases. + +## Assessment Workflow Metadata + +Assessment Workflow Metadata objects are passed to the `lAssessments` parameter in `Study_Assess` to define functions and parameters (including `mappings` and `specs`) across multiple studies. + +The `lAssessment` object is a named list of metadata defining how each assessment should be run. By default, `MakeAssessmentList()` imports YAML specifications from `inst/assessments`. Each item in `lAssessments` expects the following parameters. + +- `label`: Label used to describe the assessmens. +- `tags`: Labels to be appended as a column to summary data. +- `workflow`: Array defining one or more functions to be executed as part of the workflow for a given assessment. + - `workflow[]$name`: name of the {gsm} function. + - `workflow[]$inputs`: Specifies the required input data. + - `workflow[]$output`: Specifies the output data from the workflow step; can be used as an input in the next step in the workflow. + - `workflow[]$params`: Specifies parameters to be passed to the function. + +For example, the assessment for the AE (`inst/assessments/ae.yaml`) is shown below: ``` label: Treatment-Emergent Adverse Events @@ -138,118 +150,3 @@ workflow: params: strMethod: "poisson" ``` - -### Mapping Specification - -Below is an example mapping specification in YAML format for the Adverse Events assessment, as well -as a nested list describing the required metadata. - -* `dfInput`: Top-level description that specifies the name of the required input for `AE_Assess()` - * `strIDCol`: Specifies that the ID column is named `SubjectID` - * `strSiteCol`: Specifies that the Site ID column is named `SiteID` - * `strCountCol`: Specifies that the Count column is named `Count` - * `strExposureCol`: Specifies that the Exposure column is named `Exposure` - * `strRateCol`: Specifies that the Rate column is named `Rate` - -**The nested list (above) describes the Mapping YAML mapping (below).** - -``` -dfInput: - strIDCol: "SubjectID" - strSiteCol: "SiteID" - strCountCol: "Count" - strExposureCol: "Exposure" - strRateCol: "Rate" -``` - -### Input Data Specification - -Below is an example input data specification in YAML format for the Adverse Events assessment, as -well as a nested list describing the required metadata that can be customized as needed. - -* `dfInput`: Top-level description that specifies the name of the required input for `AE_Assess()`. - * `vRequired`: Specifies required columns for `dfInput` in the `AE_Assess()` function. - * `- "strIDCol"`: Notes that strIDCol is required. The column name for strIDCol is specified in - the Mapping YAML file. - * `- "strSiteCol"`: Notes that strSiteCol is required. The column name for strSiteCol is - specified in the Mapping YAML file. - * `- "strCountCol"`: Notes that strCountCol is required. The column name for strCountCol is - specified in the Mapping YAML file. - * `- "strExposureCol"`: Notes that strExposureCol is required. The column name for - strExposureCol is specified in the Mapping YAML file. - * `- "strRateCol"`: Notes that strRateCol is required. The column name for strRateCol is - specified in the Mapping YAML file. - * `vUniqueCols`: Specifies columns that must contain unique values for dfInput in the - `AE_Assess()` function. - * `- "strIDCol"`: Notes that strIDCol must contain unique values. The column name for strIDCol - is specified in the Mapping YAML file. - -**The nested list (above) describes the Input Data YAML mapping (below).** - -``` -dfInput: - vRequired: - - "strIDCol" - - "strSiteCol" - - "strCountCol" - - "strExposureCol" - - "strRateCol" - vUniqueCols: - - "strIDCol" -``` - -### Supported Assessment Mapping - -In addition to the specific mapping for Adverse Events above, the {clindata} package contains a YAML -mapping that is converted to a list for all supported assessments in {gsm}, with key-value pairs for -required columns. - -`clindata::mapping_rawplus` provides the default mapping passed to `lMapping` in the -`gsm::Study_Assess` function: - -```r -lMapping <- list( - dfSUBJ = list( - strIDCol = "SubjectID", - strSiteCol = "SiteID", - strTimeOnTreatmentCol = "TimeOnTreatment", - strTimeOnStudyCol = "TimeOnStudy", - strRandFlagCol = "RandFlag", - strRandDateCol = "RandDate", - strStudyCompletionFlagCol = "StudCompletion", - strStudyDiscontinuationReasonCol = "StudDCReason", - strTreatmentCompletionFlagCol = "TrtCompletion", - strTreatmentDiscontinuationReasonCol = "TrtDCReason" - ), - dfAE = list( - strIDCol = "SubjectID", - strTreatmentEmergentCol = "AE_TE_FLAG", - strTreatmentEmergentVal = TRUE, - strGradeCol = "AE_GRADE", - strSeriousCol = "AE_SERIOUS", - strSeriousVal = "Yes" - ), - dfPD = list( - strIDCol = "SubjectID", - strCategoryCol = "PD_CATEGORY", - strImportantCol = "PD_IMPORTANT_FLAG", - strImportantVal = "Y" - ), - dfIE = list( - strIDCol = "SubjectID", - strCategoryCol = "IE_CATEGORY", - strValueCol = "IE_VALUE", - strVersionCol = "IE_PROTOCOLVERSION", - vCategoryValues = c("EXCL", "INCL"), - vExpectedResultValues = 0:1 - ), - dfCONSENT = list( - strIDCol = "SubjectID", - strTypeCol = "CONSENT_TYPE", - strValueCol = "CONSENT_VALUE", - strDateCol = "CONSENT_DATE", - strConsentTypeValue = "MAINCONSENT", - strConsentStatusValue = "Y" - ) -) -``` From 4f66741dc1d6db48907dfe1bb49423a073a0ca31 Mon Sep 17 00:00:00 2001 From: Matt Roumaya Date: Tue, 7 Jun 2022 21:04:59 +0000 Subject: [PATCH 21/87] add KRI and Score cols --- R/AE_Assess.R | 8 ++++---- R/Analyze_Poisson.R | 22 ++++++++++++++++++---- R/Analyze_Wilcoxon.R | 7 ++++++- R/Consent_Assess.R | 12 ++++++++---- R/Flag.R | 8 ++++---- R/IE_Assess.R | 12 ++++++++---- R/PD_Assess.R | 8 ++++---- R/Summarize.R | 17 ++++++++++++----- R/Transform_EventCount.R | 23 ++++++++++++++++++++--- 9 files changed, 84 insertions(+), 33 deletions(-) diff --git a/R/AE_Assess.R b/R/AE_Assess.R index 62751c1f5..31dca0893 100644 --- a/R/AE_Assess.R +++ b/R/AE_Assess.R @@ -110,10 +110,10 @@ AE_Assess <- function( lAssess$dfAnalyzed <- gsm::Analyze_Poisson(lAssess$dfTransformed, bQuiet = bQuiet) if (!bQuiet) cli::cli_alert_success("{.fn Analyze_Poisson} returned output with {nrow(lAssess$dfAnalyzed)} rows.") - lAssess$dfFlagged <- gsm::Flag(lAssess$dfAnalyzed, strColumn = "Residuals", vThreshold = vThreshold) + lAssess$dfFlagged <- gsm::Flag(lAssess$dfAnalyzed, vThreshold = vThreshold) if (!bQuiet) cli::cli_alert_success("{.fn Flag} returned output with {nrow(lAssess$dfFlagged)} rows.") - lAssess$dfSummary <- gsm::Summarize(lAssess$dfFlagged, strScoreCol = "Residuals", lTags) + lAssess$dfSummary <- gsm::Summarize(lAssess$dfFlagged, lTags = lTags) if (!bQuiet) cli::cli_alert_success("{.fn Summarize} returned output with {nrow(lAssess$dfSummary)} rows.") } else if (strMethod == "wilcoxon") { if (is.null(vThreshold)) { @@ -130,10 +130,10 @@ AE_Assess <- function( lAssess$dfAnalyzed <- gsm::Analyze_Wilcoxon(lAssess$dfTransformed, "KRI", bQuiet = bQuiet) if (!bQuiet) cli::cli_alert_success("{.fn Analyze_Wilcoxon} returned output with {nrow(lAssess$dfAnalyzed)} rows.") - lAssess$dfFlagged <- gsm::Flag(lAssess$dfAnalyzed, strColumn = "PValue", vThreshold = vThreshold, strValueColumn = "Estimate") + lAssess$dfFlagged <- gsm::Flag(lAssess$dfAnalyzed, vThreshold = vThreshold, strValueColumn = "Estimate") if (!bQuiet) cli::cli_alert_success("{.fn Flag} returned output with {nrow(lAssess$dfFlagged)} rows.") - lAssess$dfSummary <- gsm::Summarize(lAssess$dfFlagged, strScoreCol = "PValue", lTags = lTags) + lAssess$dfSummary <- gsm::Summarize(lAssess$dfFlagged, lTags = lTags) if (!bQuiet) cli::cli_alert_success("{.fn Summarize} returned output with {nrow(lAssess$dfSummary)} rows.") } diff --git a/R/Analyze_Poisson.R b/R/Analyze_Poisson.R index 679792bbe..6a9afe441 100644 --- a/R/Analyze_Poisson.R +++ b/R/Analyze_Poisson.R @@ -18,6 +18,7 @@ #' - `Rate` - Rate of exposure (TotalCount / TotalExposure) #' #' @param dfTransformed data.frame in format produced by \code{\link{Transform_EventCount}}. Must include SubjectID, SiteID, TotalCount and TotalExposure. +#' @param strScoreLabel Optional. `character` vector to describe the `Score` column. Default: `Residuals` #' @param bQuiet `logical` Suppress warning messages? Default: `TRUE` #' #' @return input data.frame with columns added for "Residuals" and "PredictedCount" @@ -35,7 +36,7 @@ #' #' @export -Analyze_Poisson <- function(dfTransformed, bQuiet = TRUE) { +Analyze_Poisson <- function(dfTransformed, strScoreLabel = "Residuals", bQuiet = TRUE) { stopifnot( "dfTransformed is not a data.frame" = is.data.frame(dfTransformed), "One or more of these columns: SiteID, N, TotalExposure, TotalCount, KRI" = all(c("SiteID", "N", "TotalExposure", "TotalCount", "KRI") %in% names(dfTransformed)), @@ -61,11 +62,24 @@ Analyze_Poisson <- function(dfTransformed, bQuiet = TRUE) { dfAnalyzed <- broom::augment(cModel, dfModel, type.predict = "response") %>% rename( - Residuals = .data$.resid, + Score = .data$.resid, PredictedCount = .data$.fitted, ) %>% - select(.data$SiteID, .data$N, .data$TotalExposure, .data$TotalCount, .data$KRI, .data$Residuals, .data$PredictedCount) %>% - arrange(.data$Residuals) + mutate( + ScoreLabel = ifelse(is.null(strScoreLabel), NA_character_, strScoreLabel) + ) %>% + select( + .data$SiteID, + .data$N, + .data$TotalExposure, + .data$TotalCount, + .data$KRI, + .data$KRILabel, + .data$Score, + .data$ScoreLabel, + .data$PredictedCount + ) %>% + arrange(.data$Score) return(dfAnalyzed) } diff --git a/R/Analyze_Wilcoxon.R b/R/Analyze_Wilcoxon.R index 1beeac93d..95272d00b 100644 --- a/R/Analyze_Wilcoxon.R +++ b/R/Analyze_Wilcoxon.R @@ -22,6 +22,7 @@ #' @param strOutcomeCol `character` Column name of outcome in `dfTransformed` to analyze. #' @param strPredictorCol `character` Column name of predictor in `dfTransformed` to analyze. #' Default: `"SiteID"` +#' @param strScoreLabel Optional. `character` vector to describe the `Score` column. Default: `Residual` #' @param bQuiet `logical` Suppress warning messages? Default: `TRUE` #' #' @return `data.frame` with one row per site, columns: SiteID, N, TotalCount, TotalExposure, Rate, @@ -46,6 +47,7 @@ Analyze_Wilcoxon <- function( dfTransformed, strOutcomeCol = NULL, strPredictorCol = "SiteID", + strScoreLabel = "PValue", bQuiet = TRUE ) { stopifnot( @@ -126,6 +128,9 @@ Analyze_Wilcoxon <- function( return( dfAnalyzed %>% - select(names(dfTransformed), .data$Estimate, .data$PValue) + select(names(dfTransformed), .data$Estimate, Score = .data$PValue) %>% + mutate( + ScoreLabel = ifelse(is.null(strScoreLabel), NA_character_, strScoreLabel) + ) ) } diff --git a/R/Consent_Assess.R b/R/Consent_Assess.R index da384cac9..47691852b 100644 --- a/R/Consent_Assess.R +++ b/R/Consent_Assess.R @@ -24,6 +24,7 @@ #' @param dfInput `data.frame` Input data, a data frame with one record per subject. #' @param nThreshold `numeric` Threshold specification. Default: `0.5` #' @param lTags `list` Assessment tags, a named list of tags describing the assessment that defaults to `list(Assessment="IE")`. `lTags` is returned as part of the assessment (`lAssess$lTags`) and each tag is added as a column in `lAssess$dfSummary`. +#' @param strScoreLabel Optional. `character` vector to describe the `Score` column. Default: `Total Event Count` #' @param bChart `logical` Generate data visualization? Default: `TRUE` #' @param bReturnChecks `logical` Return input checks from `is_mapping_valid`? Default: `FALSE` #' @param bQuiet `logical` Suppress warning messages? Default: `TRUE` @@ -57,6 +58,7 @@ Consent_Assess <- function( dfInput, nThreshold = 0.5, lTags = list(Assessment = "Consent"), + strScoreLabel = "Total Event Count", bChart = TRUE, bReturnChecks = FALSE, bQuiet = TRUE @@ -99,13 +101,15 @@ Consent_Assess <- function( lAssess$dfTransformed <- gsm::Transform_EventCount(lAssess$dfInput, strCountCol = "Count") if (!bQuiet) cli::cli_alert_success("{.fn Transform_EventCount} returned output with {nrow(lAssess$dfTransformed)} rows.") - lAssess$dfAnalyzed <- lAssess$dfTransformed %>% dplyr::mutate(Estimate = .data$TotalCount) - if (!bQuiet) cli::cli_alert_info("No analysis function used. {.var dfTransformed} copied directly to {.var dfAnalyzed}") + lAssess$dfAnalyzed <- lAssess$dfTransformed %>% + dplyr::mutate(Score = .data$TotalCount, + ScoreLabel = ifelse(is.null(strScoreLabel), NA_character_, strScoreLabel)) + if (!bQuiet) cli::cli_alert_info("No analysis function used. {.var dfTransformed} copied directly to {.var dfAnalyzed} with added {.var ScoreLabel} column.") - lAssess$dfFlagged <- gsm::Flag(lAssess$dfAnalyzed, vThreshold = c(NA, nThreshold), strColumn = "Estimate") + lAssess$dfFlagged <- gsm::Flag(lAssess$dfAnalyzed, vThreshold = c(NA, nThreshold)) if (!bQuiet) cli::cli_alert_success("{.fn Flag} returned output with {nrow(lAssess$dfFlagged)} rows.") - lAssess$dfSummary <- gsm::Summarize(lAssess$dfFlagged, strScoreCol = "TotalCount", lTags) + lAssess$dfSummary <- gsm::Summarize(lAssess$dfFlagged, lTags = lTags) if (!bQuiet) cli::cli_alert_success("{.fn Summarize} returned output with {nrow(lAssess$dfSummary)} rows.") if (bChart) { diff --git a/R/Flag.R b/R/Flag.R index 7ed50b108..318f09f5a 100644 --- a/R/Flag.R +++ b/R/Flag.R @@ -32,12 +32,12 @@ #' #' @examples #' dfInput <- AE_Map_Adam() -#' dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strExposureCol = "Exposure") -#' dfAnalyzed <- Analyze_Wilcoxon(dfTransformed, "Rate") +#' dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strExposureCol = "Exposure", strKRILabel = "AEs/Site Per Week") +#' dfAnalyzed <- Analyze_Wilcoxon(dfTransformed, "KRI") #' dfFlagged <- Flag(dfAnalyzed) # PValue < 0.05 flagged #' dfFlagged10 <- Flag(dfAnalyzed, vThreshold = c(0.10, NA)) # PValue <0.10 flagged #' # Flag direction set based on 'Statistic' column -#' dfFlagged <- Flag(dfAnalyzed, strColumn = "PValue", strValueColumn = "Estimate") +#' dfFlagged <- Flag(dfAnalyzed, strColumn = "Score", strValueColumn = "Estimate") #' #' @import dplyr #' @importFrom stats median @@ -46,7 +46,7 @@ Flag <- function( dfAnalyzed, - strColumn = "PValue", + strColumn = "Score", vThreshold = c(0.05, NA), strValueColumn = NULL ) { diff --git a/R/IE_Assess.R b/R/IE_Assess.R index f13228a40..1498981c6 100644 --- a/R/IE_Assess.R +++ b/R/IE_Assess.R @@ -14,6 +14,7 @@ #' @param dfInput `data.frame` Input data, a data frame with one record per subject. #' @param nThreshold `numeric` Threshold specification. Default: `0.5` #' @param lTags `list` Assessment tags, a named list of tags describing the assessment that defaults to `list(Assessment="IE")`. `lTags` is returned as part of the assessment (`lAssess$lTags`) and each tag is added as a column in `lAssess$dfSummary`. +#' @param strScoreLabel Optional. `character` vector to describe the `Score` column. Default: `Total Event Count` #' @param bChart `logical` Generate data visualization? Default: `TRUE` #' @param bReturnChecks `logical` Return input checks from `is_mapping_valid`? Default: `FALSE` #' @param bQuiet `logical` Suppress warning messages? Default: `TRUE` @@ -48,6 +49,7 @@ IE_Assess <- function( dfInput, nThreshold = 0.5, lTags = list(Assessment = "IE"), + strScoreLabel = "Total Event Count", bChart = TRUE, bReturnChecks = FALSE, bQuiet = TRUE @@ -90,13 +92,15 @@ IE_Assess <- function( lAssess$dfTransformed <- gsm::Transform_EventCount(lAssess$dfInput, strCountCol = "Count") if (!bQuiet) cli::cli_alert_success("{.fn Transform_EventCount} returned output with {nrow(lAssess$dfTransformed)} rows.") - lAssess$dfAnalyzed <- lAssess$dfTransformed %>% dplyr::mutate(Estimate = .data$TotalCount) - if (!bQuiet) cli::cli_alert_info("No analysis function used. {.var dfTransformed} copied directly to {.var dfAnalyzed}") + lAssess$dfAnalyzed <- lAssess$dfTransformed %>% + dplyr::mutate(Score = .data$TotalCount, + ScoreLabel = ifelse(is.null(strScoreLabel), NA_character_, strScoreLabel)) + if (!bQuiet) cli::cli_alert_info("No analysis function used. {.var dfTransformed} copied directly to {.var dfAnalyzed} with added {.var ScoreLabel} column.") - lAssess$dfFlagged <- gsm::Flag(lAssess$dfAnalyzed, vThreshold = c(NA, nThreshold), strColumn = "Estimate") + lAssess$dfFlagged <- gsm::Flag(lAssess$dfAnalyzed, vThreshold = c(NA, nThreshold)) if (!bQuiet) cli::cli_alert_success("{.fn Flag} returned output with {nrow(lAssess$dfFlagged)} rows.") - lAssess$dfSummary <- gsm::Summarize(lAssess$dfFlagged, strScoreCol = "TotalCount", lTags) + lAssess$dfSummary <- gsm::Summarize(lAssess$dfFlagged, lTags = lTags) if (!bQuiet) cli::cli_alert_success("{.fn Summarize} returned output with {nrow(lAssess$dfSummary)} rows.") if (bChart) { diff --git a/R/PD_Assess.R b/R/PD_Assess.R index 6ab1208f9..4718fab80 100644 --- a/R/PD_Assess.R +++ b/R/PD_Assess.R @@ -106,10 +106,10 @@ PD_Assess <- function( lAssess$dfAnalyzed <- gsm::Analyze_Poisson(lAssess$dfTransformed, bQuiet = bQuiet) if (!bQuiet) cli::cli_alert_success("{.fn Analyze_Poisson} returned output with {nrow(lAssess$dfAnalyzed)} rows.") - lAssess$dfFlagged <- gsm::Flag(lAssess$dfAnalyzed, strColumn = "Residuals", vThreshold = vThreshold) + lAssess$dfFlagged <- gsm::Flag(lAssess$dfAnalyzed, vThreshold = vThreshold) if (!bQuiet) cli::cli_alert_success("{.fn Flag} returned output with {nrow(lAssess$dfFlagged)} rows.") - lAssess$dfSummary <- gsm::Summarize(lAssess$dfFlagged, strScoreCol = "Residuals", lTags) + lAssess$dfSummary <- gsm::Summarize(lAssess$dfFlagged, lTags = lTags) if (!bQuiet) cli::cli_alert_success("{.fn Summarize} returned output with {nrow(lAssess$dfSummary)} rows.") } else if (strMethod == "wilcoxon") { if (is.null(vThreshold)) { @@ -123,10 +123,10 @@ PD_Assess <- function( ) } - lAssess$dfAnalyzed <- gsm::Analyze_Wilcoxon(lAssess$dfTransformed, "Rate", bQuiet = bQuiet) + lAssess$dfAnalyzed <- gsm::Analyze_Wilcoxon(lAssess$dfTransformed, "KRI", bQuiet = bQuiet) if (!bQuiet) cli::cli_alert_success("{.fn Analyze_Wilcoxon} returned output with {nrow(lAssess$dfAnalyzed)} rows.") - lAssess$dfFlagged <- gsm::Flag(lAssess$dfAnalyzed, strColumn = "PValue", vThreshold = vThreshold, strValueColumn = "Estimate") + lAssess$dfFlagged <- gsm::Flag(lAssess$dfAnalyzed, vThreshold = vThreshold, strValueColumn = "Estimate") if (!bQuiet) cli::cli_alert_success("{.fn Flag} returned output with {nrow(lAssess$dfFlagged)} rows.") lAssess$dfSummary <- gsm::Summarize(lAssess$dfFlagged, lTags = lTags) diff --git a/R/Summarize.R b/R/Summarize.R index 20f3a9cea..286af28ce 100644 --- a/R/Summarize.R +++ b/R/Summarize.R @@ -23,15 +23,16 @@ #' @examples #' dfInput <- AE_Map_Adam() #' dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strExposureCol = "Exposure") -#' dfAnalyzed <- Analyze_Wilcoxon(dfTransformed, "Rate") -#' dfFlagged <- Flag(dfAnalyzed, strColumn = "PValue", strValueColumn = "Rate") +#' dfAnalyzed <- Analyze_Wilcoxon(dfTransformed, "KRI") +#' dfFlagged <- Flag(dfAnalyzed, strColumn = "Score", strValueColumn = "Estimate") #' dfSummary <- Summarize(dfFlagged) #' #' @import dplyr #' #' @export -Summarize <- function(dfFlagged, strScoreCol = "PValue", lTags = NULL) { +Summarize <- function(dfFlagged, strScoreCol = "Score", lTags = NULL) { + stopifnot( "dfFlagged is not a data frame" = is.data.frame(dfFlagged), "One or more of these columns: SiteID, N, Flag , strScoreCol, not found in dfFlagged" = all(c("SiteID", "N", "Flag", strScoreCol) %in% names(dfFlagged)) @@ -45,8 +46,14 @@ Summarize <- function(dfFlagged, strScoreCol = "PValue", lTags = NULL) { } dfSummary <- dfFlagged %>% - select(.data$SiteID, .data$N, strScoreCol, .data$Flag) %>% - rename(KRI = strScoreCol) %>% + select( + .data$SiteID, + .data$N, .data$KRI, + .data$KRILabel, + strScoreCol, + .data$ScoreLabel, + .data$Flag + ) %>% arrange(desc(abs(.data$KRI))) %>% arrange(match(.data$Flag, c(1, -1, 0))) %>% bind_cols(lTags) diff --git a/R/Transform_EventCount.R b/R/Transform_EventCount.R index b58c0a0d8..7c7d98a4e 100644 --- a/R/Transform_EventCount.R +++ b/R/Transform_EventCount.R @@ -27,6 +27,7 @@ #' @param dfInput A data.frame with one record per person. #' @param strCountCol Required. Numerical or logical. Column to be counted. #' @param strExposureCol Optional. Numerical `Exposure` column. +#' @param strKRILabel Optional. Character vector to describe the `KRI` column. #' #' @return data.frame with one row per site with columns SiteID, N, TotalCount with additional columns Exposure and Rate if strExposureCol is used. #' @@ -38,7 +39,7 @@ #' #' @export -Transform_EventCount <- function(dfInput, strCountCol, strExposureCol = NULL) { +Transform_EventCount <- function(dfInput, strCountCol, strExposureCol = NULL, strKRILabel = NULL) { stopifnot( "dfInput is not a data frame" = is.data.frame(dfInput), "strCountCol not found in input data" = strCountCol %in% names(dfInput), @@ -58,13 +59,24 @@ Transform_EventCount <- function(dfInput, strCountCol, strExposureCol = NULL) { } } + if(!is.null(strKRILabel)) { + + stopifnot( + "strKRILabel must be length 1" = length(strKRILabel) <= 1 + ) + + if(strKRILabel %in% names(dfInput)) + stop(paste0("strKRILabel cannot be named with the following names: ", paste(names(dfInput), collapse = ", "))) + } + if (is.null(strExposureCol)) { dfTransformed <- dfInput %>% group_by(.data$SiteID) %>% summarise( N = n(), TotalCount = sum(.data[[strCountCol]]), - ) + ) %>% + mutate(KRI = TotalCount) } else { dfTransformed <- dfInput %>% group_by(.data$SiteID) %>% @@ -73,7 +85,12 @@ Transform_EventCount <- function(dfInput, strCountCol, strExposureCol = NULL) { TotalCount = sum(.data[[strCountCol]]), TotalExposure = sum(.data[[strExposureCol]]) ) %>% - mutate(KRI = .data$TotalCount / .data$TotalExposure) + mutate(KRI = .data$TotalCount / .data$TotalExposure, + KRILabel = strKRILabel) + } + + if(!'KRILabel' %in% names(dfTransformed)) { + dfTransformed$KRILabel <- NA_character_ } return(dfTransformed) From eddaa44e7745995268aec5e4777371908ac91717 Mon Sep 17 00:00:00 2001 From: Matt Roumaya Date: Tue, 7 Jun 2022 21:38:16 +0000 Subject: [PATCH 22/87] test KRILabel with ae.yaml --- R/AE_Assess.R | 8 +++++++- R/Summarize.R | 2 ++ inst/assessments/ae.yaml | 3 ++- 3 files changed, 11 insertions(+), 2 deletions(-) diff --git a/R/AE_Assess.R b/R/AE_Assess.R index 31dca0893..0b214d7c4 100644 --- a/R/AE_Assess.R +++ b/R/AE_Assess.R @@ -74,6 +74,12 @@ AE_Assess <- function( if (any(unname(purrr::map_dbl(lTags, ~ length(.))) > 1)) { lTags <- purrr::map(lTags, ~ paste(.x, collapse = ", ")) } + + if("KRILabel" %in% names(lTags)) { + kri_label <- lTags$KRILabel + } else { + kri_label <- NA_character_ + } } lAssess <- list( @@ -93,7 +99,7 @@ AE_Assess <- function( if (!bQuiet) cli::cli_h2("Initializing {.fn AE_Assess}") if (!bQuiet) cli::cli_text("Input data has {nrow(lAssess$dfInput)} rows.") - lAssess$dfTransformed <- gsm::Transform_EventCount(lAssess$dfInput, strCountCol = "Count", strExposureCol = "Exposure") + lAssess$dfTransformed <- gsm::Transform_EventCount(lAssess$dfInput, strCountCol = "Count", strExposureCol = "Exposure", strKRILabel = kri_label) if (!bQuiet) cli::cli_alert_success("{.fn Transform_EventCount} returned output with {nrow(lAssess$dfTransformed)} rows.") if (strMethod == "poisson") { diff --git a/R/Summarize.R b/R/Summarize.R index 286af28ce..68bb7defd 100644 --- a/R/Summarize.R +++ b/R/Summarize.R @@ -43,6 +43,8 @@ Summarize <- function(dfFlagged, strScoreCol = "Score", lTags = NULL) { "lTags is not named" = (!is.null(names(lTags))), "lTags has unnamed elements" = all(names(lTags) != "") ) + + lTags$KRILabel <- NULL } dfSummary <- dfFlagged %>% diff --git a/inst/assessments/ae.yaml b/inst/assessments/ae.yaml index 94ea7208c..2ea666cb9 100644 --- a/inst/assessments/ae.yaml +++ b/inst/assessments/ae.yaml @@ -2,6 +2,7 @@ label: Treatment-Emergent Adverse Events tags: Assessment: Safety Label: AEs + KRILabel: AEs/Site per Week workflow: - name: FilterDomain inputs: dfAE @@ -11,7 +12,7 @@ workflow: strColParam: strTreatmentEmergentCol strValParam: strTreatmentEmergentVal - name: AE_Map_Raw - inputs: + inputs: - dfAE - dfSUBJ output: dfInput From 2a564d8fd275c7fb2a8ee2d4ae343f5a5325d25d Mon Sep 17 00:00:00 2001 From: Matt Roumaya Date: Wed, 8 Jun 2022 13:56:56 +0000 Subject: [PATCH 23/87] dont re-bind KRILabel --- R/Summarize.R | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/R/Summarize.R b/R/Summarize.R index 68bb7defd..343f9154c 100644 --- a/R/Summarize.R +++ b/R/Summarize.R @@ -43,8 +43,6 @@ Summarize <- function(dfFlagged, strScoreCol = "Score", lTags = NULL) { "lTags is not named" = (!is.null(names(lTags))), "lTags has unnamed elements" = all(names(lTags) != "") ) - - lTags$KRILabel <- NULL } dfSummary <- dfFlagged %>% @@ -58,7 +56,7 @@ Summarize <- function(dfFlagged, strScoreCol = "Score", lTags = NULL) { ) %>% arrange(desc(abs(.data$KRI))) %>% arrange(match(.data$Flag, c(1, -1, 0))) %>% - bind_cols(lTags) + bind_cols(lTags[!names(lTags) %in% names(.)]) return(dfSummary) } From 4716b30e73131bf627e17d6b1f65f83960ab4b3c Mon Sep 17 00:00:00 2001 From: Matt Roumaya <40671730+mattroumaya@users.noreply.github.com> Date: Wed, 8 Jun 2022 09:57:34 -0400 Subject: [PATCH 24/87] Update R/Analyze_Poisson.R Co-authored-by: Jeremy Wildfire --- R/Analyze_Poisson.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/Analyze_Poisson.R b/R/Analyze_Poisson.R index 6a9afe441..6ceeee70d 100644 --- a/R/Analyze_Poisson.R +++ b/R/Analyze_Poisson.R @@ -18,7 +18,7 @@ #' - `Rate` - Rate of exposure (TotalCount / TotalExposure) #' #' @param dfTransformed data.frame in format produced by \code{\link{Transform_EventCount}}. Must include SubjectID, SiteID, TotalCount and TotalExposure. -#' @param strScoreLabel Optional. `character` vector to describe the `Score` column. Default: `Residuals` +#' @param strScoreLabel Optional. `character` value describing the `Score` column. Default: `Residuals` #' @param bQuiet `logical` Suppress warning messages? Default: `TRUE` #' #' @return input data.frame with columns added for "Residuals" and "PredictedCount" From 105aa1490ac4f01e969f1cc22e30c444926928a5 Mon Sep 17 00:00:00 2001 From: Matt Roumaya <40671730+mattroumaya@users.noreply.github.com> Date: Wed, 8 Jun 2022 09:57:40 -0400 Subject: [PATCH 25/87] Update R/Analyze_Poisson.R Co-authored-by: Jeremy Wildfire --- R/Analyze_Poisson.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/Analyze_Poisson.R b/R/Analyze_Poisson.R index 6ceeee70d..2e20dc081 100644 --- a/R/Analyze_Poisson.R +++ b/R/Analyze_Poisson.R @@ -39,7 +39,7 @@ Analyze_Poisson <- function(dfTransformed, strScoreLabel = "Residuals", bQuiet = TRUE) { stopifnot( "dfTransformed is not a data.frame" = is.data.frame(dfTransformed), - "One or more of these columns: SiteID, N, TotalExposure, TotalCount, KRI" = all(c("SiteID", "N", "TotalExposure", "TotalCount", "KRI") %in% names(dfTransformed)), + "One or more of these columns not found: SiteID, N, TotalExposure, TotalCount, KRI" = all(c("SiteID", "N", "TotalExposure", "TotalCount", "KRI") %in% names(dfTransformed)), "NA value(s) found in SiteID" = all(!is.na(dfTransformed[["SiteID"]])) ) From 7c7b85d22035e081959e271b9378adf45c11ac50 Mon Sep 17 00:00:00 2001 From: Matt Roumaya <40671730+mattroumaya@users.noreply.github.com> Date: Wed, 8 Jun 2022 09:57:52 -0400 Subject: [PATCH 26/87] Update R/Consent_Assess.R Co-authored-by: Jeremy Wildfire --- R/Consent_Assess.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/Consent_Assess.R b/R/Consent_Assess.R index 47691852b..76e901c47 100644 --- a/R/Consent_Assess.R +++ b/R/Consent_Assess.R @@ -24,7 +24,7 @@ #' @param dfInput `data.frame` Input data, a data frame with one record per subject. #' @param nThreshold `numeric` Threshold specification. Default: `0.5` #' @param lTags `list` Assessment tags, a named list of tags describing the assessment that defaults to `list(Assessment="IE")`. `lTags` is returned as part of the assessment (`lAssess$lTags`) and each tag is added as a column in `lAssess$dfSummary`. -#' @param strScoreLabel Optional. `character` vector to describe the `Score` column. Default: `Total Event Count` +#' @param strScoreLabel Optional. `character` value describing the `Score` column. Default: `Total Event Count` #' @param bChart `logical` Generate data visualization? Default: `TRUE` #' @param bReturnChecks `logical` Return input checks from `is_mapping_valid`? Default: `FALSE` #' @param bQuiet `logical` Suppress warning messages? Default: `TRUE` From 7dfba04e6ebe374411ebb81ca1958df5f6234ed4 Mon Sep 17 00:00:00 2001 From: Matt Roumaya <40671730+mattroumaya@users.noreply.github.com> Date: Wed, 8 Jun 2022 09:58:00 -0400 Subject: [PATCH 27/87] Update R/Consent_Assess.R Co-authored-by: Jeremy Wildfire --- R/Consent_Assess.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/Consent_Assess.R b/R/Consent_Assess.R index 76e901c47..b1624ee13 100644 --- a/R/Consent_Assess.R +++ b/R/Consent_Assess.R @@ -103,7 +103,7 @@ Consent_Assess <- function( lAssess$dfAnalyzed <- lAssess$dfTransformed %>% dplyr::mutate(Score = .data$TotalCount, - ScoreLabel = ifelse(is.null(strScoreLabel), NA_character_, strScoreLabel)) + ScoreLabel = "Total Number of Consent Issues") if (!bQuiet) cli::cli_alert_info("No analysis function used. {.var dfTransformed} copied directly to {.var dfAnalyzed} with added {.var ScoreLabel} column.") lAssess$dfFlagged <- gsm::Flag(lAssess$dfAnalyzed, vThreshold = c(NA, nThreshold)) From e5886fbc45db2ff5dad953eb5b80259afbd310eb Mon Sep 17 00:00:00 2001 From: Matt Roumaya <40671730+mattroumaya@users.noreply.github.com> Date: Wed, 8 Jun 2022 09:58:09 -0400 Subject: [PATCH 28/87] Update R/Consent_Assess.R Co-authored-by: Jeremy Wildfire --- R/Consent_Assess.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/Consent_Assess.R b/R/Consent_Assess.R index b1624ee13..1fa421d47 100644 --- a/R/Consent_Assess.R +++ b/R/Consent_Assess.R @@ -98,7 +98,7 @@ Consent_Assess <- function( if (checks$status) { if (!bQuiet) cli::cli_h2("Initializing {.fn Consent_Assess}") if (!bQuiet) cli::cli_text("Input data has {nrow(lAssess$dfInput)} rows.") - lAssess$dfTransformed <- gsm::Transform_EventCount(lAssess$dfInput, strCountCol = "Count") + lAssess$dfTransformed <- gsm::Transform_EventCount(lAssess$dfInput, strCountCol = "Count", KRILabel = "Total Number of Consent Issues") if (!bQuiet) cli::cli_alert_success("{.fn Transform_EventCount} returned output with {nrow(lAssess$dfTransformed)} rows.") lAssess$dfAnalyzed <- lAssess$dfTransformed %>% From d7f4e37ff6ba03903c24781d990e3a82d094098c Mon Sep 17 00:00:00 2001 From: Matt Roumaya <40671730+mattroumaya@users.noreply.github.com> Date: Wed, 8 Jun 2022 09:58:17 -0400 Subject: [PATCH 29/87] Update R/Flag.R Co-authored-by: Jeremy Wildfire --- R/Flag.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/Flag.R b/R/Flag.R index 318f09f5a..1529f545b 100644 --- a/R/Flag.R +++ b/R/Flag.R @@ -32,7 +32,7 @@ #' #' @examples #' dfInput <- AE_Map_Adam() -#' dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strExposureCol = "Exposure", strKRILabel = "AEs/Site Per Week") +#' dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strExposureCol = "Exposure", strKRILabel = "AEs/Week") #' dfAnalyzed <- Analyze_Wilcoxon(dfTransformed, "KRI") #' dfFlagged <- Flag(dfAnalyzed) # PValue < 0.05 flagged #' dfFlagged10 <- Flag(dfAnalyzed, vThreshold = c(0.10, NA)) # PValue <0.10 flagged From 909dddcd2253e02caf5ba8273a3a5ac99220122a Mon Sep 17 00:00:00 2001 From: Matt Roumaya <40671730+mattroumaya@users.noreply.github.com> Date: Wed, 8 Jun 2022 09:58:28 -0400 Subject: [PATCH 30/87] Update R/Summarize.R Co-authored-by: Jeremy Wildfire --- R/Summarize.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/Summarize.R b/R/Summarize.R index 343f9154c..6af67679f 100644 --- a/R/Summarize.R +++ b/R/Summarize.R @@ -50,7 +50,7 @@ Summarize <- function(dfFlagged, strScoreCol = "Score", lTags = NULL) { .data$SiteID, .data$N, .data$KRI, .data$KRILabel, - strScoreCol, + .data$Score, .data$ScoreLabel, .data$Flag ) %>% From d663dd6f448d1469bc2b4062ab51a26c8a7f3dcd Mon Sep 17 00:00:00 2001 From: Matt Roumaya Date: Wed, 8 Jun 2022 16:18:38 +0000 Subject: [PATCH 31/87] updates based on PR review --- R/AE_Assess.R | 9 ++------- R/Analyze_Poisson.R | 15 +++++---------- R/Analyze_Wilcoxon.R | 9 ++++----- R/Consent_Assess.R | 12 +++++++----- R/IE_Assess.R | 10 ++++++---- R/PD_Assess.R | 3 ++- R/Transform_EventCount.R | 11 ++++------- 7 files changed, 30 insertions(+), 39 deletions(-) diff --git a/R/AE_Assess.R b/R/AE_Assess.R index 0b214d7c4..348fe66a9 100644 --- a/R/AE_Assess.R +++ b/R/AE_Assess.R @@ -52,6 +52,7 @@ AE_Assess <- function( dfInput, vThreshold = NULL, strMethod = "poisson", + strKRILabel = "AEs/Week", lTags = list(Assessment = "AE"), bChart = TRUE, bReturnChecks = FALSE, @@ -74,12 +75,6 @@ AE_Assess <- function( if (any(unname(purrr::map_dbl(lTags, ~ length(.))) > 1)) { lTags <- purrr::map(lTags, ~ paste(.x, collapse = ", ")) } - - if("KRILabel" %in% names(lTags)) { - kri_label <- lTags$KRILabel - } else { - kri_label <- NA_character_ - } } lAssess <- list( @@ -99,7 +94,7 @@ AE_Assess <- function( if (!bQuiet) cli::cli_h2("Initializing {.fn AE_Assess}") if (!bQuiet) cli::cli_text("Input data has {nrow(lAssess$dfInput)} rows.") - lAssess$dfTransformed <- gsm::Transform_EventCount(lAssess$dfInput, strCountCol = "Count", strExposureCol = "Exposure", strKRILabel = kri_label) + lAssess$dfTransformed <- gsm::Transform_EventCount(lAssess$dfInput, strCountCol = "Count", strExposureCol = "Exposure", strKRILabel = strKRILabel) if (!bQuiet) cli::cli_alert_success("{.fn Transform_EventCount} returned output with {nrow(lAssess$dfTransformed)} rows.") if (strMethod == "poisson") { diff --git a/R/Analyze_Poisson.R b/R/Analyze_Poisson.R index 2e20dc081..2262fadee 100644 --- a/R/Analyze_Poisson.R +++ b/R/Analyze_Poisson.R @@ -18,14 +18,13 @@ #' - `Rate` - Rate of exposure (TotalCount / TotalExposure) #' #' @param dfTransformed data.frame in format produced by \code{\link{Transform_EventCount}}. Must include SubjectID, SiteID, TotalCount and TotalExposure. -#' @param strScoreLabel Optional. `character` value describing the `Score` column. Default: `Residuals` #' @param bQuiet `logical` Suppress warning messages? Default: `TRUE` #' #' @return input data.frame with columns added for "Residuals" and "PredictedCount" #' #' @examples #' dfInput <- AE_Map_Raw() -#' dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strExposureCol = "Exposure") +#' dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strExposureCol = "Exposure", strKRILabel = "AEs/Week") #' dfAnalyzed <- Analyze_Poisson(dfTransformed) #' #' @import dplyr @@ -36,7 +35,7 @@ #' #' @export -Analyze_Poisson <- function(dfTransformed, strScoreLabel = "Residuals", bQuiet = TRUE) { +Analyze_Poisson <- function(dfTransformed, bQuiet = TRUE) { stopifnot( "dfTransformed is not a data.frame" = is.data.frame(dfTransformed), "One or more of these columns not found: SiteID, N, TotalExposure, TotalCount, KRI" = all(c("SiteID", "N", "TotalExposure", "TotalCount", "KRI") %in% names(dfTransformed)), @@ -61,12 +60,8 @@ Analyze_Poisson <- function(dfTransformed, strScoreLabel = "Residuals", bQuiet = ) dfAnalyzed <- broom::augment(cModel, dfModel, type.predict = "response") %>% - rename( - Score = .data$.resid, - PredictedCount = .data$.fitted, - ) %>% mutate( - ScoreLabel = ifelse(is.null(strScoreLabel), NA_character_, strScoreLabel) + ScoreLabel = "Residuals" ) %>% select( .data$SiteID, @@ -75,9 +70,9 @@ Analyze_Poisson <- function(dfTransformed, strScoreLabel = "Residuals", bQuiet = .data$TotalCount, .data$KRI, .data$KRILabel, - .data$Score, + Score = .data$.resid, .data$ScoreLabel, - .data$PredictedCount + PredictedCount = .data$.fitted ) %>% arrange(.data$Score) diff --git a/R/Analyze_Wilcoxon.R b/R/Analyze_Wilcoxon.R index 95272d00b..6f0870078 100644 --- a/R/Analyze_Wilcoxon.R +++ b/R/Analyze_Wilcoxon.R @@ -30,8 +30,8 @@ #' #' @examples #' dfInput <- AE_Map_Raw() -#' dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strExposureCol = "Exposure") -#' dfAnalyzed <- Analyze_Wilcoxon(dfTransformed, strOutcomeCol = "KRI") +#' dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strExposureCol = "Exposure", strKRILabel = "AEs/Week") +#' dfAnalyzed <- Analyze_Wilcoxon(dfTransformed) #' #' @import dplyr #' @importFrom broom glance @@ -45,9 +45,8 @@ Analyze_Wilcoxon <- function( dfTransformed, - strOutcomeCol = NULL, + strOutcomeCol = "KRI", strPredictorCol = "SiteID", - strScoreLabel = "PValue", bQuiet = TRUE ) { stopifnot( @@ -130,7 +129,7 @@ Analyze_Wilcoxon <- function( dfAnalyzed %>% select(names(dfTransformed), .data$Estimate, Score = .data$PValue) %>% mutate( - ScoreLabel = ifelse(is.null(strScoreLabel), NA_character_, strScoreLabel) + ScoreLabel = "Residuals" ) ) } diff --git a/R/Consent_Assess.R b/R/Consent_Assess.R index 1fa421d47..293bfdd03 100644 --- a/R/Consent_Assess.R +++ b/R/Consent_Assess.R @@ -24,7 +24,6 @@ #' @param dfInput `data.frame` Input data, a data frame with one record per subject. #' @param nThreshold `numeric` Threshold specification. Default: `0.5` #' @param lTags `list` Assessment tags, a named list of tags describing the assessment that defaults to `list(Assessment="IE")`. `lTags` is returned as part of the assessment (`lAssess$lTags`) and each tag is added as a column in `lAssess$dfSummary`. -#' @param strScoreLabel Optional. `character` value describing the `Score` column. Default: `Total Event Count` #' @param bChart `logical` Generate data visualization? Default: `TRUE` #' @param bReturnChecks `logical` Return input checks from `is_mapping_valid`? Default: `FALSE` #' @param bQuiet `logical` Suppress warning messages? Default: `TRUE` @@ -58,7 +57,7 @@ Consent_Assess <- function( dfInput, nThreshold = 0.5, lTags = list(Assessment = "Consent"), - strScoreLabel = "Total Event Count", + strKRILabel = "Total Number of Consent Issues", bChart = TRUE, bReturnChecks = FALSE, bQuiet = TRUE @@ -98,12 +97,15 @@ Consent_Assess <- function( if (checks$status) { if (!bQuiet) cli::cli_h2("Initializing {.fn Consent_Assess}") if (!bQuiet) cli::cli_text("Input data has {nrow(lAssess$dfInput)} rows.") - lAssess$dfTransformed <- gsm::Transform_EventCount(lAssess$dfInput, strCountCol = "Count", KRILabel = "Total Number of Consent Issues") + lAssess$dfTransformed <- gsm::Transform_EventCount(lAssess$dfInput, strCountCol = "Count", strKRILabel = strKRILabel) if (!bQuiet) cli::cli_alert_success("{.fn Transform_EventCount} returned output with {nrow(lAssess$dfTransformed)} rows.") lAssess$dfAnalyzed <- lAssess$dfTransformed %>% - dplyr::mutate(Score = .data$TotalCount, - ScoreLabel = "Total Number of Consent Issues") + Analyze_Identity( + strValueCol = "Total Count", + strLabelCol = "Total Number of Consent Issues" + ) + if (!bQuiet) cli::cli_alert_info("No analysis function used. {.var dfTransformed} copied directly to {.var dfAnalyzed} with added {.var ScoreLabel} column.") lAssess$dfFlagged <- gsm::Flag(lAssess$dfAnalyzed, vThreshold = c(NA, nThreshold)) diff --git a/R/IE_Assess.R b/R/IE_Assess.R index 1498981c6..dcf8376b2 100644 --- a/R/IE_Assess.R +++ b/R/IE_Assess.R @@ -49,7 +49,7 @@ IE_Assess <- function( dfInput, nThreshold = 0.5, lTags = list(Assessment = "IE"), - strScoreLabel = "Total Event Count", + strKRILabel = "Total Event Count", bChart = TRUE, bReturnChecks = FALSE, bQuiet = TRUE @@ -89,12 +89,14 @@ IE_Assess <- function( if (checks$status) { if (!bQuiet) cli::cli_h2("Initializing {.fn IE_Assess}") if (!bQuiet) cli::cli_text("Input data has {nrow(lAssess$dfInput)} rows.") - lAssess$dfTransformed <- gsm::Transform_EventCount(lAssess$dfInput, strCountCol = "Count") + lAssess$dfTransformed <- gsm::Transform_EventCount(lAssess$dfInput, strCountCol = "Count", strKRILabel = strKRILabel) if (!bQuiet) cli::cli_alert_success("{.fn Transform_EventCount} returned output with {nrow(lAssess$dfTransformed)} rows.") lAssess$dfAnalyzed <- lAssess$dfTransformed %>% - dplyr::mutate(Score = .data$TotalCount, - ScoreLabel = ifelse(is.null(strScoreLabel), NA_character_, strScoreLabel)) + Analyze_Identity( + strValueCol = "Total Count", + strLabelCol = "Total Number of Inclusion/Exclusion Issues" + ) if (!bQuiet) cli::cli_alert_info("No analysis function used. {.var dfTransformed} copied directly to {.var dfAnalyzed} with added {.var ScoreLabel} column.") lAssess$dfFlagged <- gsm::Flag(lAssess$dfAnalyzed, vThreshold = c(NA, nThreshold)) diff --git a/R/PD_Assess.R b/R/PD_Assess.R index 4718fab80..7b3026c90 100644 --- a/R/PD_Assess.R +++ b/R/PD_Assess.R @@ -48,6 +48,7 @@ PD_Assess <- function( dfInput, vThreshold = NULL, strMethod = "poisson", + strKRILabel = "PDs/Week", lTags = list(Assessment = "PD"), bChart = TRUE, bReturnChecks = FALSE, @@ -89,7 +90,7 @@ PD_Assess <- function( if (!bQuiet) cli::cli_h2("Initializing {.fn PD_Assess}") if (!bQuiet) cli::cli_text("Input data has {nrow(lAssess$dfInput)} rows.") - lAssess$dfTransformed <- gsm::Transform_EventCount(lAssess$dfInput, strCountCol = "Count", strExposureCol = "Exposure") + lAssess$dfTransformed <- gsm::Transform_EventCount(lAssess$dfInput, strCountCol = "Count", strExposureCol = "Exposure", strKRILabel = strKRILabel) if (!bQuiet) cli::cli_alert_success("{.fn Transform_EventCount} returned output with {nrow(lAssess$dfTransformed)} rows.") if (strMethod == "poisson") { diff --git a/R/Transform_EventCount.R b/R/Transform_EventCount.R index 7c7d98a4e..2f5a977c8 100644 --- a/R/Transform_EventCount.R +++ b/R/Transform_EventCount.R @@ -33,13 +33,13 @@ #' #' @examples #' dfInput <- AE_Map_Adam() -#' dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strExposureCol = "Exposure") +#' dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strExposureCol = "Exposure", strKRILabel = "AEs/Week") #' #' @import dplyr #' #' @export -Transform_EventCount <- function(dfInput, strCountCol, strExposureCol = NULL, strKRILabel = NULL) { +Transform_EventCount <- function(dfInput, strCountCol, strExposureCol = NULL, strKRILabel) { stopifnot( "dfInput is not a data frame" = is.data.frame(dfInput), "strCountCol not found in input data" = strCountCol %in% names(dfInput), @@ -85,13 +85,10 @@ Transform_EventCount <- function(dfInput, strCountCol, strExposureCol = NULL, st TotalCount = sum(.data[[strCountCol]]), TotalExposure = sum(.data[[strExposureCol]]) ) %>% - mutate(KRI = .data$TotalCount / .data$TotalExposure, - KRILabel = strKRILabel) + mutate(KRI = .data$TotalCount / .data$TotalExposure) } - if(!'KRILabel' %in% names(dfTransformed)) { - dfTransformed$KRILabel <- NA_character_ - } + dfTransformed$KRILabel <- strKRILabel return(dfTransformed) } From a7220a8628f8749c2b96f6b3bd78bb741d501ae1 Mon Sep 17 00:00:00 2001 From: Matt Roumaya Date: Wed, 8 Jun 2022 17:10:12 +0000 Subject: [PATCH 32/87] add Analyze_Identity + placeholder unit test --- R/Analyze_Identity.R | 17 +++++++++++++++++ tests/testthat/test-Analyze_Identity.R | 3 +++ 2 files changed, 20 insertions(+) create mode 100644 R/Analyze_Identity.R create mode 100644 tests/testthat/test-Analyze_Identity.R diff --git a/R/Analyze_Identity.R b/R/Analyze_Identity.R new file mode 100644 index 000000000..7376da8d7 --- /dev/null +++ b/R/Analyze_Identity.R @@ -0,0 +1,17 @@ +#' Analyze Identity +#' +#' Used in the data pipeline between `Transform` and `Flag` to rename KRI and Score columns. +#' +#' @param dfTransformed `data.frame` created by `Transform_EventCount()` +#' @param strValueCol `character` Name of column that will be copied as `Score` +#' @param strLabelCol `character` Name of column that will be copied as `ScoreLabel` +#' +#' @return `data.frame` that adds two columns to `dfTransformed`: `Score` and `ScoreLabel` +#' +#' @export + +Analyze_Identity <- function(dfTransformed, strValueCol = 'KRI', strLabelCol="KRIColumn"){ + dfTransformed %>% + mutate(Score = strValueCol, + ScoreLabel = strLabelCol) +} diff --git a/tests/testthat/test-Analyze_Identity.R b/tests/testthat/test-Analyze_Identity.R new file mode 100644 index 000000000..8849056e2 --- /dev/null +++ b/tests/testthat/test-Analyze_Identity.R @@ -0,0 +1,3 @@ +test_that("multiplication works", { + expect_equal(2 * 2, 4) +}) From 3fcf7127a3a06ecdbea6242b169a4d6ff3f5cb80 Mon Sep 17 00:00:00 2001 From: Matt Roumaya Date: Wed, 8 Jun 2022 17:27:21 +0000 Subject: [PATCH 33/87] remove "KRI" because it is now default --- R/AE_Assess.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/AE_Assess.R b/R/AE_Assess.R index 348fe66a9..65eaf980d 100644 --- a/R/AE_Assess.R +++ b/R/AE_Assess.R @@ -128,7 +128,7 @@ AE_Assess <- function( ) } - lAssess$dfAnalyzed <- gsm::Analyze_Wilcoxon(lAssess$dfTransformed, "KRI", bQuiet = bQuiet) + lAssess$dfAnalyzed <- gsm::Analyze_Wilcoxon(lAssess$dfTransformed, bQuiet = bQuiet) if (!bQuiet) cli::cli_alert_success("{.fn Analyze_Wilcoxon} returned output with {nrow(lAssess$dfAnalyzed)} rows.") lAssess$dfFlagged <- gsm::Flag(lAssess$dfAnalyzed, vThreshold = vThreshold, strValueColumn = "Estimate") From 357440280b03579820bfd2ff12997a21326da70c Mon Sep 17 00:00:00 2001 From: Matt Roumaya Date: Wed, 8 Jun 2022 19:09:02 +0000 Subject: [PATCH 34/87] remove labels from inst/assessments YAML files --- R/Analyze_Identity.R | 4 ++-- inst/assessments/ae.yaml | 3 +-- inst/assessments/consent.yaml | 1 - inst/assessments/ie.yaml | 1 - inst/assessments/importantpd.yaml | 1 - inst/assessments/pd.yaml | 1 - inst/assessments/sae.yaml | 2 +- 7 files changed, 4 insertions(+), 9 deletions(-) diff --git a/R/Analyze_Identity.R b/R/Analyze_Identity.R index 7376da8d7..896fea3d1 100644 --- a/R/Analyze_Identity.R +++ b/R/Analyze_Identity.R @@ -10,8 +10,8 @@ #' #' @export -Analyze_Identity <- function(dfTransformed, strValueCol = 'KRI', strLabelCol="KRIColumn"){ +Analyze_Identity <- function(dfTransformed, strValueCol = 'KRI', strLabelCol = "KRIColumn"){ dfTransformed %>% - mutate(Score = strValueCol, + mutate(Score = .data$KRI, ScoreLabel = strLabelCol) } diff --git a/inst/assessments/ae.yaml b/inst/assessments/ae.yaml index 2ea666cb9..0e0db0986 100644 --- a/inst/assessments/ae.yaml +++ b/inst/assessments/ae.yaml @@ -1,8 +1,6 @@ -label: Treatment-Emergent Adverse Events tags: Assessment: Safety Label: AEs - KRILabel: AEs/Site per Week workflow: - name: FilterDomain inputs: dfAE @@ -21,3 +19,4 @@ workflow: output: lResults params: strMethod: "poisson" + strKRILabel: "Treatment-Emergent AEs/Week" diff --git a/inst/assessments/consent.yaml b/inst/assessments/consent.yaml index 4f5efaec9..41b13479c 100644 --- a/inst/assessments/consent.yaml +++ b/inst/assessments/consent.yaml @@ -1,4 +1,3 @@ -label: Consent Workflow tags: Assessment: Consent Label: Consent diff --git a/inst/assessments/ie.yaml b/inst/assessments/ie.yaml index c31d514ce..59dbda4a9 100644 --- a/inst/assessments/ie.yaml +++ b/inst/assessments/ie.yaml @@ -1,4 +1,3 @@ -label: Inclusion/Exclusion (IE) Workflow tags: Assessment: IE Label: IE diff --git a/inst/assessments/importantpd.yaml b/inst/assessments/importantpd.yaml index d0def3024..29b6c701c 100644 --- a/inst/assessments/importantpd.yaml +++ b/inst/assessments/importantpd.yaml @@ -1,4 +1,3 @@ -label: Protocol Deviation (PD) Workflow - Important tags: Assessment: PD Label: Important PD diff --git a/inst/assessments/pd.yaml b/inst/assessments/pd.yaml index ae6a43a6f..3bb8c2faf 100644 --- a/inst/assessments/pd.yaml +++ b/inst/assessments/pd.yaml @@ -1,4 +1,3 @@ -label: Protocol Deviation (PD) Workflow tags: Assessment: PD Label: PD diff --git a/inst/assessments/sae.yaml b/inst/assessments/sae.yaml index 7f2d59f36..3675f79b6 100644 --- a/inst/assessments/sae.yaml +++ b/inst/assessments/sae.yaml @@ -1,4 +1,3 @@ -label: Treatment-Emergent Serious Adverse Events by SOC tags: Assessment: Safety Label: AEs Serious @@ -27,3 +26,4 @@ workflow: output: lResults params: strMethod: "poisson" + strKRILabel: "Serious Treatment-Emergent AEs/Week" From c192b6dfe72a7fb41a28d337e42e7defe94b67a3 Mon Sep 17 00:00:00 2001 From: Matt Roumaya Date: Wed, 8 Jun 2022 22:34:08 +0000 Subject: [PATCH 35/87] update unit tests + documentation --- NAMESPACE | 1 + R/AE_Assess.R | 4 +- R/Analyze_Chisq.R | 2 +- R/Analyze_Fisher.R | 2 +- R/Analyze_Poisson.R | 2 +- R/Analyze_Poisson_PredictBounds.R | 2 +- R/Analyze_Wilcoxon.R | 1 - R/Consent_Assess.R | 4 +- R/IE_Assess.R | 5 +- R/PD_Assess.R | 4 +- R/Summarize.R | 9 +-- R/Transform_EventCount.R | 2 +- man/AE_Assess.Rd | 3 + man/Analyze_Chisq.Rd | 2 +- man/Analyze_Fisher.Rd | 2 +- man/Analyze_Identity.Rd | 21 +++++++ man/Analyze_Poisson.Rd | 2 +- man/Analyze_Poisson_PredictBounds.Rd | 2 +- man/Analyze_Wilcoxon.Rd | 6 +- man/Consent_Assess.Rd | 3 + man/Flag.Rd | 8 +-- man/IE_Assess.Rd | 3 + man/PD_Assess.Rd | 3 + man/Summarize.Rd | 8 +-- man/Transform_EventCount.Rd | 6 +- tests/testthat/_snaps/Study_Assess.md | 4 +- tests/testthat/test_AE_Assess.R | 14 +++-- tests/testthat/test_Analyze_Chisq.R | 2 +- tests/testthat/test_Analyze_Fisher.R | 11 ++-- tests/testthat/test_Consent_Assess.R | 8 ++- tests/testthat/test_IE_Assess.R | 8 ++- tests/testthat/test_PD_Assess.R | 14 +++-- tests/testthat/test_Study_Assess.R | 3 +- tests/testthat/test_Summarize.R | 40 ++++++++----- tests/testthat/test_Transform_EventCount.R | 67 ++++++++++++++-------- 35 files changed, 190 insertions(+), 88 deletions(-) create mode 100644 man/Analyze_Identity.Rd diff --git a/NAMESPACE b/NAMESPACE index bffbe6ee3..596ef1b73 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -6,6 +6,7 @@ export(AE_Map_Adam) export(AE_Map_Raw) export(Analyze_Chisq) export(Analyze_Fisher) +export(Analyze_Identity) export(Analyze_Poisson) export(Analyze_Poisson_PredictBounds) export(Analyze_Wilcoxon) diff --git a/R/AE_Assess.R b/R/AE_Assess.R index 65eaf980d..6e783aae7 100644 --- a/R/AE_Assess.R +++ b/R/AE_Assess.R @@ -14,6 +14,7 @@ #' `c(-5, 5)` for `strMethod` = "poisson" and `c(.0001, NA)` for `strMethod` = "wilcoxon". #' @param strMethod `character` Statistical model. Valid values include "poisson" (default) and #' "wilcoxon". +#' @param strKRILabel `character` Describe the `KRI` column, a vector of length 1 that defaults to `AEs/Week` #' @param lTags `list` Assessment tags, a named list of tags describing the assessment that defaults #' to `list(Assessment="AE")`. `lTags` is returned as part of the assessment (`lAssess$lTags`) and #' each tag is added as a column in `lAssess$dfSummary`. @@ -62,7 +63,8 @@ AE_Assess <- function( "dfInput is not a data.frame" = is.data.frame(dfInput), "strMethod is not 'poisson' or 'wilcoxon'" = strMethod %in% c("poisson", "wilcoxon"), "One or more of these columns: SubjectID, SiteID, Count, Exposure, and Rate not found in dfInput" = all(c("SubjectID", "SiteID", "Count", "Exposure", "Rate") %in% names(dfInput)), - "strMethod must be length 1" = length(strMethod) == 1 + "strMethod must be length 1" = length(strMethod) == 1, + "strKRILabel must be length 1" = length(strKRILabel) == 1 ) if (!is.null(lTags)) { diff --git a/R/Analyze_Chisq.R b/R/Analyze_Chisq.R index eae1be379..ef7bef2e7 100644 --- a/R/Analyze_Chisq.R +++ b/R/Analyze_Chisq.R @@ -27,7 +27,7 @@ #' #' @examples #' dfInput <- Disp_Map(dfDisp = safetyData::adam_adsl, strCol = "DCREASCD", strReason = "Adverse Event") -#' dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count") +#' dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strKRILabel = "Discontinuation Reasons/Week") #' dfAnalyzed <- Analyze_Chisq(dfTransformed) #' #' @import dplyr diff --git a/R/Analyze_Fisher.R b/R/Analyze_Fisher.R index 7d2193974..a8efabc41 100644 --- a/R/Analyze_Fisher.R +++ b/R/Analyze_Fisher.R @@ -26,7 +26,7 @@ #' #' @examples #' dfInput <- Disp_Map(dfDisp = safetyData::adam_adsl, strCol = "DCREASCD", strReason = "Adverse Event") -#' dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count") +#' dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strKRILabel = "Discontinuation Reasons/Week") #' dfAnalyzed <- Analyze_Fisher(dfTransformed) #' #' @import dplyr diff --git a/R/Analyze_Poisson.R b/R/Analyze_Poisson.R index 2262fadee..cf39b0996 100644 --- a/R/Analyze_Poisson.R +++ b/R/Analyze_Poisson.R @@ -66,8 +66,8 @@ Analyze_Poisson <- function(dfTransformed, bQuiet = TRUE) { select( .data$SiteID, .data$N, - .data$TotalExposure, .data$TotalCount, + .data$TotalExposure, .data$KRI, .data$KRILabel, Score = .data$.resid, diff --git a/R/Analyze_Poisson_PredictBounds.R b/R/Analyze_Poisson_PredictBounds.R index 2682c676f..cba8a6ca8 100644 --- a/R/Analyze_Poisson_PredictBounds.R +++ b/R/Analyze_Poisson_PredictBounds.R @@ -30,7 +30,7 @@ #' #' @examples #' dfInput <- AE_Map_Adam() -#' dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strExposureCol = "Exposure") +#' dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strExposureCol = "Exposure", strKRILabel = "AEs/Week") #' dfBounds <- Analyze_Poisson_PredictBounds(dfTransformed, c(-5, 5)) #' #' @importFrom stats glm offset poisson qchisq diff --git a/R/Analyze_Wilcoxon.R b/R/Analyze_Wilcoxon.R index 6f0870078..35e8dd462 100644 --- a/R/Analyze_Wilcoxon.R +++ b/R/Analyze_Wilcoxon.R @@ -22,7 +22,6 @@ #' @param strOutcomeCol `character` Column name of outcome in `dfTransformed` to analyze. #' @param strPredictorCol `character` Column name of predictor in `dfTransformed` to analyze. #' Default: `"SiteID"` -#' @param strScoreLabel Optional. `character` vector to describe the `Score` column. Default: `Residual` #' @param bQuiet `logical` Suppress warning messages? Default: `TRUE` #' #' @return `data.frame` with one row per site, columns: SiteID, N, TotalCount, TotalExposure, Rate, diff --git a/R/Consent_Assess.R b/R/Consent_Assess.R index 293bfdd03..446d26459 100644 --- a/R/Consent_Assess.R +++ b/R/Consent_Assess.R @@ -24,6 +24,7 @@ #' @param dfInput `data.frame` Input data, a data frame with one record per subject. #' @param nThreshold `numeric` Threshold specification. Default: `0.5` #' @param lTags `list` Assessment tags, a named list of tags describing the assessment that defaults to `list(Assessment="IE")`. `lTags` is returned as part of the assessment (`lAssess$lTags`) and each tag is added as a column in `lAssess$dfSummary`. +#' @param strKRILabel `character` Describe the `KRI` column, a vector of length 1 that defaults to `Total Number of Consent Issues` #' @param bChart `logical` Generate data visualization? Default: `TRUE` #' @param bReturnChecks `logical` Return input checks from `is_mapping_valid`? Default: `FALSE` #' @param bQuiet `logical` Suppress warning messages? Default: `TRUE` @@ -66,7 +67,8 @@ Consent_Assess <- function( "dfInput is not a data.frame" = is.data.frame(dfInput), "One or more of these columns: SubjectID, SiteID,and Count not found in dfInput" = all(c("SubjectID", "SiteID", "Count") %in% names(dfInput)), "nThreshold must be numeric" = is.numeric(nThreshold), - "nThreshold must be length 1" = length(nThreshold) == 1 + "nThreshold must be length 1" = length(nThreshold) == 1, + "strKRILabel must be length 1" = length(strKRILabel) == 1 ) if (!is.null(lTags)) { diff --git a/R/IE_Assess.R b/R/IE_Assess.R index dcf8376b2..783831ebc 100644 --- a/R/IE_Assess.R +++ b/R/IE_Assess.R @@ -14,7 +14,7 @@ #' @param dfInput `data.frame` Input data, a data frame with one record per subject. #' @param nThreshold `numeric` Threshold specification. Default: `0.5` #' @param lTags `list` Assessment tags, a named list of tags describing the assessment that defaults to `list(Assessment="IE")`. `lTags` is returned as part of the assessment (`lAssess$lTags`) and each tag is added as a column in `lAssess$dfSummary`. -#' @param strScoreLabel Optional. `character` vector to describe the `Score` column. Default: `Total Event Count` +#' @param strKRILabel `character` Describe the `KRI` column, a vector of length 1 that defaults to `Total Event Count` #' @param bChart `logical` Generate data visualization? Default: `TRUE` #' @param bReturnChecks `logical` Return input checks from `is_mapping_valid`? Default: `FALSE` #' @param bQuiet `logical` Suppress warning messages? Default: `TRUE` @@ -58,7 +58,8 @@ IE_Assess <- function( "dfInput is not a data.frame" = is.data.frame(dfInput), "One or more of these columns: SubjectID, SiteID, Count, Exposure, and Rate not found in dfInput" = all(c("SubjectID", "SiteID", "Count") %in% names(dfInput)), "nThreshold must be numeric" = is.numeric(nThreshold), - "nThreshold must be length 1" = length(nThreshold) == 1 + "nThreshold must be length 1" = length(nThreshold) == 1, + "strKRILabel must be length 1" = length(strKRILabel) == 1 ) if (!is.null(lTags)) { diff --git a/R/PD_Assess.R b/R/PD_Assess.R index 7b3026c90..950244f4c 100644 --- a/R/PD_Assess.R +++ b/R/PD_Assess.R @@ -13,6 +13,7 @@ #' @param vThreshold `numeric` Threshold specification, a vector of length 2 that defaults to `c(-5, 5)` for `strMethod` = "poisson" and `c(.0001, NA)` for `strMethod` = "wilcoxon". #' @param strMethod `character` Statistical model. Valid values include "poisson" (default) and "wilcoxon". #' @param lTags `list` Assessment tags, a named list of tags describing the assessment that defaults to `list(Assessment="PD")`. `lTags` is returned as part of the assessment (`lAssess$lTags`) and each tag is added as a column in `lAssess$dfSummary`. +#' @param strKRILabel `character` Describe the `KRI` column, a vector of length 1 that defaults to `PDs/Week` #' @param bChart `logical` Generate data visualization? Default: `TRUE` #' @param bReturnChecks `logical` Return input checks from `is_mapping_valid`? Default: `FALSE` #' @param bQuiet `logical` Suppress warning messages? Default: `TRUE` @@ -58,7 +59,8 @@ PD_Assess <- function( "dfInput is not a data.frame" = is.data.frame(dfInput), "strMethod is not 'poisson' or 'wilcoxon'" = strMethod %in% c("poisson", "wilcoxon"), "strMethod must be length 1" = length(strMethod) == 1, - "One or more of these columns: SubjectID, SiteID, Count, Exposure, and Rate not found in dfInput" = all(c("SubjectID", "SiteID", "Count", "Exposure", "Rate") %in% names(dfInput)) + "One or more of these columns: SubjectID, SiteID, Count, Exposure, and Rate not found in dfInput" = all(c("SubjectID", "SiteID", "Count", "Exposure", "Rate") %in% names(dfInput)), + "strKRILabel must be length 1" = length(strKRILabel) == 1 ) if (!is.null(lTags)) { diff --git a/R/Summarize.R b/R/Summarize.R index 6af67679f..c12c2c780 100644 --- a/R/Summarize.R +++ b/R/Summarize.R @@ -22,8 +22,8 @@ #' #' @examples #' dfInput <- AE_Map_Adam() -#' dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strExposureCol = "Exposure") -#' dfAnalyzed <- Analyze_Wilcoxon(dfTransformed, "KRI") +#' dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strExposureCol = "Exposure", strKRILabel = "AEs/Week") +#' dfAnalyzed <- Analyze_Wilcoxon(dfTransformed) #' dfFlagged <- Flag(dfAnalyzed, strColumn = "Score", strValueColumn = "Estimate") #' dfSummary <- Summarize(dfFlagged) #' @@ -48,7 +48,8 @@ Summarize <- function(dfFlagged, strScoreCol = "Score", lTags = NULL) { dfSummary <- dfFlagged %>% select( .data$SiteID, - .data$N, .data$KRI, + .data$N, + .data$KRI, .data$KRILabel, .data$Score, .data$ScoreLabel, @@ -56,7 +57,7 @@ Summarize <- function(dfFlagged, strScoreCol = "Score", lTags = NULL) { ) %>% arrange(desc(abs(.data$KRI))) %>% arrange(match(.data$Flag, c(1, -1, 0))) %>% - bind_cols(lTags[!names(lTags) %in% names(.)]) + bind_cols(lTags[!names(lTags) %in% names(.data)]) return(dfSummary) } diff --git a/R/Transform_EventCount.R b/R/Transform_EventCount.R index 2f5a977c8..374e551bc 100644 --- a/R/Transform_EventCount.R +++ b/R/Transform_EventCount.R @@ -76,7 +76,7 @@ Transform_EventCount <- function(dfInput, strCountCol, strExposureCol = NULL, st N = n(), TotalCount = sum(.data[[strCountCol]]), ) %>% - mutate(KRI = TotalCount) + mutate(KRI = .data$TotalCount) } else { dfTransformed <- dfInput %>% group_by(.data$SiteID) %>% diff --git a/man/AE_Assess.Rd b/man/AE_Assess.Rd index 684ceb30b..4eb14e3ed 100644 --- a/man/AE_Assess.Rd +++ b/man/AE_Assess.Rd @@ -8,6 +8,7 @@ AE_Assess( dfInput, vThreshold = NULL, strMethod = "poisson", + strKRILabel = "AEs/Week", lTags = list(Assessment = "AE"), bChart = TRUE, bReturnChecks = FALSE, @@ -23,6 +24,8 @@ AE_Assess( \item{strMethod}{\code{character} Statistical model. Valid values include "poisson" (default) and "wilcoxon".} +\item{strKRILabel}{\code{character} Describe the \code{KRI} column, a vector of length 1 that defaults to \code{AEs/Week}} + \item{lTags}{\code{list} Assessment tags, a named list of tags describing the assessment that defaults to \code{list(Assessment="AE")}. \code{lTags} is returned as part of the assessment (\code{lAssess$lTags}) and each tag is added as a column in \code{lAssess$dfSummary}.} diff --git a/man/Analyze_Chisq.Rd b/man/Analyze_Chisq.Rd index 5f2de7bc8..5ed27feec 100644 --- a/man/Analyze_Chisq.Rd +++ b/man/Analyze_Chisq.Rd @@ -41,7 +41,7 @@ The input data (\code{dfTransformed}) for Analyze_Chisq is typically created usi \examples{ dfInput <- Disp_Map(dfDisp = safetyData::adam_adsl, strCol = "DCREASCD", strReason = "Adverse Event") -dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count") +dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strKRILabel = "Discontinuation Reasons/Week") dfAnalyzed <- Analyze_Chisq(dfTransformed) } diff --git a/man/Analyze_Fisher.Rd b/man/Analyze_Fisher.Rd index 517076b4d..0a5dde487 100644 --- a/man/Analyze_Fisher.Rd +++ b/man/Analyze_Fisher.Rd @@ -41,7 +41,7 @@ The input data (\code{dfTransformed}) for Analyze_Fisher is typically created us \examples{ dfInput <- Disp_Map(dfDisp = safetyData::adam_adsl, strCol = "DCREASCD", strReason = "Adverse Event") -dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count") +dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strKRILabel = "Discontinuation Reasons/Week") dfAnalyzed <- Analyze_Fisher(dfTransformed) } diff --git a/man/Analyze_Identity.Rd b/man/Analyze_Identity.Rd new file mode 100644 index 000000000..8a7590a1b --- /dev/null +++ b/man/Analyze_Identity.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Analyze_Identity.R +\name{Analyze_Identity} +\alias{Analyze_Identity} +\title{Analyze Identity} +\usage{ +Analyze_Identity(dfTransformed, strValueCol = "KRI", strLabelCol = "KRIColumn") +} +\arguments{ +\item{dfTransformed}{\code{data.frame} created by \code{Transform_EventCount()}} + +\item{strValueCol}{\code{character} Name of column that will be copied as \code{Score}} + +\item{strLabelCol}{\code{character} Name of column that will be copied as \code{ScoreLabel}} +} +\value{ +\code{data.frame} that adds two columns to \code{dfTransformed}: \code{Score} and \code{ScoreLabel} +} +\description{ +Used in the data pipeline between \code{Transform} and \code{Flag} to rename KRI and Score columns. +} diff --git a/man/Analyze_Poisson.Rd b/man/Analyze_Poisson.Rd index f02ffaf1d..c24e1a4d9 100644 --- a/man/Analyze_Poisson.Rd +++ b/man/Analyze_Poisson.Rd @@ -41,7 +41,7 @@ The input data (\code{dfTransformed}) for Analyze_Poisson is typically created u \examples{ dfInput <- AE_Map_Raw() -dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strExposureCol = "Exposure") +dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strExposureCol = "Exposure", strKRILabel = "AEs/Week") dfAnalyzed <- Analyze_Poisson(dfTransformed) } diff --git a/man/Analyze_Poisson_PredictBounds.Rd b/man/Analyze_Poisson_PredictBounds.Rd index 6dbc11314..a4a05e0c9 100644 --- a/man/Analyze_Poisson_PredictBounds.Rd +++ b/man/Analyze_Poisson_PredictBounds.Rd @@ -52,7 +52,7 @@ The input data (\code{ dfTransformed}) for the Analyze_Poisson is typically crea \examples{ dfInput <- AE_Map_Adam() -dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strExposureCol = "Exposure") +dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strExposureCol = "Exposure", strKRILabel = "AEs/Week") dfBounds <- Analyze_Poisson_PredictBounds(dfTransformed, c(-5, 5)) } diff --git a/man/Analyze_Wilcoxon.Rd b/man/Analyze_Wilcoxon.Rd index adddc7ffc..32f911c8c 100644 --- a/man/Analyze_Wilcoxon.Rd +++ b/man/Analyze_Wilcoxon.Rd @@ -6,7 +6,7 @@ \usage{ Analyze_Wilcoxon( dfTransformed, - strOutcomeCol = NULL, + strOutcomeCol = "KRI", strPredictorCol = "SiteID", bQuiet = TRUE ) @@ -53,7 +53,7 @@ The input data (dfTransformed) for Analyze_Wilcoxon is typically created using \examples{ dfInput <- AE_Map_Raw() -dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strExposureCol = "Exposure") -dfAnalyzed <- Analyze_Wilcoxon(dfTransformed, strOutcomeCol = "Rate") +dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strExposureCol = "Exposure", strKRILabel = "AEs/Week") +dfAnalyzed <- Analyze_Wilcoxon(dfTransformed) } diff --git a/man/Consent_Assess.Rd b/man/Consent_Assess.Rd index 5d1935064..98c340ba4 100644 --- a/man/Consent_Assess.Rd +++ b/man/Consent_Assess.Rd @@ -8,6 +8,7 @@ Consent_Assess( dfInput, nThreshold = 0.5, lTags = list(Assessment = "Consent"), + strKRILabel = "Total Number of Consent Issues", bChart = TRUE, bReturnChecks = FALSE, bQuiet = TRUE @@ -20,6 +21,8 @@ Consent_Assess( \item{lTags}{\code{list} Assessment tags, a named list of tags describing the assessment that defaults to \code{list(Assessment="IE")}. \code{lTags} is returned as part of the assessment (\code{lAssess$lTags}) and each tag is added as a column in \code{lAssess$dfSummary}.} +\item{strKRILabel}{\code{character} Describe the \code{KRI} column, a vector of length 1 that defaults to \verb{Total Number of Consent Issues}} + \item{bChart}{\code{logical} Generate data visualization? Default: \code{TRUE}} \item{bReturnChecks}{\code{logical} Return input checks from \code{is_mapping_valid}? Default: \code{FALSE}} diff --git a/man/Flag.Rd b/man/Flag.Rd index a56c9984a..7105ff3af 100644 --- a/man/Flag.Rd +++ b/man/Flag.Rd @@ -6,7 +6,7 @@ \usage{ Flag( dfAnalyzed, - strColumn = "PValue", + strColumn = "Score", vThreshold = c(0.05, NA), strValueColumn = NULL ) @@ -53,11 +53,11 @@ In short, the following columns are considered: \examples{ dfInput <- AE_Map_Adam() -dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strExposureCol = "Exposure") -dfAnalyzed <- Analyze_Wilcoxon(dfTransformed, "Rate") +dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strExposureCol = "Exposure", strKRILabel = "AEs/Week") +dfAnalyzed <- Analyze_Wilcoxon(dfTransformed, "KRI") dfFlagged <- Flag(dfAnalyzed) # PValue < 0.05 flagged dfFlagged10 <- Flag(dfAnalyzed, vThreshold = c(0.10, NA)) # PValue <0.10 flagged # Flag direction set based on 'Statistic' column -dfFlagged <- Flag(dfAnalyzed, strColumn = "PValue", strValueColumn = "Estimate") +dfFlagged <- Flag(dfAnalyzed, strColumn = "Score", strValueColumn = "Estimate") } diff --git a/man/IE_Assess.Rd b/man/IE_Assess.Rd index fec7185ac..066105d0d 100644 --- a/man/IE_Assess.Rd +++ b/man/IE_Assess.Rd @@ -8,6 +8,7 @@ IE_Assess( dfInput, nThreshold = 0.5, lTags = list(Assessment = "IE"), + strKRILabel = "Total Event Count", bChart = TRUE, bReturnChecks = FALSE, bQuiet = TRUE @@ -20,6 +21,8 @@ IE_Assess( \item{lTags}{\code{list} Assessment tags, a named list of tags describing the assessment that defaults to \code{list(Assessment="IE")}. \code{lTags} is returned as part of the assessment (\code{lAssess$lTags}) and each tag is added as a column in \code{lAssess$dfSummary}.} +\item{strKRILabel}{\code{character} Describe the \code{KRI} column, a vector of length 1 that defaults to \verb{Total Event Count}} + \item{bChart}{\code{logical} Generate data visualization? Default: \code{TRUE}} \item{bReturnChecks}{\code{logical} Return input checks from \code{is_mapping_valid}? Default: \code{FALSE}} diff --git a/man/PD_Assess.Rd b/man/PD_Assess.Rd index 1b5fbd337..a12d49bb1 100644 --- a/man/PD_Assess.Rd +++ b/man/PD_Assess.Rd @@ -8,6 +8,7 @@ PD_Assess( dfInput, vThreshold = NULL, strMethod = "poisson", + strKRILabel = "PDs/Week", lTags = list(Assessment = "PD"), bChart = TRUE, bReturnChecks = FALSE, @@ -21,6 +22,8 @@ PD_Assess( \item{strMethod}{\code{character} Statistical model. Valid values include "poisson" (default) and "wilcoxon".} +\item{strKRILabel}{\code{character} Describe the \code{KRI} column, a vector of length 1 that defaults to \code{PDs/Week}} + \item{lTags}{\code{list} Assessment tags, a named list of tags describing the assessment that defaults to \code{list(Assessment="PD")}. \code{lTags} is returned as part of the assessment (\code{lAssess$lTags}) and each tag is added as a column in \code{lAssess$dfSummary}.} \item{bChart}{\code{logical} Generate data visualization? Default: \code{TRUE}} diff --git a/man/Summarize.Rd b/man/Summarize.Rd index d102fe87a..1aa71c66f 100644 --- a/man/Summarize.Rd +++ b/man/Summarize.Rd @@ -4,7 +4,7 @@ \alias{Summarize} \title{Make Summary Data Frame} \usage{ -Summarize(dfFlagged, strScoreCol = "PValue", lTags = NULL) +Summarize(dfFlagged, strScoreCol = "Score", lTags = NULL) } \arguments{ \item{dfFlagged}{data frame in format produced by \code{\link{Flag}}} @@ -36,9 +36,9 @@ Create a concise summary of assessment results that is easy to aggregate across \examples{ dfInput <- AE_Map_Adam() -dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strExposureCol = "Exposure") -dfAnalyzed <- Analyze_Wilcoxon(dfTransformed, "Rate") -dfFlagged <- Flag(dfAnalyzed, strColumn = "PValue", strValueColumn = "Rate") +dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strExposureCol = "Exposure", strKRILabel = "AEs/Week") +dfAnalyzed <- Analyze_Wilcoxon(dfTransformed) +dfFlagged <- Flag(dfAnalyzed, strColumn = "Score", strValueColumn = "Estimate") dfSummary <- Summarize(dfFlagged) } diff --git a/man/Transform_EventCount.Rd b/man/Transform_EventCount.Rd index 02fc4f99d..318de3d09 100644 --- a/man/Transform_EventCount.Rd +++ b/man/Transform_EventCount.Rd @@ -4,7 +4,7 @@ \alias{Transform_EventCount} \title{Transform Event Count} \usage{ -Transform_EventCount(dfInput, strCountCol, strExposureCol = NULL) +Transform_EventCount(dfInput, strCountCol, strExposureCol = NULL, strKRILabel) } \arguments{ \item{dfInput}{A data.frame with one record per person.} @@ -12,6 +12,8 @@ Transform_EventCount(dfInput, strCountCol, strExposureCol = NULL) \item{strCountCol}{Required. Numerical or logical. Column to be counted.} \item{strExposureCol}{Optional. Numerical \code{Exposure} column.} + +\item{strKRILabel}{Optional. Character vector to describe the \code{KRI} column.} } \value{ data.frame with one row per site with columns SiteID, N, TotalCount with additional columns Exposure and Rate if strExposureCol is used. @@ -47,6 +49,6 @@ For data with an optional strExposureCol, a summed exposure is calculated for ea \examples{ dfInput <- AE_Map_Adam() -dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strExposureCol = "Exposure") +dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strExposureCol = "Exposure", strKRILabel = "AEs/Week") } diff --git a/tests/testthat/_snaps/Study_Assess.md b/tests/testthat/_snaps/Study_Assess.md index 1dc07e91f..922b381f2 100644 --- a/tests/testthat/_snaps/Study_Assess.md +++ b/tests/testthat/_snaps/Study_Assess.md @@ -167,7 +167,7 @@ Input data has 3 rows. v `Transform_EventCount()` returned output with 3 rows. - i No analysis function used. `dfTransformed` copied directly to `dfAnalyzed` + i No analysis function used. `dfTransformed` copied directly to `dfAnalyzed` with added `ScoreLabel` column. v `Flag()` returned output with 3 rows. v `Summarize()` returned output with 3 rows. v `Visualize_Count()` created a chart. @@ -208,7 +208,7 @@ Input data has 3 rows. v `Transform_EventCount()` returned output with 3 rows. - i No analysis function used. `dfTransformed` copied directly to `dfAnalyzed` + i No analysis function used. `dfTransformed` copied directly to `dfAnalyzed` with added `ScoreLabel` column. v `Flag()` returned output with 3 rows. v `Summarize()` returned output with 3 rows. v `Visualize_Count()` created a chart. diff --git a/tests/testthat/test_AE_Assess.R b/tests/testthat/test_AE_Assess.R index 795e97ed6..58c0c4495 100644 --- a/tests/testthat/test_AE_Assess.R +++ b/tests/testthat/test_AE_Assess.R @@ -40,6 +40,7 @@ test_that("incorrect inputs throw errors", { expect_snapshot_error(AE_Assess(aeInput %>% select(-Count))) expect_snapshot_error(AE_Assess(aeInput %>% select(-Exposure))) expect_snapshot_error(AE_Assess(aeInput %>% select(-Rate))) + expect_error(AE_Assess(aeInput, strKRILabel = c("label 1", "label 2"))) }) # incorrect lTags throw errors -------------------------------------------- @@ -65,10 +66,10 @@ test_that("incorrect lTags throw errors", { # custom tests ------------------------------------------------------------ test_that("dfAnalyzed has appropriate model output regardless of statistical method", { - assPoisson <- AE_Assess(aeInput, strMethod = "poisson") - expect_true(all(c("Residuals", "PredictedCount") %in% names(assPoisson$dfAnalyzed))) - assWilcoxon <- AE_Assess(aeInput, strMethod = "wilcoxon") - expect_true(all(c("Estimate", "PValue") %in% names(assWilcoxon$dfAnalyzed))) + assessmentPoisson <- AE_Assess(aeInput, strMethod = "poisson") + expect_true(all(c("KRI", "KRILabel", "Score", "ScoreLabel") %in% names(assessmentPoisson$dfAnalyzed))) + assessmentWilcoxon <- AE_Assess(aeInput, strMethod = "wilcoxon") + expect_true(all(c("KRI", "KRILabel", "Score", "ScoreLabel") %in% names(assessmentWilcoxon$dfAnalyzed))) }) test_that("bQuiet works as intended", { @@ -82,3 +83,8 @@ test_that("bReturnChecks works as intended", { "lChecks" %in% names(AE_Assess(aeInput, bReturnChecks = TRUE)) ) }) + +test_that("strKRILabel works as intended", { + ae <- AE_Assess(aeInput, strKRILabel = "my test label") + expect_equal(unique(ae$dfSummary$KRILabel), "my test label") +}) diff --git a/tests/testthat/test_Analyze_Chisq.R b/tests/testthat/test_Analyze_Chisq.R index 6889d415f..683e7e1b4 100644 --- a/tests/testthat/test_Analyze_Chisq.R +++ b/tests/testthat/test_Analyze_Chisq.R @@ -1,7 +1,7 @@ source(testthat::test_path("testdata/data.R")) dfInput <- Disp_Map(dfDisp, strCol = "DCREASCD", strReason = "Adverse Event") -dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count") +dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strKRILabel = "Discontinuation Reasons/Site") test_that("output created as expected and has correct structure", { chisq <- suppressWarnings(Analyze_Chisq(dfTransformed)) diff --git a/tests/testthat/test_Analyze_Fisher.R b/tests/testthat/test_Analyze_Fisher.R index 483fe4748..9b53d987f 100644 --- a/tests/testthat/test_Analyze_Fisher.R +++ b/tests/testthat/test_Analyze_Fisher.R @@ -3,7 +3,7 @@ source(testthat::test_path("testdata/data.R")) dfInput <- Disp_Map(dfDisp, strCol = "DCREASCD", strReason = "Adverse Event") test_that("output created as expected and has correct structure", { - df <- Transform_EventCount(dfInput, strCountCol = "Count") + df <- Transform_EventCount(dfInput, strCountCol = "Count", strKRILabel = "test label") output <- Analyze_Fisher(df) @@ -24,7 +24,8 @@ test_that("incorrect inputs throw errors", { df <- Transform_EventCount( dfInput, - strCountCol = "Count" + strCountCol = "Count", + strKRILabel = "testing label" ) expect_error(Analyze_Fisher(list())) @@ -43,7 +44,8 @@ test_that("error given if required column not found", { df <- Transform_EventCount( dfInput, - strCountCol = "Count" + strCountCol = "Count", + strKRILabel = "testing label" ) expect_error(Analyze_Fisher(df %>% select(-SiteID))) @@ -60,7 +62,8 @@ test_that("NAs are handled correctly", { df <- Transform_EventCount( dfInput, - strCountCol = "Count" + strCountCol = "Count", + strKRILabel = "testing label" ) createNA <- function(data, variable) { diff --git a/tests/testthat/test_Consent_Assess.R b/tests/testthat/test_Consent_Assess.R index 846a2e720..04a8b120f 100644 --- a/tests/testthat/test_Consent_Assess.R +++ b/tests/testthat/test_Consent_Assess.R @@ -36,6 +36,7 @@ test_that("incorrect inputs throw errors", { expect_snapshot_error(Consent_Assess(consentInput %>% select(-SubjectID))) expect_snapshot_error(Consent_Assess(consentInput %>% select(-SiteID))) expect_snapshot_error(Consent_Assess(consentInput %>% select(-Count))) + expect_error(Consent_Assess(consentInput, strKRILabel = c("label 1", "label 2"))) }) @@ -56,7 +57,7 @@ test_that("incorrect lTags throw errors", { # custom tests ------------------------------------------------------------ test_that("dfAnalyzed has appropriate model output regardless of statistical method", { assessment <- Consent_Assess(consentInput) - expect_true(hasName(assessment$dfAnalyzed, "Estimate")) + expect_equal(unique(assessment$dfAnalyzed$ScoreLabel), "Total Number of Consent Issues") }) test_that("bQuiet works as intended", { @@ -70,3 +71,8 @@ test_that("bReturnChecks works as intended", { "lChecks" %in% names(Consent_Assess(consentInput, bReturnChecks = TRUE)) ) }) + +test_that("strKRILabel works as intended", { + consent <- Consent_Assess(consentInput, strKRILabel = "my test label") + expect_equal(unique(consent$dfSummary$KRILabel), "my test label") +}) diff --git a/tests/testthat/test_IE_Assess.R b/tests/testthat/test_IE_Assess.R index 48ba52bbf..a46931ef0 100644 --- a/tests/testthat/test_IE_Assess.R +++ b/tests/testthat/test_IE_Assess.R @@ -36,6 +36,7 @@ test_that("incorrect inputs throw errors", { expect_error(IE_Assess(ieInput %>% select(-SubjectID))) expect_error(IE_Assess(ieInput %>% select(-SiteID))) expect_error(IE_Assess(ieInput %>% select(-Count))) + expect_error(IE_Assess(ieInput, strKRILabel = c("label 1", "label 2"))) }) # incorrect lTags throw errors -------------------------------------------- @@ -53,7 +54,7 @@ test_that("incorrect lTags throw errors", { # custom tests ------------------------------------------------------------ test_that("dfAnalyzed has appropriate model output regardless of statistical method", { assessment <- IE_Assess(ieInput) - expect_true(hasName(assessment$dfAnalyzed, "Estimate")) + expect_equal(unique(assessment$dfAnalyzed$ScoreLabel), "Total Number of Inclusion/Exclusion Issues") }) test_that("bQuiet works as intended", { @@ -67,3 +68,8 @@ test_that("bReturnChecks works as intended", { "lChecks" %in% names(IE_Assess(ieInput, bReturnChecks = TRUE)) ) }) + +test_that("strKRILabel works as intended", { + ie <- IE_Assess(ieInput, strKRILabel = "my test label") + expect_equal(unique(ie$dfSummary$KRILabel), "my test label") +}) diff --git a/tests/testthat/test_PD_Assess.R b/tests/testthat/test_PD_Assess.R index b5973a42c..9b78c142d 100644 --- a/tests/testthat/test_PD_Assess.R +++ b/tests/testthat/test_PD_Assess.R @@ -41,6 +41,7 @@ test_that("incorrect inputs throw errors", { expect_snapshot_error(PD_Assess(pdInput %>% select(-Count))) expect_snapshot_error(PD_Assess(pdInput %>% select(-Exposure))) expect_snapshot_error(PD_Assess(pdInput %>% select(-Rate))) + expect_error(PD_Assess(pdInput, strKRILabel = c("label 1", "label 2"))) }) # incorrect lTags throw errors -------------------------------------------- @@ -76,10 +77,10 @@ test_that("NA in dfInput$Count results in Error for PD_Assess", { }) test_that("dfAnalyzed has appropriate model output regardless of statistical method", { - assPoisson <- PD_Assess(pdInput, strMethod = "poisson") - expect_true(all(c("Residuals", "PredictedCount") %in% names(assPoisson$dfAnalyzed))) - assWilcoxon <- PD_Assess(pdInput, strMethod = "wilcoxon") - expect_true(all(c("Estimate", "PValue") %in% names(assWilcoxon$dfAnalyzed))) + assessmentPoisson <- PD_Assess(pdInput, strMethod = "poisson") + expect_true(all(c("KRI", "KRILabel", "Score", "ScoreLabel") %in% names(assessmentPoisson$dfAnalyzed))) + assessmentWilcoxon <- PD_Assess(pdInput, strMethod = "wilcoxon") + expect_true(all(c("KRI", "KRILabel", "Score", "ScoreLabel") %in% names(assessmentWilcoxon$dfAnalyzed))) }) test_that("bQuiet works as intended", { @@ -93,3 +94,8 @@ test_that("bReturnChecks works as intended", { "lChecks" %in% names(PD_Assess(pdInput, bReturnChecks = TRUE)) ) }) + +test_that("strKRILabel works as intended", { + pd <- PD_Assess(pdInput, strKRILabel = "my test label") + expect_equal(unique(pd$dfSummary$KRILabel), "my test label") +}) diff --git a/tests/testthat/test_Study_Assess.R b/tests/testthat/test_Study_Assess.R index 2b747c8fc..e79de9b76 100644 --- a/tests/testthat/test_Study_Assess.R +++ b/tests/testthat/test_Study_Assess.R @@ -25,7 +25,6 @@ test_that("output is created as expected", { # metadata is returned as expected ---------------------------------------- test_that("metadata is returned as expected", { ae <- result$ae - expect_equal(ae$label, "Treatment-Emergent Adverse Events") expect_equal(ae$tags, list(Assessment = "Safety", Label = "AEs")) expect_equal(ae$lResults$strFunctionName, "AE_Assess()") expect_equal(ae$workflow[[1]], list( @@ -111,7 +110,7 @@ test_that("custom lAssessments runs as intended", { custom_assessments <- MakeAssessmentList() custom_assessments$ie$workflow <- NULL result <- Study_Assess(lAssessments = custom_assessments) - expect_equal(length(result$ie), 7) + expect_equal(length(result$ie), 6) }) test_that("bQuiet works as intended", { diff --git a/tests/testthat/test_Summarize.R b/tests/testthat/test_Summarize.R index 6df4ea432..f005765dc 100644 --- a/tests/testthat/test_Summarize.R +++ b/tests/testthat/test_Summarize.R @@ -2,19 +2,19 @@ source(testthat::test_path("testdata/data.R")) ae_input <- AE_Map_Adam(dfs = list(dfADSL = dfADSL, dfADAE = dfADAE)) -dfTransformed <- Transform_EventCount(ae_input, strCountCol = "Count", strExposureCol = "Exposure") +dfTransformed <- Transform_EventCount(ae_input, strCountCol = "Count", strExposureCol = "Exposure", strKRILabel = "AEs/Week") dfAnalyzed <- gsm::Analyze_Poisson(dfTransformed) -dfFlagged <- gsm::Flag(dfAnalyzed, strColumn = "Residuals", vThreshold = c(-5, 5)) +dfFlagged <- gsm::Flag(dfAnalyzed, vThreshold = c(-5, 5)) test_that("output created as expected and has correct structure", { - ae_default <- Summarize(dfFlagged, "Residuals") + ae_default <- Summarize(dfFlagged, strScoreCol = "Score") expect_true(is.data.frame(ae_default)) - expect_equal(names(ae_default), c("SiteID", "N", "Score", "Flag")) + expect_equal(names(ae_default), c("SiteID", "N", "KRI", "KRILabel", "Score", "ScoreLabel", "Flag")) expect_equal(sort(unique(ae_input$SiteID)), sort(ae_default$SiteID)) - ae_finding <- Summarize(dfFlagged, "Residuals", list(Assessment = "Safety", Label = "Test Assessment")) + ae_finding <- Summarize(dfFlagged, strScoreCol = "Score", lTags = list(Assessment = "Safety", Label = "Test Assessment")) expect_true(is.data.frame(ae_finding)) - expect_equal(names(ae_finding), c("SiteID", "N", "Score", "Flag", "Assessment", "Label")) + expect_equal(names(ae_finding), c("SiteID", "N", "KRI", "KRILabel", "Score", "ScoreLabel", "Flag", "Assessment", "Label")) expect_equal(sort(unique(ae_input$SiteID)), sort(ae_finding$SiteID)) }) @@ -26,16 +26,30 @@ test_that("incorrect inputs throw errors", { }) test_that("invalid lTags throw error", { - expect_error(Summarize(dfFlagged, strScoreCol = "Residuals", lTags = "hi mom")) - expect_error(Summarize(dfFlagged, strScoreCol = "Residuals", lTags = list("hi", "mom"))) - expect_error(Summarize(dfFlagged, strScoreCol = "Residuals", lTags = list(greeting = "hi", "mom"))) - expect_silent(Summarize(dfFlagged, strScoreCol = "Residuals", lTags = list(greeting = "hi", person = "mom"))) + expect_error(Summarize(dfFlagged, lTags = "hi mom")) + expect_error(Summarize(dfFlagged, lTags = list("hi", "mom"))) + expect_error(Summarize(dfFlagged, lTags = list(greeting = "hi", "mom"))) + expect_silent(Summarize(dfFlagged, lTags = list(greeting = "hi", person = "mom"))) }) test_that("output is correctly sorted by Flag and Score", { - sim1 <- data.frame(SiteID = seq(1:100), N = seq(1:100), PValue = rep(NA, 100), ThresholdLow = rep(10, 100), ThresholdHigh = rep(NA, 100), Flag = c(rep(-1, 9), rep(0, 91))) + sim1 <- data.frame(SiteID = seq(1:100), + N = seq(1:100), + KRI = rep(NA, 100), + KRILabel = "cats", + Score = c(rep(0, 20), rep(1, 80)), + ScoreLabel = "dogs", + Flag = c(rep(-1, 9), rep(0, 91))) + expect_equal(Summarize(sim1)$Flag, c(rep(-1, 9), rep(0, 91))) - sim1 <- data.frame(SiteID = seq(1, 100), N = seq(1, 100), PValue = c(seq(1, 5), seq(6, 1), rep(11, 89)), ThresholdLow = rep(10, 100), ThresholdHigh = rep(NA, 100), Flag = c(rep(-1, 9), rep(0, 91))) - expect_equal(Summarize(sim1, strScoreCol = "PValue")$Score, c(6, 5, 5, 4, 4, 3, 3, 2, 1, rep(11, 89), 2, 1)) + sim1 <- data.frame(SiteID = seq(1, 100), + N = seq(1, 100), + KRI = c(seq(1, 5), seq(6, 1), rep(11, 89)), + KRILabel = "fictitious things by general relativity", + Score = c(seq(1, 5), seq(6, 1), rep(11, 89)), + ScoreLabel = "homerun", + Flag = c(rep(-1, 9), rep(0, 91))) + + expect_equal(Summarize(sim1)$Score, c(6, 5, 5, 4, 4, 3, 3, 2, 1, rep(11, 89), 2, 1)) }) diff --git a/tests/testthat/test_Transform_EventCount.R b/tests/testthat/test_Transform_EventCount.R index d5bed43e9..2fe44c9bf 100644 --- a/tests/testthat/test_Transform_EventCount.R +++ b/tests/testthat/test_Transform_EventCount.R @@ -3,47 +3,63 @@ source(testthat::test_path("testdata/data.R")) ae_input <- AE_Map_Adam(dfs = list(dfADSL = dfADSL, dfADAE = dfADAE)) test_that("output created as expected and has correct structure", { - ae_prep <- Transform_EventCount(ae_input, strCountCol = "Count", strExposureCol = "Exposure") + ae_prep <- Transform_EventCount(ae_input, strCountCol = "Count", strExposureCol = "Exposure", strKRILabel = "Test Label") expect_true(is.data.frame(ae_prep)) expect_equal(sort(unique(ae_input$SiteID)), sort(ae_prep$SiteID)) - expect_equal(names(Transform_EventCount(ae_input, strCountCol = "Count")), c("SiteID", "N", "TotalCount")) - expect_equal(names(Transform_EventCount(ae_input, strCountCol = "Count", strExposureCol = "Exposure")), c("SiteID", "N", "TotalCount", "TotalExposure", "Rate")) + expect_equal( + names(Transform_EventCount(ae_input, strCountCol = "Count", strKRILabel = "Test Label")), + c("SiteID", "N", "TotalCount", "KRI", "KRILabel") + ) + expect_equal( + names(Transform_EventCount(ae_input, strCountCol = "Count", strExposureCol = "Exposure", strKRILabel = "Test Label")), + c("SiteID", "N", "TotalCount", "TotalExposure", "KRI", "KRILabel") + ) }) -test_that("cCount works as expected", { +test_that("strCountCol works as expected", { sim <- data.frame( SiteID = rep("site1", 30), event = c(rep(0, 5), rep(1, 15), rep(2, 10)) ) - EventCount <- Transform_EventCount(sim, strCountCol = "event") - expect_equal(EventCount, tibble(SiteID = "site1", N = 30, TotalCount = 35)) + EventCount <- Transform_EventCount(sim, strCountCol = "event", strKRILabel = "Test Label") + expect_equal(EventCount, tibble(SiteID = "site1", N = 30, TotalCount = 35, KRI = 35, KRILabel = "Test Label")) sim2 <- data.frame( SiteID = c(rep("site1", 10), rep("site2", 8), rep("site3", 12)), event = c(rep(0, 5), rep(1, 15), rep(2, 10)) ) - EventCount2 <- Transform_EventCount(sim2, strCountCol = "event") - expect_equal(EventCount2, tibble(SiteID = c("site1", "site2", "site3"), N = c(10, 8, 12), TotalCount = c(5, 8, 22))) + EventCount2 <- Transform_EventCount(sim2, strCountCol = "event", strKRILabel = "Test Label") + expect_equal( + EventCount2, + tibble(SiteID = c("site1", "site2", "site3"), + N = c(10, 8, 12), + TotalCount = c(5, 8, 22), + KRI = c(5, 8, 22), + KRILabel = "Test Label")) }) -test_that("cExposureCol works as expected", { +test_that("strExposureCol works as expected", { sim3 <- data.frame( SiteID = c(rep("site1", 11), rep("site2", 7), rep("site3", 12)), event = c(rep(0, 6), rep(1, 12), rep(2, 12)), ndays = c(rep(5, 6), rep(10, 12), rep(10, 12)) ) - EventCount3 <- Transform_EventCount(sim3, strCountCol = "event", strExposureCol = "ndays") - expect_equal(EventCount3, tibble( - SiteID = c("site1", "site2", "site3"), N = c(11, 7, 12), TotalCount = c(5, 7, 24), - TotalExposure = c(80, 70, 120), Rate = c(0.0625, 0.1, 0.2) - )) + EventCount3 <- Transform_EventCount(sim3, strCountCol = "event", strExposureCol = "ndays", strKRILabel = "Test Label") + expect_equal(EventCount3, + tibble::tribble( + ~SiteID, ~N, ~TotalCount, ~TotalExposure, ~KRI, ~KRILabel, + "site1", 11L, 5, 80, 0.0625, "Test Label", + "site2", 7L, 7, 70, 0.1, "Test Label", + "site3", 12L, 24, 120, 0.2, "Test Label" + ) + ) }) test_that("incorrect inputs throw errors", { - expect_error(Transform_EventCount(list())) - expect_error(Transform_EventCount("Hi")) - expect_error(Transform_EventCount(ae_input, strCountCol = "NotACol")) - expect_error(Transform_EventCount(ae_input, strExposureCol = "NotACol")) + expect_error(Transform_EventCount(list(), strKRILabel = "Test Label")) + expect_error(Transform_EventCount("Hi", strKRILabel = "Test Label")) + expect_error(Transform_EventCount(ae_input, strCountCol = "NotACol", strKRILabel = "Test Label")) + expect_error(Transform_EventCount(ae_input, strExposureCol = "NotACol", strKRILabel = "Test Label")) }) test_that("NA in Exposure throws a warning and returns correct data", { @@ -53,16 +69,17 @@ test_that("NA in Exposure throws a warning and returns correct data", { ndays = c(NA, rep(5, 5), NA, rep(10, 11), NA, rep(10, 10), NA) ) - expect_warning(Transform_EventCount(sim4, strCountCol = "event", strExposureCol = "ndays")) - expect_false(anyNA(suppressWarnings(Transform_EventCount(sim4, strCountCol = "event", strExposureCol = "ndays")) %>% pull(.data$TotalExposure))) + expect_warning(Transform_EventCount(sim4, strCountCol = "event", strExposureCol = "ndays", strKRILabel = "Test Label")) + expect_false(anyNA(suppressWarnings(Transform_EventCount(sim4, strCountCol = "event", strExposureCol = "ndays", strKRILabel = "Test Label")) %>% pull(.data$TotalExposure))) expect_equal( - suppressWarnings(Transform_EventCount(sim4, strCountCol = "event", strExposureCol = "ndays")), + suppressWarnings(Transform_EventCount(sim4, strCountCol = "event", strExposureCol = "ndays", strKRILabel = "Test Label")), tibble( SiteID = c("site1", "site2", "site3"), N = c(9, 7, 10), TotalCount = c(4, 7, 20), TotalExposure = c(65, 70, 100), - Rate = c(4 / 65, 7 / 70, 20 / 100) + KRI = c(4 / 65, 7 / 70, 20 / 100), + KRILabel = "Test Label" ) ) }) @@ -70,11 +87,13 @@ test_that("NA in Exposure throws a warning and returns correct data", { test_that("NA in Exposure is removed ", { ae_input2 <- ae_input ae_input2[1, "Exposure"] <- NA - expect_false(anyNA(suppressWarnings(Transform_EventCount(ae_input2, strCountCol = "Count", strExposureCol = "Exposure")) %>% pull(.data$TotalExposure))) + expect_false(anyNA(suppressWarnings(Transform_EventCount(ae_input2, strCountCol = "Count", strExposureCol = "Exposure", strKRILabel = "Test Label")) %>% + pull(.data$TotalExposure)) + ) }) test_that("NA in Count throws an Error", { ae_input2 <- ae_input ae_input2[1, "Count"] <- NA - expect_error(suppressWarnings(Transform_EventCount(ae_input2, strCountCol = "Count", strExposureCol = "Exposure"))) + expect_error(suppressWarnings(Transform_EventCount(ae_input2, strCountCol = "Count", strExposureCol = "Exposure", strKRILabel = "Test Label"))) }) From 9cab8b87a99398d1356811023095dd175f3e6f7c Mon Sep 17 00:00:00 2001 From: Li Ge Date: Wed, 8 Jun 2022 16:14:30 -0700 Subject: [PATCH 36/87] fix #515 --- R/util-parse_data_spec.R | 9 ++++----- man/AE_Map_Adam.Rd | 2 +- man/AE_Map_Raw.Rd | 2 +- man/Consent_Map_Raw.Rd | 14 +++++++------- man/IE_Map_Raw.Rd | 6 +++--- man/PD_Map_Raw.Rd | 2 +- man/md/AE_Map_Adam.md | 2 +- man/md/AE_Map_Raw.md | 2 +- man/md/Consent_Map_Raw.md | 14 +++++++------- man/md/IE_Map_Raw.md | 6 +++--- man/md/PD_Map_Raw.md | 2 +- 11 files changed, 30 insertions(+), 31 deletions(-) diff --git a/R/util-parse_data_spec.R b/R/util-parse_data_spec.R index 1095b0202..11d9c54b2 100644 --- a/R/util-parse_data_spec.R +++ b/R/util-parse_data_spec.R @@ -5,7 +5,7 @@ #' @param content `list` data specification #' @param file `character` file path of .yaml file #' -#' @importFrom purrr reduce +#' @import dplyr #' @importFrom tibble tibble #' @importFrom yaml read_yaml #' @@ -29,7 +29,7 @@ parse_data_spec <- function( domains <- names(content) # Create list to append metadata from each domain to. - domain_list <- vector("list", length(domains)) + domain_list <- list() # Iterate over domains. for (domain in domains) { @@ -58,9 +58,8 @@ parse_data_spec <- function( # De-structure domain list as data frame. spec <- domain_list %>% - purrr::reduce( - dplyr::bind_rows - ) + dplyr::bind_rows() %>% + dplyr::mutate_if(is.logical, ~ dplyr::coalesce(., FALSE)) spec } diff --git a/man/AE_Map_Adam.Rd b/man/AE_Map_Adam.Rd index e00e3d7a4..3043e5d20 100644 --- a/man/AE_Map_Adam.Rd +++ b/man/AE_Map_Adam.Rd @@ -50,7 +50,7 @@ AEs by passing filtered AE data to \code{dfADAE}. dfADSL \tab strSiteCol \tab SITEID \tab TRUE \tab FALSE \cr dfADSL \tab strStartCol \tab TRTSDT \tab TRUE \tab FALSE \cr dfADSL \tab strEndCol \tab TRTEDT \tab TRUE \tab FALSE \cr - dfADAE \tab strIDCol \tab USUBJID \tab TRUE \tab \cr + dfADAE \tab strIDCol \tab USUBJID \tab TRUE \tab FALSE \cr } } diff --git a/man/AE_Map_Raw.Rd b/man/AE_Map_Raw.Rd index ab267bbfe..fd11c3864 100644 --- a/man/AE_Map_Raw.Rd +++ b/man/AE_Map_Raw.Rd @@ -49,7 +49,7 @@ AEs by passing filtered AE data to \code{dfAE}. dfSUBJ \tab strIDCol \tab SubjectID \tab TRUE \tab TRUE \cr dfSUBJ \tab strSiteCol \tab SiteID \tab TRUE \tab FALSE \cr dfSUBJ \tab strTimeOnTreatmentCol \tab TimeOnTreatment \tab TRUE \tab FALSE \cr - dfAE \tab strIDCol \tab SubjectID \tab TRUE \tab \cr + dfAE \tab strIDCol \tab SubjectID \tab TRUE \tab FALSE \cr } } diff --git a/man/Consent_Map_Raw.Rd b/man/Consent_Map_Raw.Rd index 532a713b9..cdc34d587 100644 --- a/man/Consent_Map_Raw.Rd +++ b/man/Consent_Map_Raw.Rd @@ -46,13 +46,13 @@ types of consent by customizing \code{lMapping$dfCONSENT}. \section{Data specification}{ \tabular{llllll}{ \strong{Domain} \tab \strong{Column Key} \tab \strong{Default Value} \tab \strong{Required?} \tab \strong{Accept NA/Empty Values?} \tab \strong{Require Unique Values?} \cr - dfSUBJ \tab strIDCol \tab SubjectID \tab TRUE \tab \tab TRUE \cr - dfSUBJ \tab strSiteCol \tab SiteID \tab TRUE \tab \tab FALSE \cr - dfSUBJ \tab strRandDateCol \tab RandDate \tab TRUE \tab \tab FALSE \cr - dfCONSENT \tab strIDCol \tab SubjectID \tab TRUE \tab FALSE \tab \cr - dfCONSENT \tab strTypeCol \tab CONSENT_TYPE \tab TRUE \tab FALSE \tab \cr - dfCONSENT \tab strValueCol \tab CONSENT_VALUE \tab TRUE \tab FALSE \tab \cr - dfCONSENT \tab strDateCol \tab CONSENT_DATE \tab TRUE \tab TRUE \tab \cr + dfSUBJ \tab strIDCol \tab SubjectID \tab TRUE \tab FALSE \tab TRUE \cr + dfSUBJ \tab strSiteCol \tab SiteID \tab TRUE \tab FALSE \tab FALSE \cr + dfSUBJ \tab strRandDateCol \tab RandDate \tab TRUE \tab FALSE \tab FALSE \cr + dfCONSENT \tab strIDCol \tab SubjectID \tab TRUE \tab FALSE \tab FALSE \cr + dfCONSENT \tab strTypeCol \tab CONSENT_TYPE \tab TRUE \tab FALSE \tab FALSE \cr + dfCONSENT \tab strValueCol \tab CONSENT_VALUE \tab TRUE \tab FALSE \tab FALSE \cr + dfCONSENT \tab strDateCol \tab CONSENT_DATE \tab TRUE \tab TRUE \tab FALSE \cr } } diff --git a/man/IE_Map_Raw.Rd b/man/IE_Map_Raw.Rd index 5cd880a32..a01f39ee3 100644 --- a/man/IE_Map_Raw.Rd +++ b/man/IE_Map_Raw.Rd @@ -48,9 +48,9 @@ specific types of IE criteria by passing filtered IE data to \code{dfIE}. \strong{Domain} \tab \strong{Column Key} \tab \strong{Default Value} \tab \strong{Required?} \tab \strong{Require Unique Values?} \cr dfSUBJ \tab strIDCol \tab SubjectID \tab TRUE \tab TRUE \cr dfSUBJ \tab strSiteCol \tab SiteID \tab TRUE \tab FALSE \cr - dfIE \tab strIDCol \tab SubjectID \tab TRUE \tab \cr - dfIE \tab strCategoryCol \tab IE_CATEGORY \tab TRUE \tab \cr - dfIE \tab strValueCol \tab IE_VALUE \tab TRUE \tab \cr + dfIE \tab strIDCol \tab SubjectID \tab TRUE \tab FALSE \cr + dfIE \tab strCategoryCol \tab IE_CATEGORY \tab TRUE \tab FALSE \cr + dfIE \tab strValueCol \tab IE_VALUE \tab TRUE \tab FALSE \cr } } diff --git a/man/PD_Map_Raw.Rd b/man/PD_Map_Raw.Rd index 81cd879a4..4f44259fd 100644 --- a/man/PD_Map_Raw.Rd +++ b/man/PD_Map_Raw.Rd @@ -49,7 +49,7 @@ PDs by passing filtered PD data to \code{dfPD}. dfSUBJ \tab strIDCol \tab SubjectID \tab TRUE \tab TRUE \cr dfSUBJ \tab strSiteCol \tab SiteID \tab TRUE \tab FALSE \cr dfSUBJ \tab strTimeOnStudyCol \tab TimeOnStudy \tab TRUE \tab FALSE \cr - dfPD \tab strIDCol \tab SubjectID \tab TRUE \tab \cr + dfPD \tab strIDCol \tab SubjectID \tab TRUE \tab FALSE \cr } } diff --git a/man/md/AE_Map_Adam.md b/man/md/AE_Map_Adam.md index 4ee09b009..b4f7da576 100644 --- a/man/md/AE_Map_Adam.md +++ b/man/md/AE_Map_Adam.md @@ -6,4 +6,4 @@ |dfADSL |strSiteCol |SITEID |TRUE |FALSE | |dfADSL |strStartCol |TRTSDT |TRUE |FALSE | |dfADSL |strEndCol |TRTEDT |TRUE |FALSE | -|dfADAE |strIDCol |USUBJID |TRUE | | +|dfADAE |strIDCol |USUBJID |TRUE |FALSE | diff --git a/man/md/AE_Map_Raw.md b/man/md/AE_Map_Raw.md index 2e9a4bb84..d705ff8e5 100644 --- a/man/md/AE_Map_Raw.md +++ b/man/md/AE_Map_Raw.md @@ -5,4 +5,4 @@ |dfSUBJ |strIDCol |SubjectID |TRUE |TRUE | |dfSUBJ |strSiteCol |SiteID |TRUE |FALSE | |dfSUBJ |strTimeOnTreatmentCol |TimeOnTreatment |TRUE |FALSE | -|dfAE |strIDCol |SubjectID |TRUE | | +|dfAE |strIDCol |SubjectID |TRUE |FALSE | diff --git a/man/md/Consent_Map_Raw.md b/man/md/Consent_Map_Raw.md index a4b1897ae..98577be7a 100644 --- a/man/md/Consent_Map_Raw.md +++ b/man/md/Consent_Map_Raw.md @@ -2,10 +2,10 @@ |**Domain** |**Column Key** |**Default Value** |**Required?** |**Accept NA/Empty Values?** |**Require Unique Values?** | |:----------|:--------------|:-----------------|:-------------|:---------------------------|:--------------------------| -|dfSUBJ |strIDCol |SubjectID |TRUE | |TRUE | -|dfSUBJ |strSiteCol |SiteID |TRUE | |FALSE | -|dfSUBJ |strRandDateCol |RandDate |TRUE | |FALSE | -|dfCONSENT |strIDCol |SubjectID |TRUE |FALSE | | -|dfCONSENT |strTypeCol |CONSENT_TYPE |TRUE |FALSE | | -|dfCONSENT |strValueCol |CONSENT_VALUE |TRUE |FALSE | | -|dfCONSENT |strDateCol |CONSENT_DATE |TRUE |TRUE | | +|dfSUBJ |strIDCol |SubjectID |TRUE |FALSE |TRUE | +|dfSUBJ |strSiteCol |SiteID |TRUE |FALSE |FALSE | +|dfSUBJ |strRandDateCol |RandDate |TRUE |FALSE |FALSE | +|dfCONSENT |strIDCol |SubjectID |TRUE |FALSE |FALSE | +|dfCONSENT |strTypeCol |CONSENT_TYPE |TRUE |FALSE |FALSE | +|dfCONSENT |strValueCol |CONSENT_VALUE |TRUE |FALSE |FALSE | +|dfCONSENT |strDateCol |CONSENT_DATE |TRUE |TRUE |FALSE | diff --git a/man/md/IE_Map_Raw.md b/man/md/IE_Map_Raw.md index b3d44f7f9..f1ecfec71 100644 --- a/man/md/IE_Map_Raw.md +++ b/man/md/IE_Map_Raw.md @@ -4,6 +4,6 @@ |:----------|:--------------|:-----------------|:-------------|:--------------------------| |dfSUBJ |strIDCol |SubjectID |TRUE |TRUE | |dfSUBJ |strSiteCol |SiteID |TRUE |FALSE | -|dfIE |strIDCol |SubjectID |TRUE | | -|dfIE |strCategoryCol |IE_CATEGORY |TRUE | | -|dfIE |strValueCol |IE_VALUE |TRUE | | +|dfIE |strIDCol |SubjectID |TRUE |FALSE | +|dfIE |strCategoryCol |IE_CATEGORY |TRUE |FALSE | +|dfIE |strValueCol |IE_VALUE |TRUE |FALSE | diff --git a/man/md/PD_Map_Raw.md b/man/md/PD_Map_Raw.md index d63c78fd0..392296f9d 100644 --- a/man/md/PD_Map_Raw.md +++ b/man/md/PD_Map_Raw.md @@ -5,4 +5,4 @@ |dfSUBJ |strIDCol |SubjectID |TRUE |TRUE | |dfSUBJ |strSiteCol |SiteID |TRUE |FALSE | |dfSUBJ |strTimeOnStudyCol |TimeOnStudy |TRUE |FALSE | -|dfPD |strIDCol |SubjectID |TRUE | | +|dfPD |strIDCol |SubjectID |TRUE |FALSE | From a100b422fa2214e02b181c622f152aea19f80cdd Mon Sep 17 00:00:00 2001 From: Li Ge Date: Wed, 8 Jun 2022 17:03:15 -0700 Subject: [PATCH 37/87] fix #529 --- R/util-MergeSubjects.R | 2 +- tests/testthat/_snaps/Study_Assess.md | 6 ------ 2 files changed, 1 insertion(+), 7 deletions(-) diff --git a/R/util-MergeSubjects.R b/R/util-MergeSubjects.R index 2650d4cdf..273b3078e 100644 --- a/R/util-MergeSubjects.R +++ b/R/util-MergeSubjects.R @@ -22,7 +22,7 @@ #' @export MergeSubjects <- function(dfDomain, dfSubjects, strIDCol = "SubjectID", vFillZero = NULL, bQuiet = TRUE) { - cli_alert_info("Intializing merge of domain and subject data") + if (!bQuiet) cli_alert_info("Intializing merge of domain and subject data") is_domain_valid <- gsm::is_mapping_valid( df = dfDomain, mapping = list("strIDCol" = strIDCol), diff --git a/tests/testthat/_snaps/Study_Assess.md b/tests/testthat/_snaps/Study_Assess.md index 1dc07e91f..d38650151 100644 --- a/tests/testthat/_snaps/Study_Assess.md +++ b/tests/testthat/_snaps/Study_Assess.md @@ -9,7 +9,6 @@ Saving dfAE to `lAssessment$lData` Preparing parameters for `AE_Map_Raw()` ... Calling `AE_Map_Raw()` ... - i Intializing merge of domain and subject data v `AE_Map_Raw()` Successful Saving dfInput to `lAssessment$lData` Preparing parameters for `AE_Assess()` ... @@ -18,7 +17,6 @@ Saving lResults to `lAssessment` Preparing parameters for `Consent_Map_Raw()` ... Calling `Consent_Map_Raw()` ... - i Intializing merge of domain and subject data v `Consent_Map_Raw()` Successful Saving dfInput to `lAssessment$lData` Preparing parameters for `Consent_Assess()` ... @@ -27,7 +25,6 @@ Saving lResults to `lAssessment` Preparing parameters for `IE_Map_Raw()` ... Calling `IE_Map_Raw()` ... - i Intializing merge of domain and subject data v `IE_Map_Raw()` Successful Saving dfInput to `lAssessment$lData` Preparing parameters for `IE_Assess()` ... @@ -40,7 +37,6 @@ Saving dfPD to `lAssessment$lData` Preparing parameters for `PD_Map_Raw()` ... Calling `PD_Map_Raw()` ... - i Intializing merge of domain and subject data v `PD_Map_Raw()` Successful Saving dfInput to `lAssessment$lData` Preparing parameters for `PD_Assess()` ... @@ -49,7 +45,6 @@ Saving lResults to `lAssessment` Preparing parameters for `PD_Map_Raw()` ... Calling `PD_Map_Raw()` ... - i Intializing merge of domain and subject data v `PD_Map_Raw()` Successful Saving dfInput to `lAssessment$lData` Preparing parameters for `PD_Assess()` ... @@ -66,7 +61,6 @@ Saving dfAE to `lAssessment$lData` Preparing parameters for `AE_Map_Raw()` ... Calling `AE_Map_Raw()` ... - i Intializing merge of domain and subject data v `AE_Map_Raw()` Successful Saving dfInput to `lAssessment$lData` Preparing parameters for `AE_Assess()` ... From ddb8005fe0860f45745f1793279b4c8e46f40495 Mon Sep 17 00:00:00 2001 From: Jeremy Wildfire Date: Thu, 9 Jun 2022 09:33:42 -0400 Subject: [PATCH 38/87] Apply suggestions from code review Co-authored-by: Matt Roumaya <40671730+mattroumaya@users.noreply.github.com> --- vignettes/DataPipeline.Rmd | 49 ++++++++++++++++++++------------------ 1 file changed, 26 insertions(+), 23 deletions(-) diff --git a/vignettes/DataPipeline.Rmd b/vignettes/DataPipeline.Rmd index 9fb6169cf..7b2ee73a1 100644 --- a/vignettes/DataPipeline.Rmd +++ b/vignettes/DataPipeline.Rmd @@ -16,13 +16,13 @@ knitr::opts_chunk$set( ``` # Intro -The {gsm} package provides a standardized workflow that leverages Key Risk Indicators (KRIs) and thresholds to conduct study-level Risk Based Monitoring (RBM) for clinical trials. This vignette provides an overview of the {gsm} data model. First, we provide an overview of standardized data pipeline used to calculate KRIs and evaluate thresholds to set site-level flags. We also discuss workflows and reports that allow users to run multiple KRIs concurrently on a study. +The {gsm} package provides a standardized workflow that leverages Key Risk Indicators (KRIs) and thresholds to conduct study-level Risk Based Monitoring (RBM) for clinical trials. This vignette provides an overview of the {gsm} data model. First, we provide an overview of the standardized data pipeline used to calculate KRIs and evaluate thresholds to set site-level flags. We also discuss workflows and reports that allow users to run multiple KRIs concurrently on a study. # KRI Data Pipeline image -In the context of clinical research a KRI, is a measure of risk associated with the conduct of a clinical trial. Examples of KRIs include the rate of adverse events or amount of missing data at a site or across sites. Defining and deploying KRIs during study start-up allows sponsors to continually monitor risks to the integrity of the trial and take corrective actions accordingly. +In the context of clinical research, a KRI is a measure of risk associated with the conduct of a clinical trial. Examples of KRIs include the rate of adverse events or amount of missing data at a site or across sites. Defining and deploying KRIs during study start-up allows sponsors to continually monitor risks to the integrity of the trial and take corrective actions accordingly. The KRI data pipeline begins with one or more clinical datasets related to the KRI. An optional participant-level subset is then applied to each dataset before aggregating by participant to quantify the KRI at the participant level. This aggregated dataset is then further summarized by site to obtain site-level metrics. @@ -36,13 +36,13 @@ The image above provides an overview of the KRI assessment pipeline. The pipelin 2. `transformed` data - Site-level transformed data including KRI calculation. Created by `Transform` functions. 3. `analyzed` data - Site-level analysis result data. Created by `Analyze` functions. 4. `flagged` data - Site-level analysis results with flags added. Created by passing numeric `thresholds` to a `Flag` function. -5. `summary` data - Standardized subset the flagged data. This summary data has the same structure for all assessments and always includes both `KRI` and `Flag` values so that we can easily look at trends for any given site across multiple assessments. Created using a `Summarize` Function. +5. `summary` data - Standardized subset of the flagged data. This summary data has the same structure for all assessments and always includes both `KRI` and `Flag` values so that we can easily look at trends for any given site across multiple assessments. Created using a `Summarize` Function. Finally, each assessment has an `Assess` function that sequentially executes all 4 of the functions and returns a list containing all 5 data sets listed above. ## Generating `input` data -Creating input data is outside the scope of the assessment pipeline. The specifications for `input` data are designed so that the data can easily be generated from multiple clinical data standards (e.g. Raw, ADaM or SDTM). Most assessments have `Map` functions that can be used to generate `input` data. For example, the Adverse Event assessment has 2 map functions, `AE_Map_Raw()` and `AE_Map_Adam()` which create `input` data from Raw and ADaM data respectively. +Creating input data is outside the scope of the assessment pipeline. The specifications for `input` data are designed so that the data can easily be generated from multiple clinical data standards (e.g. Raw, ADaM or SDTM). Most assessments have `Map` functions that can be used to generate `input` data. For example, the Adverse Event assessment has 2 map functions, `AE_Map_Raw()` and `AE_Map_Adam()`, which create `input` data from Raw and ADaM data respectively. These `map` functions are provided for convenience but may not work for all clinical studies. When no `map` function is available for a given assessment, the user is expected to manually create `input` data following the specifications for that assessment. @@ -50,27 +50,30 @@ These `map` functions are provided for convenience but may not work for all clin Running multiple assessments for a single study is a common use case and {gsm} provides workflow and reporting functions to streamline this process. -`Study_Assess()` attempts to run one or more assessment workflows using shared data and metadata. The metadata used for this study-level assessment is described in detail in this appendix for this vignette. The function returns a a list of assessments containing status information and results that is used as input for the reporting functions described below. -`Study_Assess`. +`Study_Assess()` attempts to run one or more assessment workflows using shared data and metadata. The metadata used for this study-level assessment is described in detail in [Appendix 1](#Appendix-1-Metadata-Technical-Specifications). The `Study_Assess()` function returns a list of assessments containing status information and results that is used as input for the reporting functions described below. -`Study_Report()` creates a detailed report showing both charts and listings summarizing each KRI that was run for the study along with a study-level table (via `Study_Table()`) and a summary of the workflow run to generate each KRI (via `Study_AssessmentTable()`) +`Study_Report()` creates a detailed report showing both charts and listings summarizing each KRI that was run for the study, along with a study-level table (via `Study_Table()`), and a summary of the workflow run to generate each KRI (via `Study_AssessmentTable()`) . To see a sample report, simply run: ``` -results<-Study_Assess() -StudyReport(results) +results <- Study_Assess() +Study_Report(results) ``` -Many additional examples are provided in the `Cookbook` Vignette. +Many additional examples are provided in the [`Cookbook` Vignette](Cookbook.html). # Appendix 1 - Metadata Technical Specifications -{gsm} has several standardized metadata models that are use to facilitate a standardized, reusable workflow for RBM. The default metadata used by the package are stored as YAML files in the `inst` folder, and can be customized for any given study. Detailed specification for each type of metadata is provided below, and example data for the AE domain is provided. +{gsm} has several standardized metadata models that are used to facilitate a standardized, reusable workflow for RBM. The default metadata used by {gsm} are stored as YAML files in the `inst` folder, and can be customized for any given study. + +Detailed specifications for each type of metadata is provided below, and example data for the AE domain is provided. ## Data Specification Metadata -Input data specifications define the data requirements for a given {gsm} function and are saved in `inst/specs`. Each spec lists the data domains required for the function defines the following parameters for each domain: +Input data specifications define the data requirements for a given {gsm} function and are saved in `inst/specs`. + +Each input data specification lists the data domains required for the function and specifies the following parameters for each domain: - `vRequired` - list of parameters that should be defined in `mapping` (see more details in the following section). - `vUniqueCols` - list of column parameters that should not contain duplicate values @@ -93,30 +96,31 @@ dfSUBJ: ## Data Mappings Metadata -Mapping Specifications in {gsm} define a "mapping" of column and field-level inputs needed for function. This mapping can be used in combination with a specification to confirm that input data meets the requirements for a function. +Mapping Specifications in {gsm} define a "mapping" of column and field-level inputs needed for a function. This mapping can be used in combination with a specification to confirm that input data meets the requirements for a function. + +Each mapping object lists the required parameters for all required data domains and specifies the column and field values for specific data sets. -Each mapping object lists the required parameters for all required data domains and specifies the column and field values for specific data sets. For example, the following could be passed to the `mapping` parameter for `AE_Map_Raw` for use with `clindata::rawplus_AE` and `clindata::rawplus_SUBJ`: +For example, the following could be passed to the `mapping` parameter for the `AE_Map_Raw()` function to be used with the default data from `clindata::rawplus_AE` and `clindata::rawplus_SUBJ`: ``` list( - dfAE=list(strIDCol= 'SubjectID'), - dfSUBJ= list( - strIDCol= 'SubjectID', - strSiteCol= 'SiteID', - strTimeOnTreatmentCol= 'TimeOnTreatment' + dfAE = list(strIDCol = 'SubjectID'), + dfSUBJ = list( + strIDCol = 'SubjectID', + strSiteCol = 'SiteID', + strTimeOnTreatmentCol = 'TimeOnTreatment' ) ) ``` -Note that `Study_Assess` is designed to share a `mapping` object across multiple assessments. The default mapping is saved as `clindata::mapping_rawplus`, but users can also create a custom mapping object for thier use cases. +Note that `Study_Assess()` is designed to share a `mapping` object across multiple assessments. The default mapping is saved as a `list` in {clindata} (`clindata::mapping_rawplus`), but users can also create a custom mapping object for thier use cases by making a custom YAML file, or by creating or modifying a list such as `clindata::mapping_rawplus`. ## Assessment Workflow Metadata -Assessment Workflow Metadata objects are passed to the `lAssessments` parameter in `Study_Assess` to define functions and parameters (including `mappings` and `specs`) across multiple studies. +Assessment Workflow Metadata objects are passed to the `lAssessments` parameter in `Study_Assess()` to define functions and parameters (including `mappings` and `specs`) across multiple studies. The `lAssessment` object is a named list of metadata defining how each assessment should be run. By default, `MakeAssessmentList()` imports YAML specifications from `inst/assessments`. Each item in `lAssessments` expects the following parameters. -- `label`: Label used to describe the assessmens. - `tags`: Labels to be appended as a column to summary data. - `workflow`: Array defining one or more functions to be executed as part of the workflow for a given assessment. - `workflow[]$name`: name of the {gsm} function. @@ -127,7 +131,6 @@ The `lAssessment` object is a named list of metadata defining how each assessmen For example, the assessment for the AE (`inst/assessments/ae.yaml`) is shown below: ``` -label: Treatment-Emergent Adverse Events tags: Assessment: Safety Label: AEs From b471d08d0bc0f65a653bb9fb20ba68d4952159ef Mon Sep 17 00:00:00 2001 From: Matt Roumaya <40671730+mattroumaya@users.noreply.github.com> Date: Thu, 9 Jun 2022 10:36:43 -0400 Subject: [PATCH 39/87] Update R/Analyze_Chisq.R Co-authored-by: Jeremy Wildfire --- R/Analyze_Chisq.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/Analyze_Chisq.R b/R/Analyze_Chisq.R index ef7bef2e7..c2eef2b73 100644 --- a/R/Analyze_Chisq.R +++ b/R/Analyze_Chisq.R @@ -27,7 +27,7 @@ #' #' @examples #' dfInput <- Disp_Map(dfDisp = safetyData::adam_adsl, strCol = "DCREASCD", strReason = "Adverse Event") -#' dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strKRILabel = "Discontinuation Reasons/Week") +#' dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strKRILabel = "Discontinuations due to AE/Month") #' dfAnalyzed <- Analyze_Chisq(dfTransformed) #' #' @import dplyr From bd9b51b5f9bc19cd3468af817ad26bbff9167960 Mon Sep 17 00:00:00 2001 From: Matt Roumaya <40671730+mattroumaya@users.noreply.github.com> Date: Thu, 9 Jun 2022 10:36:49 -0400 Subject: [PATCH 40/87] Update R/Analyze_Fisher.R Co-authored-by: Jeremy Wildfire --- R/Analyze_Fisher.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/Analyze_Fisher.R b/R/Analyze_Fisher.R index a8efabc41..d18b95905 100644 --- a/R/Analyze_Fisher.R +++ b/R/Analyze_Fisher.R @@ -26,7 +26,7 @@ #' #' @examples #' dfInput <- Disp_Map(dfDisp = safetyData::adam_adsl, strCol = "DCREASCD", strReason = "Adverse Event") -#' dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strKRILabel = "Discontinuation Reasons/Week") +#' dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strKRILabel = ""Discontinuations due to AE/Month"") #' dfAnalyzed <- Analyze_Fisher(dfTransformed) #' #' @import dplyr From bc961604dc85e193d3053823d57959322f75f487 Mon Sep 17 00:00:00 2001 From: Matt Roumaya <40671730+mattroumaya@users.noreply.github.com> Date: Thu, 9 Jun 2022 10:37:11 -0400 Subject: [PATCH 41/87] Update R/Analyze_Identity.R Co-authored-by: Jeremy Wildfire --- R/Analyze_Identity.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/Analyze_Identity.R b/R/Analyze_Identity.R index 896fea3d1..736891338 100644 --- a/R/Analyze_Identity.R +++ b/R/Analyze_Identity.R @@ -12,6 +12,6 @@ Analyze_Identity <- function(dfTransformed, strValueCol = 'KRI', strLabelCol = "KRIColumn"){ dfTransformed %>% - mutate(Score = .data$KRI, - ScoreLabel = strLabelCol) + mutate(Score = .data[strValueCol], + ScoreLabel = .data[strLabelCol]) } From 9a3a306c699f92c6b094b0e88a6cf45f35665ba8 Mon Sep 17 00:00:00 2001 From: Matt Roumaya <40671730+mattroumaya@users.noreply.github.com> Date: Thu, 9 Jun 2022 10:37:39 -0400 Subject: [PATCH 42/87] Update R/Analyze_Wilcoxon.R Co-authored-by: Jeremy Wildfire --- R/Analyze_Wilcoxon.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/Analyze_Wilcoxon.R b/R/Analyze_Wilcoxon.R index 35e8dd462..187c93338 100644 --- a/R/Analyze_Wilcoxon.R +++ b/R/Analyze_Wilcoxon.R @@ -128,7 +128,7 @@ Analyze_Wilcoxon <- function( dfAnalyzed %>% select(names(dfTransformed), .data$Estimate, Score = .data$PValue) %>% mutate( - ScoreLabel = "Residuals" + ScoreLabel = "P value" ) ) } From c23fabbbaf54db344a0af91e65b4f027248cd8e0 Mon Sep 17 00:00:00 2001 From: Matt Roumaya <40671730+mattroumaya@users.noreply.github.com> Date: Thu, 9 Jun 2022 10:37:47 -0400 Subject: [PATCH 43/87] Update R/Flag.R Co-authored-by: Jeremy Wildfire --- R/Flag.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/Flag.R b/R/Flag.R index 1529f545b..ee7e0285c 100644 --- a/R/Flag.R +++ b/R/Flag.R @@ -33,7 +33,7 @@ #' @examples #' dfInput <- AE_Map_Adam() #' dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strExposureCol = "Exposure", strKRILabel = "AEs/Week") -#' dfAnalyzed <- Analyze_Wilcoxon(dfTransformed, "KRI") +#' dfAnalyzed <- Analyze_Wilcoxon(dfTransformed) #' dfFlagged <- Flag(dfAnalyzed) # PValue < 0.05 flagged #' dfFlagged10 <- Flag(dfAnalyzed, vThreshold = c(0.10, NA)) # PValue <0.10 flagged #' # Flag direction set based on 'Statistic' column From d1a719ca1732b6a1e9ef5598c81d565e3bff050e Mon Sep 17 00:00:00 2001 From: Matt Roumaya <40671730+mattroumaya@users.noreply.github.com> Date: Thu, 9 Jun 2022 10:38:01 -0400 Subject: [PATCH 44/87] Update R/Flag.R Co-authored-by: Jeremy Wildfire --- R/Flag.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/Flag.R b/R/Flag.R index ee7e0285c..b4de85520 100644 --- a/R/Flag.R +++ b/R/Flag.R @@ -34,7 +34,7 @@ #' dfInput <- AE_Map_Adam() #' dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strExposureCol = "Exposure", strKRILabel = "AEs/Week") #' dfAnalyzed <- Analyze_Wilcoxon(dfTransformed) -#' dfFlagged <- Flag(dfAnalyzed) # PValue < 0.05 flagged +#' dfFlagged <- Flag(dfAnalyzed) # P value (dfAnalyzed$Score) < 0.05 flagged #' dfFlagged10 <- Flag(dfAnalyzed, vThreshold = c(0.10, NA)) # PValue <0.10 flagged #' # Flag direction set based on 'Statistic' column #' dfFlagged <- Flag(dfAnalyzed, strColumn = "Score", strValueColumn = "Estimate") From b7113e8f8de064da1760ee3c4e792b293fe42602 Mon Sep 17 00:00:00 2001 From: Matt Roumaya <40671730+mattroumaya@users.noreply.github.com> Date: Thu, 9 Jun 2022 10:38:35 -0400 Subject: [PATCH 45/87] Update R/IE_Assess.R Co-authored-by: Jeremy Wildfire --- R/IE_Assess.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/IE_Assess.R b/R/IE_Assess.R index 783831ebc..dc4eb2be5 100644 --- a/R/IE_Assess.R +++ b/R/IE_Assess.R @@ -14,7 +14,7 @@ #' @param dfInput `data.frame` Input data, a data frame with one record per subject. #' @param nThreshold `numeric` Threshold specification. Default: `0.5` #' @param lTags `list` Assessment tags, a named list of tags describing the assessment that defaults to `list(Assessment="IE")`. `lTags` is returned as part of the assessment (`lAssess$lTags`) and each tag is added as a column in `lAssess$dfSummary`. -#' @param strKRILabel `character` Describe the `KRI` column, a vector of length 1 that defaults to `Total Event Count` +#' @param strKRILabel `character` Describe the `KRI` column, a vector of length 1 that defaults to `# of Inclusion/Exclusion Issues` #' @param bChart `logical` Generate data visualization? Default: `TRUE` #' @param bReturnChecks `logical` Return input checks from `is_mapping_valid`? Default: `FALSE` #' @param bQuiet `logical` Suppress warning messages? Default: `TRUE` From 8591393393d7d73652c57a1cf9ab924860a4ad50 Mon Sep 17 00:00:00 2001 From: Matt Roumaya <40671730+mattroumaya@users.noreply.github.com> Date: Thu, 9 Jun 2022 10:39:11 -0400 Subject: [PATCH 46/87] Update R/IE_Assess.R Co-authored-by: Jeremy Wildfire --- R/IE_Assess.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/IE_Assess.R b/R/IE_Assess.R index dc4eb2be5..23ed86574 100644 --- a/R/IE_Assess.R +++ b/R/IE_Assess.R @@ -49,7 +49,7 @@ IE_Assess <- function( dfInput, nThreshold = 0.5, lTags = list(Assessment = "IE"), - strKRILabel = "Total Event Count", + strKRILabel = "# of Inclusion/Exclusion Issues", bChart = TRUE, bReturnChecks = FALSE, bQuiet = TRUE From b32100dd4ccd43966192f9b5bbd61bb00b5a6ce9 Mon Sep 17 00:00:00 2001 From: Matt Roumaya Date: Thu, 9 Jun 2022 16:39:10 +0000 Subject: [PATCH 47/87] [[]] in Analyze_Identity() --- R/Analyze_Identity.R | 7 ++++--- R/Consent_Assess.R | 3 ++- R/IE_Assess.R | 3 ++- tests/testthat/test-Analyze_Identity.R | 3 --- 4 files changed, 8 insertions(+), 8 deletions(-) delete mode 100644 tests/testthat/test-Analyze_Identity.R diff --git a/R/Analyze_Identity.R b/R/Analyze_Identity.R index 736891338..bf0813882 100644 --- a/R/Analyze_Identity.R +++ b/R/Analyze_Identity.R @@ -5,13 +5,14 @@ #' @param dfTransformed `data.frame` created by `Transform_EventCount()` #' @param strValueCol `character` Name of column that will be copied as `Score` #' @param strLabelCol `character` Name of column that will be copied as `ScoreLabel` +#' @param bQuiet `logical` Suppress warning messages? Default: `TRUE` #' #' @return `data.frame` that adds two columns to `dfTransformed`: `Score` and `ScoreLabel` #' #' @export -Analyze_Identity <- function(dfTransformed, strValueCol = 'KRI', strLabelCol = "KRIColumn"){ +Analyze_Identity <- function(dfTransformed, strValueCol = 'KRI', strLabelCol = "KRIColumn", bQuiet = TRUE){ dfTransformed %>% - mutate(Score = .data[strValueCol], - ScoreLabel = .data[strLabelCol]) + mutate(Score = .data[[strValueCol]], + ScoreLabel = .data[[strLabelCol]]) } diff --git a/R/Consent_Assess.R b/R/Consent_Assess.R index 446d26459..f1ce7b747 100644 --- a/R/Consent_Assess.R +++ b/R/Consent_Assess.R @@ -105,7 +105,8 @@ Consent_Assess <- function( lAssess$dfAnalyzed <- lAssess$dfTransformed %>% Analyze_Identity( strValueCol = "Total Count", - strLabelCol = "Total Number of Consent Issues" + strLabelCol = "Total Number of Consent Issues", + bQuiet = bQuiet ) if (!bQuiet) cli::cli_alert_info("No analysis function used. {.var dfTransformed} copied directly to {.var dfAnalyzed} with added {.var ScoreLabel} column.") diff --git a/R/IE_Assess.R b/R/IE_Assess.R index 23ed86574..86284805c 100644 --- a/R/IE_Assess.R +++ b/R/IE_Assess.R @@ -96,7 +96,8 @@ IE_Assess <- function( lAssess$dfAnalyzed <- lAssess$dfTransformed %>% Analyze_Identity( strValueCol = "Total Count", - strLabelCol = "Total Number of Inclusion/Exclusion Issues" + strLabelCol = "Total Number of Inclusion/Exclusion Issues", + bQuiet = bQuiet ) if (!bQuiet) cli::cli_alert_info("No analysis function used. {.var dfTransformed} copied directly to {.var dfAnalyzed} with added {.var ScoreLabel} column.") diff --git a/tests/testthat/test-Analyze_Identity.R b/tests/testthat/test-Analyze_Identity.R deleted file mode 100644 index 8849056e2..000000000 --- a/tests/testthat/test-Analyze_Identity.R +++ /dev/null @@ -1,3 +0,0 @@ -test_that("multiplication works", { - expect_equal(2 * 2, 4) -}) From 837d55c997f2cc32fb3c49f1350523d745e5fdd2 Mon Sep 17 00:00:00 2001 From: Li Ge Date: Thu, 9 Jun 2022 10:12:27 -0700 Subject: [PATCH 48/87] fix #515 - don't use `mutate_if()` --- R/util-parse_data_spec.R | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/R/util-parse_data_spec.R b/R/util-parse_data_spec.R index 11d9c54b2..c6159cce9 100644 --- a/R/util-parse_data_spec.R +++ b/R/util-parse_data_spec.R @@ -58,8 +58,11 @@ parse_data_spec <- function( # De-structure domain list as data frame. spec <- domain_list %>% - dplyr::bind_rows() %>% - dplyr::mutate_if(is.logical, ~ dplyr::coalesce(., FALSE)) + dplyr::bind_rows() + # Handle row binding produced NAs: + # will only affect v* logical columns + # (domain, col_key) are always complete + spec[is.na(spec)] <- FALSE spec } From 73337b1fcef4ce4bc6bfa12e19795124a5640885 Mon Sep 17 00:00:00 2001 From: Matt Roumaya Date: Thu, 9 Jun 2022 17:34:07 +0000 Subject: [PATCH 49/87] unit tests --- tests/testthat/test_Analyze_Identity.R | 6 ++++++ 1 file changed, 6 insertions(+) create mode 100644 tests/testthat/test_Analyze_Identity.R diff --git a/tests/testthat/test_Analyze_Identity.R b/tests/testthat/test_Analyze_Identity.R new file mode 100644 index 000000000..50414321f --- /dev/null +++ b/tests/testthat/test_Analyze_Identity.R @@ -0,0 +1,6 @@ +source(testthat::test_path("testdata/data.R")) + +dfInput <- Consent_Map_Raw(dfs = list(dfCONSENT = dfCONSENT, dfSUBJ = dfSUBJ)) +dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strKRILabel = "Test Label") + +Analyze_Identity(dfTransformed, strValueCol = "KRI", strLabelCol = "KRILabel") From c8f338d4e9319e082a0290d8a483ada4e0bf2d93 Mon Sep 17 00:00:00 2001 From: Matt Roumaya Date: Thu, 9 Jun 2022 18:21:01 +0000 Subject: [PATCH 50/87] update tests --- R/Analyze_Identity.R | 17 +++++++-- R/Consent_Assess.R | 6 +--- R/IE_Assess.R | 7 ++-- R/Transform_EventCount.R | 4 +-- tests/testthat/_snaps/Analyze_Identity.md | 15 ++++++++ tests/testthat/test_Analyze_Identity.R | 42 ++++++++++++++++++++++- 6 files changed, 76 insertions(+), 15 deletions(-) create mode 100644 tests/testthat/_snaps/Analyze_Identity.md diff --git a/R/Analyze_Identity.R b/R/Analyze_Identity.R index bf0813882..f26db31c9 100644 --- a/R/Analyze_Identity.R +++ b/R/Analyze_Identity.R @@ -11,8 +11,21 @@ #' #' @export -Analyze_Identity <- function(dfTransformed, strValueCol = 'KRI', strLabelCol = "KRIColumn", bQuiet = TRUE){ - dfTransformed %>% +Analyze_Identity <- function(dfTransformed, strValueCol = 'KRI', strLabelCol = "KRILabel", bQuiet = TRUE){ + + stopifnot( + "dfTransformed is not a data.frame" = is.data.frame(dfTransformed), + "strValueCol and/or strLabelCol not found in dfTransformed" = all(c(strValueCol, strLabelCol) %in% names(dfTransformed)), + "strValueCol must be length 1" = length(strValueCol) == 1, + "strLabelCol must be length 1" = length(strLabelCol) == 1 + ) + + dfAnalyzed <- dfTransformed %>% mutate(Score = .data[[strValueCol]], ScoreLabel = .data[[strLabelCol]]) + + if(!bQuiet) cli::cli_text(paste0("{.var Score} column created from `", strValueCol, "`.")) + if(!bQuiet) cli::cli_text(paste0("{.var ScoreLabel} column created from `", strLabelCol, "`.")) + + return(dfAnalyzed) } diff --git a/R/Consent_Assess.R b/R/Consent_Assess.R index f1ce7b747..8dc3a37d8 100644 --- a/R/Consent_Assess.R +++ b/R/Consent_Assess.R @@ -103,11 +103,7 @@ Consent_Assess <- function( if (!bQuiet) cli::cli_alert_success("{.fn Transform_EventCount} returned output with {nrow(lAssess$dfTransformed)} rows.") lAssess$dfAnalyzed <- lAssess$dfTransformed %>% - Analyze_Identity( - strValueCol = "Total Count", - strLabelCol = "Total Number of Consent Issues", - bQuiet = bQuiet - ) + Analyze_Identity(bQuiet = bQuiet) if (!bQuiet) cli::cli_alert_info("No analysis function used. {.var dfTransformed} copied directly to {.var dfAnalyzed} with added {.var ScoreLabel} column.") diff --git a/R/IE_Assess.R b/R/IE_Assess.R index 86284805c..c713e24d6 100644 --- a/R/IE_Assess.R +++ b/R/IE_Assess.R @@ -94,11 +94,8 @@ IE_Assess <- function( if (!bQuiet) cli::cli_alert_success("{.fn Transform_EventCount} returned output with {nrow(lAssess$dfTransformed)} rows.") lAssess$dfAnalyzed <- lAssess$dfTransformed %>% - Analyze_Identity( - strValueCol = "Total Count", - strLabelCol = "Total Number of Inclusion/Exclusion Issues", - bQuiet = bQuiet - ) + Analyze_Identity(bQuiet = bQuiet) + if (!bQuiet) cli::cli_alert_info("No analysis function used. {.var dfTransformed} copied directly to {.var dfAnalyzed} with added {.var ScoreLabel} column.") lAssess$dfFlagged <- gsm::Flag(lAssess$dfAnalyzed, vThreshold = c(NA, nThreshold)) diff --git a/R/Transform_EventCount.R b/R/Transform_EventCount.R index 374e551bc..593a38291 100644 --- a/R/Transform_EventCount.R +++ b/R/Transform_EventCount.R @@ -33,13 +33,13 @@ #' #' @examples #' dfInput <- AE_Map_Adam() -#' dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strExposureCol = "Exposure", strKRILabel = "AEs/Week") +#' dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strExposureCol = "Exposure") #' #' @import dplyr #' #' @export -Transform_EventCount <- function(dfInput, strCountCol, strExposureCol = NULL, strKRILabel) { +Transform_EventCount <- function(dfInput, strCountCol, strExposureCol = NULL, strKRILabel = "[Not Specified]") { stopifnot( "dfInput is not a data frame" = is.data.frame(dfInput), "strCountCol not found in input data" = strCountCol %in% names(dfInput), diff --git a/tests/testthat/_snaps/Analyze_Identity.md b/tests/testthat/_snaps/Analyze_Identity.md new file mode 100644 index 000000000..3ef1e08d3 --- /dev/null +++ b/tests/testthat/_snaps/Analyze_Identity.md @@ -0,0 +1,15 @@ +# bQuiet works as intended + + Code + Analyze_Identity(dfTransformed, bQuiet = FALSE) + Message + `Score` column created from `KRI`. + `ScoreLabel` column created from `KRILabel`. + Output + # A tibble: 3 x 7 + SiteID N TotalCount KRI KRILabel Score ScoreLabel + + 1 X010X 1 1 1 Test Label 1 Test Label + 2 X102X 1 1 1 Test Label 1 Test Label + 3 X999X 1 1 1 Test Label 1 Test Label + diff --git a/tests/testthat/test_Analyze_Identity.R b/tests/testthat/test_Analyze_Identity.R index 50414321f..938055250 100644 --- a/tests/testthat/test_Analyze_Identity.R +++ b/tests/testthat/test_Analyze_Identity.R @@ -2,5 +2,45 @@ source(testthat::test_path("testdata/data.R")) dfInput <- Consent_Map_Raw(dfs = list(dfCONSENT = dfCONSENT, dfSUBJ = dfSUBJ)) dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strKRILabel = "Test Label") +dfAnalyzed <- Analyze_Identity(dfTransformed) -Analyze_Identity(dfTransformed, strValueCol = "KRI", strLabelCol = "KRILabel") +test_that("output created as expected and has correct structure", { + expect_true(is.data.frame(dfAnalyzed)) + expect_equal(names(dfAnalyzed), c("SiteID", "N", "TotalCount", "KRI", "KRILabel", "Score", "ScoreLabel")) + expect_equal(dfAnalyzed$KRI, dfAnalyzed$Score) + expect_equal(dfAnalyzed$KRILabel, dfAnalyzed$ScoreLabel) +}) + +test_that("incorrect inputs throw errors", { + expect_error(Analyze_Identity(list())) + expect_error(Analyze_Identity("Hi")) +}) + +test_that("error given if required column not found", { + expect_error(Analyze_Identity(dfAnalyzed %>% rename("x" = KRI))) + expect_error(Analyze_Identity(dfAnalyzed %>% rename("x" = KRILabel))) +}) + +test_that("strValueCol works as intended", { + dfTransformed <- dfTransformed %>% + rename(customKRI = KRI) + + dfAnalyzed <- Analyze_Identity(dfTransformed, strValueCol = "customKRI") + + expect_silent(Analyze_Identity(dfTransformed, strValueCol = "customKRI")) + expect_equal(names(dfAnalyzed), c("SiteID", "N", "TotalCount", "customKRI", "KRILabel", "Score", "ScoreLabel")) +}) + +test_that("strLabelCol works as intended", { + dfTransformed <- dfTransformed %>% + rename(customKRILabel = KRILabel) + + dfAnalyzed <- Analyze_Identity(dfTransformed, strLabelCol = "customKRILabel") + + expect_silent(Analyze_Identity(dfTransformed, strLabelCol = "customKRILabel")) + expect_equal(names(dfAnalyzed), c("SiteID", "N", "TotalCount", "KRI", "customKRILabel", "Score", "ScoreLabel")) +}) + +test_that("bQuiet works as intended", { + expect_snapshot(Analyze_Identity(dfTransformed, bQuiet = FALSE)) +}) From ec925326be05d72736bf764f4a1d842f05c94448 Mon Sep 17 00:00:00 2001 From: Spencer Childress Date: Thu, 9 Jun 2022 14:44:39 -0400 Subject: [PATCH 51/87] fix #521 --- R/AE_Map_Adam.R | 11 ++----- R/Study_AssessmentReport.R | 16 +++++----- R/util-CheckInputs.R | 3 +- R/util-FilterDomain.R | 10 ++++++- R/util-RunStep.R | 5 +++- inst/assessments/ae.yaml | 12 ++++++++ inst/assessments/consent.yaml | 12 +++++++- inst/assessments/ie.yaml | 11 +++++++ inst/assessments/importantpd.yaml | 14 +++++++++ inst/assessments/pd.yaml | 12 ++++++++ inst/assessments/sae.yaml | 14 +++++++++ inst/mappings/AE_Map_Adam.yaml | 20 +++++++++++++ inst/mappings/AE_Map_Raw.yaml | 18 +++++++++++ inst/mappings/Consent_Map_Raw.yaml | 18 +++++++++++ inst/mappings/IE_Map_Raw.yaml | 22 ++++++++++++++ inst/mappings/PD_Map_Raw.yaml | 16 ++++++++++ inst/mappings/mapping_rawplus.yaml | 41 ++++++++++++++++++++++++++ tests/testthat/test_Study_Assess.R | 2 +- tests/testthat/test_util_CheckInputs.R | 4 +-- 19 files changed, 238 insertions(+), 23 deletions(-) create mode 100644 inst/mappings/AE_Map_Adam.yaml create mode 100644 inst/mappings/AE_Map_Raw.yaml create mode 100644 inst/mappings/Consent_Map_Raw.yaml create mode 100644 inst/mappings/IE_Map_Raw.yaml create mode 100644 inst/mappings/PD_Map_Raw.yaml create mode 100644 inst/mappings/mapping_rawplus.yaml diff --git a/R/AE_Map_Adam.R b/R/AE_Map_Adam.R index 05b50b302..7f123b49d 100644 --- a/R/AE_Map_Adam.R +++ b/R/AE_Map_Adam.R @@ -46,14 +46,6 @@ AE_Map_Adam <- function( bReturnChecks = FALSE, bQuiet = TRUE ) { - # TODO: Use predefined mapping, which does not currently exist in {clindata}. - if (is.null(lMapping)) { - lMapping <- list( - dfADSL = list(strIDCol = "USUBJID", strSiteCol = "SITEID", strStartCol = "TRTSDT", strEndCol = "TRTEDT"), - dfADAE = list(strIDCol = "USUBJID") - ) - } - checks <- gsm::CheckInputs( context = "AE_Map_Adam", dfs = dfs, @@ -61,6 +53,9 @@ AE_Map_Adam <- function( mapping = lMapping ) + if (is.null(lMapping)) + lMapping <- checks$mapping + # Run mapping if checks passed. if (checks$status) { if (!bQuiet) cli::cli_h2("Initializing {.fn AE_Map_Adam}") diff --git a/R/Study_AssessmentReport.R b/R/Study_AssessmentReport.R index a5032a023..ab2650df5 100644 --- a/R/Study_AssessmentReport.R +++ b/R/Study_AssessmentReport.R @@ -24,17 +24,19 @@ Study_AssessmentReport <- function(lAssessments, bViewReport = FALSE) { allChecks <- map(names(lAssessments), function(assessment) { - workflow <- map_df(lAssessments[[assessment]][['workflow']], ~ bind_cols(step = .x[['name']], domain = .x[['inputs']])) %>% - mutate( - assessment = assessment, - index = as.character(row_number()) + workflow <- lAssessments[[assessment]][['workflow']] %>% + map_df( + ~bind_cols(step = .x[['name']], domain = .x[['inputs']]) + ) %>% + mutate( + assessment = assessment, + index = as.character(row_number()) ) allChecks <- map(lAssessments[[assessment]][['checks']], function(step) { - domains <- names(step[names(step) != 'status']) + domains <- names(step[!names(step) %in% c('status', 'mapping')]) - map(domains, function(test) { - domain <- test + map(domains, function(domain) { status <- step[[domain]][['status']] step[[domain]][['tests_if']] %>% bind_rows(.id = "names") %>% diff --git a/R/util-CheckInputs.R b/R/util-CheckInputs.R index 4a0f1bc47..2df64310c 100644 --- a/R/util-CheckInputs.R +++ b/R/util-CheckInputs.R @@ -49,9 +49,8 @@ CheckInputs <- function(context, dfs, mapping = NULL, bQuiet = TRUE) { }) %>% purrr::set_names(nm = names(spec)) - - checks$status <- all(checks %>% purrr::map_lgl(~ .x$status)) + checks$mapping <- mapping if (checks$status) { if (!bQuiet) cli::cli_alert_success("No issues found for {.fn {context}}") diff --git a/R/util-FilterDomain.R b/R/util-FilterDomain.R index d831a5e5e..02c3dd276 100644 --- a/R/util-FilterDomain.R +++ b/R/util-FilterDomain.R @@ -30,7 +30,15 @@ #' #' @export -FilterDomain <- function(df, strDomain, lMapping, strColParam, strValParam, bReturnChecks = FALSE, bQuiet = TRUE) { +FilterDomain <- function( + df, + strDomain, + lMapping, + strColParam, + strValParam, + bReturnChecks = FALSE, + bQuiet = TRUE +) { if (!bQuiet) cli::cli_h2("Checking Input Data for {.fn FilterDomain}") lSpec <- list(vRequired = c(strColParam, strValParam)) check <- gsm::is_mapping_valid(df = df, mapping = lMapping[[strDomain]], spec = lSpec, bQuiet = bQuiet) diff --git a/R/util-RunStep.R b/R/util-RunStep.R index cdab91a08..335719425 100644 --- a/R/util-RunStep.R +++ b/R/util-RunStep.R @@ -39,7 +39,10 @@ RunStep <- function(lStep, lMapping, lData, lTags, bQuiet) { # prepare parameter list inputs cli::cli_text("Preparing parameters for {.fn {lStep$name}} ...") - params <- c(lStep$params, list(bQuiet = bQuiet, bReturnChecks = TRUE)) + + params <- lStep$params + params$bQuiet <- bQuiet + params$bReturnChecks <- TRUE # prepare data inputs by function type if (stringr::str_detect(lStep$name, "_Map")) { diff --git a/inst/assessments/ae.yaml b/inst/assessments/ae.yaml index 94ea7208c..b4eab79f9 100644 --- a/inst/assessments/ae.yaml +++ b/inst/assessments/ae.yaml @@ -10,13 +10,25 @@ workflow: strDomain: dfAE strColParam: strTreatmentEmergentCol strValParam: strTreatmentEmergentVal + bReturnChecks: false + bQuiet: true - name: AE_Map_Raw inputs: - dfAE - dfSUBJ output: dfInput + params: + lMapping: null + bReturnChecks: false + bQuiet: true - name: AE_Assess inputs: dfInput output: lResults params: + vThreshold: null strMethod: "poisson" + lTags: + Assessment: "AE" + bChart: true + bReturnChecks: false + bQuiet: true diff --git a/inst/assessments/consent.yaml b/inst/assessments/consent.yaml index 4f5efaec9..dc6153bf8 100644 --- a/inst/assessments/consent.yaml +++ b/inst/assessments/consent.yaml @@ -8,7 +8,17 @@ workflow: - dfCONSENT - dfSUBJ output: dfInput + params: + lMapping: null + bReturnChecks: false + bQuiet: true - name: Consent_Assess inputs: dfInput output: lResults - + params: + nThreshold: 0.5 + lTags: + Assessment: "Consent" + bChart: true + bReturnChecks: false + bQuiet: true diff --git a/inst/assessments/ie.yaml b/inst/assessments/ie.yaml index c31d514ce..ca3290606 100644 --- a/inst/assessments/ie.yaml +++ b/inst/assessments/ie.yaml @@ -8,6 +8,17 @@ workflow: - dfIE - dfSUBJ output: dfInput + params: + lMapping: null + bReturnChecks: false + bQuiet: true - name: IE_Assess inputs: dfInput output: lResults + params: + nThreshold: 0.5 + lTags: + Assessment: "IE" + bChart: true + bReturnChecks: false + bQuiet: true diff --git a/inst/assessments/importantpd.yaml b/inst/assessments/importantpd.yaml index d0def3024..bdd464461 100644 --- a/inst/assessments/importantpd.yaml +++ b/inst/assessments/importantpd.yaml @@ -10,11 +10,25 @@ workflow: strDomain: dfPD strColParam: strImportantCol strValParam: strImportantVal + bReturnChecks: false + bQuiet: true - name: PD_Map_Raw inputs: - dfPD - dfSUBJ output: dfInput + params: + lMapping: null + bReturnChecks: false + bQuiet: true - name: PD_Assess inputs: dfInput output: lResults + params: + vThreshold: null + strMethod: "poisson" + lTags: + Assessment: "PD" + bChart: true + bReturnChecks: false + bQuiet: true diff --git a/inst/assessments/pd.yaml b/inst/assessments/pd.yaml index ae6a43a6f..725fe833e 100644 --- a/inst/assessments/pd.yaml +++ b/inst/assessments/pd.yaml @@ -8,6 +8,18 @@ workflow: - dfPD - dfSUBJ output: dfInput + params: + lMapping: null + bReturnChecks: false + bQuiet: true - name: PD_Assess inputs: dfInput output: lResults + params: + vThreshold: null + strMethod: "poisson" + lTags: + Assessment: "PD" + bChart: true + bReturnChecks: false + bQuiet: true diff --git a/inst/assessments/sae.yaml b/inst/assessments/sae.yaml index 7f2d59f36..3708e63eb 100644 --- a/inst/assessments/sae.yaml +++ b/inst/assessments/sae.yaml @@ -10,6 +10,8 @@ workflow: strDomain: dfAE strColParam: strTreatmentEmergentCol strValParam: strTreatmentEmergentVal + bReturnChecks: false + bQuiet: true - name: FilterDomain inputs: dfAE output: dfAE @@ -17,13 +19,25 @@ workflow: strDomain: dfAE strColParam: strSeriousCol strValParam: strSeriousVal + bReturnChecks: false + bQuiet: true - name: AE_Map_Raw inputs: - dfAE - dfSUBJ output: dfInput + params: + lMapping: null + bReturnChecks: false + bQuiet: true - name: AE_Assess inputs: dfInput output: lResults params: + vThreshold: null strMethod: "poisson" + lTags: + Assessment: "AE" + bChart: true + bReturnChecks: false + bQuiet: true diff --git a/inst/mappings/AE_Map_Adam.yaml b/inst/mappings/AE_Map_Adam.yaml new file mode 100644 index 000000000..984251bdc --- /dev/null +++ b/inst/mappings/AE_Map_Adam.yaml @@ -0,0 +1,20 @@ +dfADSL: + strIDCol: "USUBJID" + strSiteCol: "SITEID" + strStartCol: "TRTSDT" + strEndCol: "TRTEDT" + strTimeOnTreatmentCol: "TDUR" + strTimeOnStudyCol: "SDUR" + strRandFlagCol: "RANDFL" + strRandDateCol: "RANDDT" + strStudyCompletionFlagCol: "COMPLSFL" + strStudyDiscontinuationReasonCol: "DCSREAS" + strTreatmentCompletionFlagCol: "COMPLTFL" + strTreatmentDiscontinuationReasonCol: "DCTREAS" +dfADAE: + strIDCol: "USUBJID" + strTreatmentEmergentCol: "TRTEMFL" + strTreatmentEmergentVal: "Y" + strGradeCol: "AETOXGR" + strSeriousCol: "AESER" + strSeriousVal: "Yes" diff --git a/inst/mappings/AE_Map_Raw.yaml b/inst/mappings/AE_Map_Raw.yaml new file mode 100644 index 000000000..62e225b28 --- /dev/null +++ b/inst/mappings/AE_Map_Raw.yaml @@ -0,0 +1,18 @@ +dfSUBJ: + strIDCol: "SubjectID" + strSiteCol: "SiteID" + strTimeOnTreatmentCol: "TimeOnTreatment" + strTimeOnStudyCol: "TimeOnStudy" + strRandFlagCol: "RandFlag" + strRandDateCol: "RandDate" + strStudyCompletionFlagCol: "StudCompletion" + strStudyDiscontinuationReasonCol: "StudDCReason" + strTreatmentCompletionFlagCol: "TrtCompletion" + strTreatmentDiscontinuationReasonCol: "TrtDCReason" +dfAE: + strIDCol: "SubjectID" + strTreatmentEmergentCol: "AE_TE_FLAG" + strTreatmentEmergentVal: TRUE + strGradeCol: "AE_GRADE" + strSeriousCol: "AE_SERIOUS" + strSeriousVal: "Yes" diff --git a/inst/mappings/Consent_Map_Raw.yaml b/inst/mappings/Consent_Map_Raw.yaml new file mode 100644 index 000000000..feb1b087a --- /dev/null +++ b/inst/mappings/Consent_Map_Raw.yaml @@ -0,0 +1,18 @@ +dfSUBJ: + strIDCol: "SubjectID" + strSiteCol: "SiteID" + strTimeOnTreatmentCol: "TimeOnTreatment" + strTimeOnStudyCol: "TimeOnStudy" + strRandFlagCol: "RandFlag" + strRandDateCol: "RandDate" + strStudyCompletionFlagCol: "StudCompletion" + strStudyDiscontinuationReasonCol: "StudDCReason" + strTreatmentCompletionFlagCol: "TrtCompletion" + strTreatmentDiscontinuationReasonCol: "TrtDCReason" +dfCONSENT: + strIDCol: "SubjectID" + strTypeCol: "CONSENT_TYPE" + strValueCol: "CONSENT_VALUE" + strDateCol: "CONSENT_DATE" + strConsentTypeValue: "MAINCONSENT" + strConsentStatusValue: "Y" diff --git a/inst/mappings/IE_Map_Raw.yaml b/inst/mappings/IE_Map_Raw.yaml new file mode 100644 index 000000000..27abcdf16 --- /dev/null +++ b/inst/mappings/IE_Map_Raw.yaml @@ -0,0 +1,22 @@ +dfSUBJ: + strIDCol: "SubjectID" + strSiteCol: "SiteID" + strTimeOnTreatmentCol: "TimeOnTreatment" + strTimeOnStudyCol: "TimeOnStudy" + strRandFlagCol: "RandFlag" + strRandDateCol: "RandDate" + strStudyCompletionFlagCol: "StudCompletion" + strStudyDiscontinuationReasonCol: "StudDCReason" + strTreatmentCompletionFlagCol: "TrtCompletion" + strTreatmentDiscontinuationReasonCol: "TrtDCReason" +dfIE: + strIDCol: "SubjectID" + strCategoryCol: "IE_CATEGORY" + strValueCol: "IE_VALUE" + strVersionCol: "IE_PROTOCOLVERSION" + vCategoryValues: + - "EXCL" + - "INCL" + vExpectedResultValues: + - 0 + - 1 diff --git a/inst/mappings/PD_Map_Raw.yaml b/inst/mappings/PD_Map_Raw.yaml new file mode 100644 index 000000000..191570c19 --- /dev/null +++ b/inst/mappings/PD_Map_Raw.yaml @@ -0,0 +1,16 @@ +dfSUBJ: + strIDCol: "SubjectID" + strSiteCol: "SiteID" + strTimeOnTreatmentCol: "TimeOnTreatment" + strTimeOnStudyCol: "TimeOnStudy" + strRandFlagCol: "RandFlag" + strRandDateCol: "RandDate" + strStudyCompletionFlagCol: "StudCompletion" + strStudyDiscontinuationReasonCol: "StudDCReason" + strTreatmentCompletionFlagCol: "TrtCompletion" + strTreatmentDiscontinuationReasonCol: "TrtDCReason" +dfPD: + strIDCol: "SubjectID" + strCategoryCol: "PD_CATEGORY" + strImportantCol: "PD_IMPORTANT_FLAG" + strImportantVal: "Y" diff --git a/inst/mappings/mapping_rawplus.yaml b/inst/mappings/mapping_rawplus.yaml new file mode 100644 index 000000000..0c3cf35b0 --- /dev/null +++ b/inst/mappings/mapping_rawplus.yaml @@ -0,0 +1,41 @@ +dfSUBJ: + strIDCol: "SubjectID" + strSiteCol: "SiteID" + strTimeOnTreatmentCol: "TimeOnTreatment" + strTimeOnStudyCol: "TimeOnStudy" + strRandFlagCol: "RandFlag" + strRandDateCol: "RandDate" + strStudyCompletionFlagCol: "StudCompletion" + strStudyDiscontinuationReasonCol: "StudDCReason" + strTreatmentCompletionFlagCol: "TrtCompletion" + strTreatmentDiscontinuationReasonCol: "TrtDCReason" +dfAE: + strIDCol: "SubjectID" + strTreatmentEmergentCol: "AE_TE_FLAG" + strTreatmentEmergentVal: TRUE + strGradeCol: "AE_GRADE" + strSeriousCol: "AE_SERIOUS" + strSeriousVal: "Yes" +dfPD: + strIDCol: "SubjectID" + strCategoryCol: "PD_CATEGORY" + strImportantCol: "PD_IMPORTANT_FLAG" + strImportantVal: "Y" +dfIE: + strIDCol: "SubjectID" + strCategoryCol: "IE_CATEGORY" + strValueCol: "IE_VALUE" + strVersionCol: "IE_PROTOCOLVERSION" + vCategoryValues: + - "EXCL" + - "INCL" + vExpectedResultValues: + - 0 + - 1 +dfCONSENT: + strIDCol: "SubjectID" + strTypeCol: "CONSENT_TYPE" + strValueCol: "CONSENT_VALUE" + strDateCol: "CONSENT_DATE" + strConsentTypeValue: "MAINCONSENT" + strConsentStatusValue: "Y" diff --git a/tests/testthat/test_Study_Assess.R b/tests/testthat/test_Study_Assess.R index 2b747c8fc..9ab30a2af 100644 --- a/tests/testthat/test_Study_Assess.R +++ b/tests/testthat/test_Study_Assess.R @@ -32,7 +32,7 @@ test_that("metadata is returned as expected", { name = "FilterDomain", inputs = "dfAE", output = "dfAE", params = list( strDomain = "dfAE", strColParam = "strTreatmentEmergentCol", - strValParam = "strTreatmentEmergentVal" + strValParam = "strTreatmentEmergentVal", bReturnChecks = FALSE, bQuiet = TRUE ) )) expect_equal(ae$name, "ae") diff --git a/tests/testthat/test_util_CheckInputs.R b/tests/testthat/test_util_CheckInputs.R index 8ee9f842f..dfc50af41 100644 --- a/tests/testthat/test_util_CheckInputs.R +++ b/tests/testthat/test_util_CheckInputs.R @@ -14,7 +14,7 @@ test_that("output is created as expected", { expect_true(checks$status) expect_true(checks$dfInput$status) - expect_equal(names(checks), c("dfInput", "status")) + expect_equal(names(checks), c("dfInput", "status", "mapping")) expect_type(checks$dfInput, "list") expect_type(checks$status, "logical") expect_true(all(map_lgl(checks$dfInput$tests_if, pluck("status")))) @@ -38,7 +38,7 @@ test_that("output is created as expected", { expect_true(checks$status) expect_true(checks$dfIE$status) expect_true(checks$dfSUBJ$status) - expect_equal(names(checks), c("dfIE", "dfSUBJ", "status")) + expect_equal(names(checks), c("dfIE", "dfSUBJ", "status", "mapping")) expect_type(checks$dfIE, "list") expect_type(checks$dfSUBJ, "list") expect_type(checks$status, "logical") From c19dd96967802b074d5e49ac502cce1c63cbadc6 Mon Sep 17 00:00:00 2001 From: Spencer Childress Date: Thu, 9 Jun 2022 15:26:55 -0400 Subject: [PATCH 52/87] remove non-assessment-related parameters from workflow YAML files --- inst/assessments/ae.yaml | 11 ----------- inst/assessments/consent.yaml | 9 --------- inst/assessments/ie.yaml | 9 --------- inst/assessments/importantpd.yaml | 11 ----------- inst/assessments/pd.yaml | 9 --------- inst/assessments/sae.yaml | 13 ------------- tests/testthat/test_Study_Assess.R | 2 +- 7 files changed, 1 insertion(+), 63 deletions(-) diff --git a/inst/assessments/ae.yaml b/inst/assessments/ae.yaml index b4eab79f9..8b5570bc9 100644 --- a/inst/assessments/ae.yaml +++ b/inst/assessments/ae.yaml @@ -10,25 +10,14 @@ workflow: strDomain: dfAE strColParam: strTreatmentEmergentCol strValParam: strTreatmentEmergentVal - bReturnChecks: false - bQuiet: true - name: AE_Map_Raw inputs: - dfAE - dfSUBJ output: dfInput - params: - lMapping: null - bReturnChecks: false - bQuiet: true - name: AE_Assess inputs: dfInput output: lResults params: vThreshold: null strMethod: "poisson" - lTags: - Assessment: "AE" - bChart: true - bReturnChecks: false - bQuiet: true diff --git a/inst/assessments/consent.yaml b/inst/assessments/consent.yaml index dc6153bf8..1bd1069ba 100644 --- a/inst/assessments/consent.yaml +++ b/inst/assessments/consent.yaml @@ -8,17 +8,8 @@ workflow: - dfCONSENT - dfSUBJ output: dfInput - params: - lMapping: null - bReturnChecks: false - bQuiet: true - name: Consent_Assess inputs: dfInput output: lResults params: nThreshold: 0.5 - lTags: - Assessment: "Consent" - bChart: true - bReturnChecks: false - bQuiet: true diff --git a/inst/assessments/ie.yaml b/inst/assessments/ie.yaml index ca3290606..306eeaca5 100644 --- a/inst/assessments/ie.yaml +++ b/inst/assessments/ie.yaml @@ -8,17 +8,8 @@ workflow: - dfIE - dfSUBJ output: dfInput - params: - lMapping: null - bReturnChecks: false - bQuiet: true - name: IE_Assess inputs: dfInput output: lResults params: nThreshold: 0.5 - lTags: - Assessment: "IE" - bChart: true - bReturnChecks: false - bQuiet: true diff --git a/inst/assessments/importantpd.yaml b/inst/assessments/importantpd.yaml index bdd464461..e68310696 100644 --- a/inst/assessments/importantpd.yaml +++ b/inst/assessments/importantpd.yaml @@ -10,25 +10,14 @@ workflow: strDomain: dfPD strColParam: strImportantCol strValParam: strImportantVal - bReturnChecks: false - bQuiet: true - name: PD_Map_Raw inputs: - dfPD - dfSUBJ output: dfInput - params: - lMapping: null - bReturnChecks: false - bQuiet: true - name: PD_Assess inputs: dfInput output: lResults params: vThreshold: null strMethod: "poisson" - lTags: - Assessment: "PD" - bChart: true - bReturnChecks: false - bQuiet: true diff --git a/inst/assessments/pd.yaml b/inst/assessments/pd.yaml index 725fe833e..2fa415dcc 100644 --- a/inst/assessments/pd.yaml +++ b/inst/assessments/pd.yaml @@ -8,18 +8,9 @@ workflow: - dfPD - dfSUBJ output: dfInput - params: - lMapping: null - bReturnChecks: false - bQuiet: true - name: PD_Assess inputs: dfInput output: lResults params: vThreshold: null strMethod: "poisson" - lTags: - Assessment: "PD" - bChart: true - bReturnChecks: false - bQuiet: true diff --git a/inst/assessments/sae.yaml b/inst/assessments/sae.yaml index 3708e63eb..f270823da 100644 --- a/inst/assessments/sae.yaml +++ b/inst/assessments/sae.yaml @@ -10,8 +10,6 @@ workflow: strDomain: dfAE strColParam: strTreatmentEmergentCol strValParam: strTreatmentEmergentVal - bReturnChecks: false - bQuiet: true - name: FilterDomain inputs: dfAE output: dfAE @@ -19,25 +17,14 @@ workflow: strDomain: dfAE strColParam: strSeriousCol strValParam: strSeriousVal - bReturnChecks: false - bQuiet: true - name: AE_Map_Raw inputs: - dfAE - dfSUBJ output: dfInput - params: - lMapping: null - bReturnChecks: false - bQuiet: true - name: AE_Assess inputs: dfInput output: lResults params: vThreshold: null strMethod: "poisson" - lTags: - Assessment: "AE" - bChart: true - bReturnChecks: false - bQuiet: true diff --git a/tests/testthat/test_Study_Assess.R b/tests/testthat/test_Study_Assess.R index 9ab30a2af..2b747c8fc 100644 --- a/tests/testthat/test_Study_Assess.R +++ b/tests/testthat/test_Study_Assess.R @@ -32,7 +32,7 @@ test_that("metadata is returned as expected", { name = "FilterDomain", inputs = "dfAE", output = "dfAE", params = list( strDomain = "dfAE", strColParam = "strTreatmentEmergentCol", - strValParam = "strTreatmentEmergentVal", bReturnChecks = FALSE, bQuiet = TRUE + strValParam = "strTreatmentEmergentVal" ) )) expect_equal(ae$name, "ae") From e25741c3ad910dda741a36e4764d891eaaae6889 Mon Sep 17 00:00:00 2001 From: Matt Roumaya Date: Thu, 9 Jun 2022 21:17:54 +0000 Subject: [PATCH 53/87] update unit tests and documentation --- R/Analyze_Poisson.R | 3 ++- R/Analyze_Wilcoxon.R | 4 +++- man/Analyze_Chisq.Rd | 2 +- man/Analyze_Fisher.Rd | 2 +- man/Analyze_Identity.Rd | 9 ++++++++- man/Flag.Rd | 4 ++-- man/IE_Assess.Rd | 4 ++-- man/Transform_EventCount.Rd | 9 +++++++-- tests/testthat/_snaps/Study_Assess.md | 4 ++++ tests/testthat/test_AE_Assess.R | 8 ++++++++ tests/testthat/test_Analyze_Poisson.R | 3 ++- tests/testthat/test_Analyze_Wilcoxon.R | 19 +++++++++---------- tests/testthat/test_Consent_Assess.R | 1 + tests/testthat/test_Flag.R | 23 +++++++++++++---------- tests/testthat/test_IE_Assess.R | 3 ++- tests/testthat/test_PD_Assess.R | 6 ++++++ 16 files changed, 71 insertions(+), 33 deletions(-) diff --git a/R/Analyze_Poisson.R b/R/Analyze_Poisson.R index cf39b0996..c4845a20f 100644 --- a/R/Analyze_Poisson.R +++ b/R/Analyze_Poisson.R @@ -38,7 +38,8 @@ Analyze_Poisson <- function(dfTransformed, bQuiet = TRUE) { stopifnot( "dfTransformed is not a data.frame" = is.data.frame(dfTransformed), - "One or more of these columns not found: SiteID, N, TotalExposure, TotalCount, KRI" = all(c("SiteID", "N", "TotalExposure", "TotalCount", "KRI") %in% names(dfTransformed)), + "One or more of these columns not found: SiteID, N, TotalExposure, TotalCount, KRI, KRILabel" = + all(c("SiteID", "N", "TotalExposure", "TotalCount", "KRI", "KRILabel") %in% names(dfTransformed)), "NA value(s) found in SiteID" = all(!is.na(dfTransformed[["SiteID"]])) ) diff --git a/R/Analyze_Wilcoxon.R b/R/Analyze_Wilcoxon.R index 187c93338..5c59c6251 100644 --- a/R/Analyze_Wilcoxon.R +++ b/R/Analyze_Wilcoxon.R @@ -62,7 +62,9 @@ Analyze_Wilcoxon <- function( "@param:strOutcomeCol or @param:strPredictorCol not found in @param:dfTransformed" = all(c(strPredictorCol, strOutcomeCol) %in% names(dfTransformed)), "NA value(s) found in @param:strPredictorCol" = - all(!is.na(dfTransformed[[strPredictorCol]])) + all(!is.na(dfTransformed[[strPredictorCol]])), + "One or more of these columns not found: SiteID, N, TotalExposure, TotalCount, KRI, KRILabel" = + all(c("SiteID", "N", "TotalExposure", "TotalCount", "KRI", "KRILabel") %in% names(dfTransformed)) ) wilcoxon_model <- function(predictorValue) { diff --git a/man/Analyze_Chisq.Rd b/man/Analyze_Chisq.Rd index 5ed27feec..814e01ea0 100644 --- a/man/Analyze_Chisq.Rd +++ b/man/Analyze_Chisq.Rd @@ -41,7 +41,7 @@ The input data (\code{dfTransformed}) for Analyze_Chisq is typically created usi \examples{ dfInput <- Disp_Map(dfDisp = safetyData::adam_adsl, strCol = "DCREASCD", strReason = "Adverse Event") -dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strKRILabel = "Discontinuation Reasons/Week") +dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strKRILabel = "Discontinuations due to AE/Month") dfAnalyzed <- Analyze_Chisq(dfTransformed) } diff --git a/man/Analyze_Fisher.Rd b/man/Analyze_Fisher.Rd index 0a5dde487..bfc669b7d 100644 --- a/man/Analyze_Fisher.Rd +++ b/man/Analyze_Fisher.Rd @@ -41,7 +41,7 @@ The input data (\code{dfTransformed}) for Analyze_Fisher is typically created us \examples{ dfInput <- Disp_Map(dfDisp = safetyData::adam_adsl, strCol = "DCREASCD", strReason = "Adverse Event") -dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strKRILabel = "Discontinuation Reasons/Week") +dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strKRILabel = ""Discontinuations due to AE/Month"") dfAnalyzed <- Analyze_Fisher(dfTransformed) } diff --git a/man/Analyze_Identity.Rd b/man/Analyze_Identity.Rd index 8a7590a1b..be5792761 100644 --- a/man/Analyze_Identity.Rd +++ b/man/Analyze_Identity.Rd @@ -4,7 +4,12 @@ \alias{Analyze_Identity} \title{Analyze Identity} \usage{ -Analyze_Identity(dfTransformed, strValueCol = "KRI", strLabelCol = "KRIColumn") +Analyze_Identity( + dfTransformed, + strValueCol = "KRI", + strLabelCol = "KRILabel", + bQuiet = TRUE +) } \arguments{ \item{dfTransformed}{\code{data.frame} created by \code{Transform_EventCount()}} @@ -12,6 +17,8 @@ Analyze_Identity(dfTransformed, strValueCol = "KRI", strLabelCol = "KRIColumn") \item{strValueCol}{\code{character} Name of column that will be copied as \code{Score}} \item{strLabelCol}{\code{character} Name of column that will be copied as \code{ScoreLabel}} + +\item{bQuiet}{\code{logical} Suppress warning messages? Default: \code{TRUE}} } \value{ \code{data.frame} that adds two columns to \code{dfTransformed}: \code{Score} and \code{ScoreLabel} diff --git a/man/Flag.Rd b/man/Flag.Rd index 7105ff3af..f87c2d857 100644 --- a/man/Flag.Rd +++ b/man/Flag.Rd @@ -54,8 +54,8 @@ In short, the following columns are considered: \examples{ dfInput <- AE_Map_Adam() dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strExposureCol = "Exposure", strKRILabel = "AEs/Week") -dfAnalyzed <- Analyze_Wilcoxon(dfTransformed, "KRI") -dfFlagged <- Flag(dfAnalyzed) # PValue < 0.05 flagged +dfAnalyzed <- Analyze_Wilcoxon(dfTransformed) +dfFlagged <- Flag(dfAnalyzed) # P value (dfAnalyzed$Score) < 0.05 flagged dfFlagged10 <- Flag(dfAnalyzed, vThreshold = c(0.10, NA)) # PValue <0.10 flagged # Flag direction set based on 'Statistic' column dfFlagged <- Flag(dfAnalyzed, strColumn = "Score", strValueColumn = "Estimate") diff --git a/man/IE_Assess.Rd b/man/IE_Assess.Rd index 066105d0d..fb5b9380e 100644 --- a/man/IE_Assess.Rd +++ b/man/IE_Assess.Rd @@ -8,7 +8,7 @@ IE_Assess( dfInput, nThreshold = 0.5, lTags = list(Assessment = "IE"), - strKRILabel = "Total Event Count", + strKRILabel = "# of Inclusion/Exclusion Issues", bChart = TRUE, bReturnChecks = FALSE, bQuiet = TRUE @@ -21,7 +21,7 @@ IE_Assess( \item{lTags}{\code{list} Assessment tags, a named list of tags describing the assessment that defaults to \code{list(Assessment="IE")}. \code{lTags} is returned as part of the assessment (\code{lAssess$lTags}) and each tag is added as a column in \code{lAssess$dfSummary}.} -\item{strKRILabel}{\code{character} Describe the \code{KRI} column, a vector of length 1 that defaults to \verb{Total Event Count}} +\item{strKRILabel}{\code{character} Describe the \code{KRI} column, a vector of length 1 that defaults to \verb{# of Inclusion/Exclusion Issues}} \item{bChart}{\code{logical} Generate data visualization? Default: \code{TRUE}} diff --git a/man/Transform_EventCount.Rd b/man/Transform_EventCount.Rd index 318de3d09..44a009e84 100644 --- a/man/Transform_EventCount.Rd +++ b/man/Transform_EventCount.Rd @@ -4,7 +4,12 @@ \alias{Transform_EventCount} \title{Transform Event Count} \usage{ -Transform_EventCount(dfInput, strCountCol, strExposureCol = NULL, strKRILabel) +Transform_EventCount( + dfInput, + strCountCol, + strExposureCol = NULL, + strKRILabel = "[Not Specified]" +) } \arguments{ \item{dfInput}{A data.frame with one record per person.} @@ -49,6 +54,6 @@ For data with an optional strExposureCol, a summed exposure is calculated for ea \examples{ dfInput <- AE_Map_Adam() -dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strExposureCol = "Exposure", strKRILabel = "AEs/Week") +dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strExposureCol = "Exposure") } diff --git a/tests/testthat/_snaps/Study_Assess.md b/tests/testthat/_snaps/Study_Assess.md index b58f74414..3e68e30af 100644 --- a/tests/testthat/_snaps/Study_Assess.md +++ b/tests/testthat/_snaps/Study_Assess.md @@ -161,6 +161,8 @@ Input data has 3 rows. v `Transform_EventCount()` returned output with 3 rows. + `Score` column created from `KRI`. + `ScoreLabel` column created from `KRILabel`. i No analysis function used. `dfTransformed` copied directly to `dfAnalyzed` with added `ScoreLabel` column. v `Flag()` returned output with 3 rows. v `Summarize()` returned output with 3 rows. @@ -202,6 +204,8 @@ Input data has 3 rows. v `Transform_EventCount()` returned output with 3 rows. + `Score` column created from `KRI`. + `ScoreLabel` column created from `KRILabel`. i No analysis function used. `dfTransformed` copied directly to `dfAnalyzed` with added `ScoreLabel` column. v `Flag()` returned output with 3 rows. v `Summarize()` returned output with 3 rows. diff --git a/tests/testthat/test_AE_Assess.R b/tests/testthat/test_AE_Assess.R index 58c0c4495..3d1b0ee9e 100644 --- a/tests/testthat/test_AE_Assess.R +++ b/tests/testthat/test_AE_Assess.R @@ -70,6 +70,12 @@ test_that("dfAnalyzed has appropriate model output regardless of statistical met expect_true(all(c("KRI", "KRILabel", "Score", "ScoreLabel") %in% names(assessmentPoisson$dfAnalyzed))) assessmentWilcoxon <- AE_Assess(aeInput, strMethod = "wilcoxon") expect_true(all(c("KRI", "KRILabel", "Score", "ScoreLabel") %in% names(assessmentWilcoxon$dfAnalyzed))) + + expect_equal(unique(assessmentPoisson$dfAnalyzed$ScoreLabel), "Residuals") + expect_equal(unique(assessmentWilcoxon$dfAnalyzed$ScoreLabel), "P value") + + expect_equal(sort(assessmentPoisson$dfAnalyzed$Score), sort(assessmentPoisson$dfSummary$Score)) + expect_equal(sort(assessmentWilcoxon$dfAnalyzed$Score), sort(assessmentWilcoxon$dfSummary$Score)) }) test_that("bQuiet works as intended", { @@ -88,3 +94,5 @@ test_that("strKRILabel works as intended", { ae <- AE_Assess(aeInput, strKRILabel = "my test label") expect_equal(unique(ae$dfSummary$KRILabel), "my test label") }) + + diff --git a/tests/testthat/test_Analyze_Poisson.R b/tests/testthat/test_Analyze_Poisson.R index 954eac144..73c833f30 100644 --- a/tests/testthat/test_Analyze_Poisson.R +++ b/tests/testthat/test_Analyze_Poisson.R @@ -7,7 +7,8 @@ test_that("output created as expected and has correct structure", { ae_anly <- Analyze_Poisson(ae_prep) expect_true(is.data.frame(ae_anly)) expect_equal(sort(unique(ae_input$SiteID)), sort(ae_anly$SiteID)) - expect_equal(names(ae_anly), c("SiteID", "N", "TotalExposure", "TotalCount", "Rate", "Residuals", "PredictedCount")) + expect_equal(names(ae_anly), c("SiteID", "N", "TotalCount", "TotalExposure", "KRI", "KRILabel", + "Score", "ScoreLabel", "PredictedCount")) }) test_that("incorrect inputs throw errors", { diff --git a/tests/testthat/test_Analyze_Wilcoxon.R b/tests/testthat/test_Analyze_Wilcoxon.R index a25435cce..4aa75249c 100644 --- a/tests/testthat/test_Analyze_Wilcoxon.R +++ b/tests/testthat/test_Analyze_Wilcoxon.R @@ -4,9 +4,10 @@ ae_input <- AE_Map_Adam(dfs = list(dfADSL = dfADSL, dfADAE = dfADAE)) ae_prep <- Transform_EventCount(ae_input, strCountCol = "Count", strExposureCol = "Exposure") test_that("output created as expected and has correct structure", { - aew_anly <- Analyze_Wilcoxon(ae_prep, strOutcome = "Rate") + aew_anly <- Analyze_Wilcoxon(ae_prep) expect_true(is.data.frame(aew_anly)) - expect_true(all(c("SiteID", "N", "Estimate", "PValue") %in% names(aew_anly))) + expect_true(all(c("SiteID", "N", "TotalCount", "TotalExposure", "KRI", "KRILabel", + "Estimate", "Score", "ScoreLabel") %in% names(aew_anly))) expect_equal(sort(unique(ae_input$SiteID)), sort(aew_anly$SiteID)) }) @@ -29,24 +30,22 @@ test_that("error given if required column not found", { test_that("model isn't run with fewer than three records", { aew_anly <- Analyze_Wilcoxon( - ae_prep %>% filter(row_number() < 3), - strOutcome = "Rate" + ae_prep %>% filter(row_number() < 3) ) expect_true(is.data.frame(aew_anly)) - expect_true(all(c("SiteID", "N", "Estimate", "PValue") %in% names(aew_anly))) + expect_true(all(c("SiteID", "N", "TotalCount", "TotalExposure", "KRI", "KRILabel", "Estimate", "Score", "ScoreLabel") %in% names(aew_anly))) expect_true(all(is.na(aew_anly$Estimate))) - expect_true(all(is.na(aew_anly$PValue))) + expect_true(all(is.na(aew_anly$Score))) }) test_that("model isn't run with a single outcome value", { aew_anly <- Analyze_Wilcoxon( - ae_prep %>% mutate(Rate = .5), - strOutcome = "Rate" + ae_prep %>% mutate(KRI = .5) ) expect_true(is.data.frame(aew_anly)) - expect_true(all(c("SiteID", "N", "Estimate", "PValue") %in% names(aew_anly))) + expect_true(all(c("SiteID", "N", "TotalCount", "TotalExposure", "KRI", "KRILabel", "Estimate", "Score", "ScoreLabel") %in% names(aew_anly))) + expect_true(all(is.na(aew_anly$Score))) expect_true(all(is.na(aew_anly$Estimate))) - expect_true(all(is.na(aew_anly$PValue))) }) diff --git a/tests/testthat/test_Consent_Assess.R b/tests/testthat/test_Consent_Assess.R index 04a8b120f..6366104f5 100644 --- a/tests/testthat/test_Consent_Assess.R +++ b/tests/testthat/test_Consent_Assess.R @@ -58,6 +58,7 @@ test_that("incorrect lTags throw errors", { test_that("dfAnalyzed has appropriate model output regardless of statistical method", { assessment <- Consent_Assess(consentInput) expect_equal(unique(assessment$dfAnalyzed$ScoreLabel), "Total Number of Consent Issues") + expect_equal(sort(assessment$dfAnalyzed$Score), sort(assessment$dfSummary$Score)) }) test_that("bQuiet works as intended", { diff --git a/tests/testthat/test_Flag.R b/tests/testthat/test_Flag.R index f92a9d9a0..d3de352e5 100644 --- a/tests/testthat/test_Flag.R +++ b/tests/testthat/test_Flag.R @@ -5,7 +5,7 @@ data <- AE_Map_Adam(dfs = list(dfADSL = dfADSL, dfADAE = dfADAE)) %>% dfPoisson <- Analyze_Poisson(data) -dfWilcoxon <- Analyze_Wilcoxon(data, strOutcome = "Rate") +dfWilcoxon <- Analyze_Wilcoxon(data) # output is created as expected ------------------------------------------- test_that("output is created as expected", { @@ -13,10 +13,13 @@ test_that("output is created as expected", { expect_true(is.data.frame(flag)) expect_equal(sort(unique(dfWilcoxon$SiteID)), sort(flag$SiteID)) expect_true(all(names(dfWilcoxon) %in% names(flag))) - expect_equal(names(flag), c( - "SiteID", "N", "TotalCount", "TotalExposure", "Rate", "Estimate", - "PValue", "ThresholdLow", "ThresholdHigh", "ThresholdCol", "Flag" - )) + expect_equal( + names(flag), + c( + "SiteID", "N", "TotalCount", "TotalExposure", "KRI", "KRILabel", "Estimate", + "Score", "ScoreLabel", "ThresholdLow", "ThresholdHigh", "ThresholdCol", "Flag" + ) + ) }) # incorrect inputs throw errors ------------------------------------------- @@ -25,18 +28,18 @@ test_that("incorrect inputs throw errors", { expect_error(Flag("Hi", -1, 1)) expect_error(Flag(dfPoisson, "1", "2")) expect_error(Flag(dfPoisson, vThreshold = c(NA, 1), strColumn = 1.0, strValueColumn = "Estimate")) - expect_error(Flag(dfPoisson, vThreshold = "1", strColumn = "PValue", strValueColumn = "Estimate")) - expect_error(Flag(dfPoisson, vThreshold = 0.5, strColumn = "PValue", strValueColumn = "Estimate")) + expect_error(Flag(dfPoisson, vThreshold = "1", strValueColumn = "Estimate")) + expect_error(Flag(dfPoisson, vThreshold = 0.5, strValueColumn = "Estimate")) expect_error(Flag(dfPoisson, vThreshold = c(NA, 1), strColumn = "PValue1", strValueColumn = "Estimate")) - expect_error(Flag(dfPoisson, vThreshold = c(NA, 1), strColumn = "PValue", strValueColumn = "Mean")) + expect_error(Flag(dfPoisson, vThreshold = c(NA, 1), strValueColumn = "Mean")) }) # custom tests ------------------------------------------------------------ test_that("strValueColumn paramter works as intended", { - dfFlagged <- Flag(dfWilcoxon, strColumn = "PValue", vThreshold = c(0.6, NA), strValueColumn = "Estimate") + dfFlagged <- Flag(dfWilcoxon, vThreshold = c(0.6, NA), strValueColumn = "Estimate") expect_equal(dfFlagged$Flag[1], 1) - dfFlagged <- Flag(dfWilcoxon, strColumn = "PValue", vThreshold = c(0.2, NA), strValueColumn = NULL) + dfFlagged <- Flag(dfWilcoxon, vThreshold = c(0.2, NA), strValueColumn = NULL) expect_equal(dfFlagged$Flag[1], 0) }) diff --git a/tests/testthat/test_IE_Assess.R b/tests/testthat/test_IE_Assess.R index a46931ef0..904616a2e 100644 --- a/tests/testthat/test_IE_Assess.R +++ b/tests/testthat/test_IE_Assess.R @@ -54,7 +54,8 @@ test_that("incorrect lTags throw errors", { # custom tests ------------------------------------------------------------ test_that("dfAnalyzed has appropriate model output regardless of statistical method", { assessment <- IE_Assess(ieInput) - expect_equal(unique(assessment$dfAnalyzed$ScoreLabel), "Total Number of Inclusion/Exclusion Issues") + expect_equal(unique(assessment$dfAnalyzed$ScoreLabel), "# of Inclusion/Exclusion Issues") + expect_equal(sort(assessment$dfAnalyzed$Score), sort(assessment$dfSummary$Score)) }) test_that("bQuiet works as intended", { diff --git a/tests/testthat/test_PD_Assess.R b/tests/testthat/test_PD_Assess.R index 9b78c142d..ca4a6e55b 100644 --- a/tests/testthat/test_PD_Assess.R +++ b/tests/testthat/test_PD_Assess.R @@ -81,6 +81,12 @@ test_that("dfAnalyzed has appropriate model output regardless of statistical met expect_true(all(c("KRI", "KRILabel", "Score", "ScoreLabel") %in% names(assessmentPoisson$dfAnalyzed))) assessmentWilcoxon <- PD_Assess(pdInput, strMethod = "wilcoxon") expect_true(all(c("KRI", "KRILabel", "Score", "ScoreLabel") %in% names(assessmentWilcoxon$dfAnalyzed))) + + expect_equal(unique(assessmentPoisson$dfAnalyzed$ScoreLabel), "Residuals") + expect_equal(unique(assessmentWilcoxon$dfAnalyzed$ScoreLabel), "P value") + + expect_equal(sort(assessmentPoisson$dfAnalyzed$Score), sort(assessmentPoisson$dfSummary$Score)) + expect_equal(sort(assessmentWilcoxon$dfAnalyzed$Score), sort(assessmentWilcoxon$dfSummary$Score)) }) test_that("bQuiet works as intended", { From 5b520eb832a9b85712925f8e65010ab8b4daa44b Mon Sep 17 00:00:00 2001 From: Matt Roumaya Date: Thu, 9 Jun 2022 21:27:28 +0000 Subject: [PATCH 54/87] update examples --- R/Analyze_Fisher.R | 2 +- man/Analyze_Fisher.Rd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/Analyze_Fisher.R b/R/Analyze_Fisher.R index d18b95905..a061cecac 100644 --- a/R/Analyze_Fisher.R +++ b/R/Analyze_Fisher.R @@ -26,7 +26,7 @@ #' #' @examples #' dfInput <- Disp_Map(dfDisp = safetyData::adam_adsl, strCol = "DCREASCD", strReason = "Adverse Event") -#' dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strKRILabel = ""Discontinuations due to AE/Month"") +#' dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strKRILabel = "Discontinuations due to AE/Month") #' dfAnalyzed <- Analyze_Fisher(dfTransformed) #' #' @import dplyr diff --git a/man/Analyze_Fisher.Rd b/man/Analyze_Fisher.Rd index bfc669b7d..a9da234c7 100644 --- a/man/Analyze_Fisher.Rd +++ b/man/Analyze_Fisher.Rd @@ -41,7 +41,7 @@ The input data (\code{dfTransformed}) for Analyze_Fisher is typically created us \examples{ dfInput <- Disp_Map(dfDisp = safetyData::adam_adsl, strCol = "DCREASCD", strReason = "Adverse Event") -dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strKRILabel = ""Discontinuations due to AE/Month"") +dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strKRILabel = "Discontinuations due to AE/Month") dfAnalyzed <- Analyze_Fisher(dfTransformed) } From a679fd0b0221432758c663b37358eeac026a0d2b Mon Sep 17 00:00:00 2001 From: Spencer Childress Date: Fri, 10 Jun 2022 11:52:38 -0400 Subject: [PATCH 55/87] align AE and PD unit tests --- tests/testthat/test_AE_Map_Raw.R | 44 ++++++------ tests/testthat/test_PD_Map_Raw.R | 114 +++++++++++-------------------- 2 files changed, 59 insertions(+), 99 deletions(-) diff --git a/tests/testthat/test_AE_Map_Raw.R b/tests/testthat/test_AE_Map_Raw.R index ef9bfa904..d597a34e6 100644 --- a/tests/testthat/test_AE_Map_Raw.R +++ b/tests/testthat/test_AE_Map_Raw.R @@ -13,6 +13,7 @@ test_that("incorrect inputs throw errors", { expect_snapshot(AE_Map_Raw(dfs = list(dfAE = dfAE, dfSUBJ = list()), bQuiet = F)) expect_snapshot(AE_Map_Raw(dfs = list(dfAE = list(), dfSUBJ = dfSUBJ), bQuiet = F)) expect_snapshot(AE_Map_Raw(dfs = list(dfAE = "Hi", dfSUBJ = "Mom"), bQuiet = F)) + expect_snapshot(AE_Map_Raw(dfs = list(dfAE = dfAE, dfSUBJ = dfSUBJ), lMapping = list(), bQuiet = F)) expect_snapshot(AE_Map_Raw(dfs = list(dfAE = dfAE %>% select(-SubjectID), dfSUBJ = dfSUBJ), bQuiet = F)) expect_snapshot(AE_Map_Raw(dfs = list(dfAE = dfAE, dfSUBJ = dfSUBJ %>% select(-SiteID)), bQuiet = F)) expect_snapshot(AE_Map_Raw(dfs = list(dfAE = dfAE, dfSUBJ = dfSUBJ %>% select(-SubjectID)), bQuiet = F)) @@ -59,7 +60,7 @@ test_that("NA values in input data are handled", { dfAE1 <- tibble::tribble( ~SubjectID, 1, 1, 1, 1, 2, 2, 4, 4 ) - dfExposure1 <- tibble::tribble( + dfSUBJ1 <- tibble::tribble( ~SubjectID, ~SiteID, ~TimeOnTreatment, 1, 1, 10, 2, 1, NA, @@ -67,7 +68,7 @@ test_that("NA values in input data are handled", { 4, 2, 50 ) mapped1 <- AE_Map_Raw( - list(dfAE = dfAE1, dfSUBJ = dfExposure1) + list(dfAE = dfAE1, dfSUBJ = dfSUBJ1) ) expect_null(mapped1) @@ -75,7 +76,7 @@ test_that("NA values in input data are handled", { dfAE2 <- tibble::tribble( ~SubjectID, 1, NA, 1, 1, 2, 2, 4, 4 ) - dfExposure2 <- tibble::tribble( + dfSUBJ2 <- tibble::tribble( ~SubjectID, ~SiteID, ~TimeOnTreatment, 1, 1, 10, 2, 1, 20, @@ -83,7 +84,7 @@ test_that("NA values in input data are handled", { 4, 2, 50 ) mapped2 <- AE_Map_Raw( - list(dfAE = dfAE2, dfSUBJ = dfExposure2) + list(dfAE = dfAE2, dfSUBJ = dfSUBJ2) ) expect_null(mapped2) @@ -91,7 +92,7 @@ test_that("NA values in input data are handled", { dfAE3 <- tibble::tribble( ~SubjectID, 1, 1, 1, 1, 2, 2, 4, 4 ) - dfExposure3 <- tibble::tribble( + dfSUBJ3 <- tibble::tribble( ~SubjectID, ~SiteID, ~TimeOnTreatment, NA, 1, 10, 2, 1, 20, @@ -99,11 +100,23 @@ test_that("NA values in input data are handled", { 4, 2, 50 ) mapped3 <- AE_Map_Raw( - list(dfAE = dfAE3, dfSUBJ = dfExposure3) + list(dfAE = dfAE3, dfSUBJ = dfSUBJ3) ) expect_null(mapped3) }) +test_that("duplicate SubjectID values are caught in dfSUBJ", { + dfAE <- tribble(~SubjectID, 1, 2) + + dfSUBJ <- tribble( + ~SubjectID, ~SiteID, ~TimeOnTreatment, + 1, 1, 10, + 1, 1, 30 + ) + + expect_snapshot(AE_Map_Raw(dfs = list(dfAE = dfAE, dfSUBJ = dfSUBJ), bQuiet = F)) +}) + test_that("bQuiet works as intended", { expect_message( AE_Map_Raw(dfs = list(dfAE = dfAE, dfSUBJ = dfSUBJ), bQuiet = FALSE) @@ -115,22 +128,3 @@ test_that("bReturnChecks works as intended", { all(names(AE_Map_Raw(dfs = list(dfAE = dfAE, dfSUBJ = dfSUBJ), bReturnChecks = TRUE)) == c("df", "lChecks")) ) }) -# -# test_that("custom mapping runs without errors", { -# -# custom_mapping <- list( -# dfAE= list(strIDCol="SubjectID", -# strTreatmentEmergentCol = "AE_TE_FLAG"), -# dfSUBJ=list(strIDCol="custom_id", -# strSiteCol="custom_site_id", -# strTimeOnTreatmentCol="trtmnt") -# ) -# -# custom_subj <- dfSUBJ %>% -# mutate(trtmnt = TimeOnTreatment * 2.025) %>% -# rename(custom_id = SubjectID, -# custom_site_id = SiteID) -# -# expect_silent(AE_Map_Raw(dfAE, custom_subj, mapping = custom_mapping)) -# -# }) diff --git a/tests/testthat/test_PD_Map_Raw.R b/tests/testthat/test_PD_Map_Raw.R index a67a2b74e..74847c397 100644 --- a/tests/testthat/test_PD_Map_Raw.R +++ b/tests/testthat/test_PD_Map_Raw.R @@ -23,47 +23,52 @@ test_that("incorrect inputs throw errors", { # incorrect mappings throw errors ----------------------------------------- test_that("incorrect mappings throw errors", { - expect_snapshot(PD_Map_Raw( - dfs = list(dfPD = dfPD, dfSUBJ = dfSUBJ), - lMapping = list( - dfPD = list(strIDCol = "not an id"), - dfSUBJ = list( - strIDCol = "SubjectID", - strSiteCol = "SiteID", - strTimeOnStudyCol = "TimeOnStudy" - ) - ), bQuiet = F - )) - - expect_snapshot(PD_Map_Raw( - dfs = list(dfPD = dfPD, dfSUBJ = dfSUBJ), - lMapping = list( - dfPD = list(strIDCol = "SubjectID"), - dfSUBJ = list( - strIDCol = "not an id", - strSiteCol = "SiteID", - strTimeOnStudyCol = "TimeOnStudy" - ) - ), bQuiet = F - )) + expect_snapshot( + PD_Map_Raw( + dfs = list(dfPD = dfPD, dfSUBJ = dfSUBJ), + lMapping = list( + dfPD = list(strIDCol = "not an id"), + dfSUBJ = list( + strIDCol = "SubjectID", + strSiteCol = "SiteID", + strTimeOnStudyCol = "TimeOnStudy" + ) + ), + bQuiet = F + ) + ) + + expect_snapshot( + PD_Map_Raw( + dfs = list(dfPD = dfPD, dfSUBJ = dfSUBJ), + lMapping = list( + dfPD = list(strIDCol = "SubjectID"), + dfSUBJ = list( + strIDCol = "not an id", + strSiteCol = "SiteID", + strTimeOnStudyCol = "TimeOnStudy" + ) + ), + bQuiet = F + ) + ) }) - # custom tests ------------------------------------------------------------ test_that("NA values in input data are handled", { - # NA SiteID and TimeOnTreatment. + # NA SiteID and TimeOnStudy. dfPD1 <- tibble::tribble( ~SubjectID, 1, 1, 1, 1, 2, 2, 4, 4 ) - dfExposure1 <- tibble::tribble( - ~SubjectID, ~SiteID, ~TimeOnTreatment, + dfSUBJ1 <- tibble::tribble( + ~SubjectID, ~SiteID, ~TimeOnStudy, 1, 1, 10, 2, 1, NA, 3, NA, 30, 4, 2, 50 ) mapped1 <- PD_Map_Raw( - list(dfPD = dfPD1, dfSUBJ = dfExposure1) + list(dfPD = dfPD1, dfSUBJ = dfSUBJ1) ) expect_null(mapped1) @@ -71,15 +76,15 @@ test_that("NA values in input data are handled", { dfPD2 <- tibble::tribble( ~SubjectID, 1, NA, 1, 1, 2, 2, 4, 4 ) - dfExposure2 <- tibble::tribble( - ~SubjectID, ~SiteID, ~TimeOnTreatment, + dfSUBJ2 <- tibble::tribble( + ~SubjectID, ~SiteID, ~TimeOnStudy, 1, 1, 10, 2, 1, 20, 3, 3, 30, 4, 2, 50 ) mapped2 <- PD_Map_Raw( - list(dfPD = dfPD2, dfSUBJ = dfExposure2) + list(dfPD = dfPD2, dfSUBJ = dfSUBJ2) ) expect_null(mapped2) @@ -87,59 +92,20 @@ test_that("NA values in input data are handled", { dfPD3 <- tibble::tribble( ~SubjectID, 1, 1, 1, 1, 2, 2, 4, 4 ) - dfExposure3 <- tibble::tribble( - ~SubjectID, ~SiteID, ~TimeOnTreatment, + dfSUBJ3 <- tibble::tribble( + ~SubjectID, ~SiteID, ~TimeOnStudy, NA, 1, 10, 2, 1, 20, 3, 2, 30, 4, 2, 50 ) mapped3 <- PD_Map_Raw( - list(dfPD = dfPD3, dfSUBJ = dfExposure3) + list(dfPD = dfPD3, dfSUBJ = dfSUBJ3) ) expect_null(mapped3) }) -test_that("NA values are caught", { - dfPD <- tribble(~SubjectID, 1, 1, 1, 1, 2, 2) - - dfTos <- tribble( - ~SubjectID, ~SiteID, ~TimeOnStudy, - 1, 1, 10, - 2, 1, NA, - 3, 1, 30 - ) - - dfInput <- tribble( - ~SubjectID, ~SiteID, ~Count, ~Exposure, ~Rate, - 1, 1, 4, 10, 0.4, - 2, 1, 2, NA, NA, - 3, 1, 0, 30, 0 - ) - - dfPD2 <- tribble(~SubjectID, 1, 1, 1, 1, 2, 2, 4, 4) - - dfTos2 <- tribble( - ~SubjectID, ~SiteID, ~TimeOnStudy, - 1, 1, 10, - 2, 1, NA, - 3, 1, 30, - 4, 2, 50 - ) - - dfInput2 <- tribble( - ~SubjectID, ~SiteID, ~Count, ~Exposure, ~Rate, - 1, 1, 4, 10, 0.4, - 2, 1, 2, NA, NA, - 3, 1, 0, 30, 0, - 4, 2, 2, 50, .04 - ) - - expect_snapshot(PD_Map_Raw(dfs = list(dfPD = dfPD, dfSUBJ = dfTos), bQuiet = F)) - expect_snapshot(PD_Map_Raw(dfs = list(dfPD = dfPD2, dfSUBJ = dfTos2), bQuiet = F)) -}) - -test_that("duplicate SubjectID values are caught in RDSL", { +test_that("duplicate SubjectID values are caught in dfSUBJ", { dfPD <- tribble(~SubjectID, 1, 2) dfSUBJ <- tribble( From e31e7b8414328bdd3454d201890bb7d842b35bb8 Mon Sep 17 00:00:00 2001 From: Nathan Kosiba Date: Fri, 10 Jun 2022 16:45:35 +0000 Subject: [PATCH 56/87] update qualification tests for KRI update --- tests/testthat/helper-qualification.R | 38 ++++++++++++++++----------- tests/testthat/test_qual_T1_1.R | 19 +++++++------- tests/testthat/test_qual_T1_2.R | 19 +++++++------- tests/testthat/test_qual_T1_3.R | 19 +++++++------- tests/testthat/test_qual_T1_4.R | 19 +++++++------- tests/testthat/test_qual_T1_5.R | 17 ++++++------ tests/testthat/test_qual_T1_6.R | 17 ++++++------ tests/testthat/test_qual_T1_7.R | 17 ++++++------ tests/testthat/test_qual_T1_8.R | 17 ++++++------ tests/testthat/test_qual_T2_1.R | 19 +++++++------- tests/testthat/test_qual_T2_2.R | 19 +++++++------- tests/testthat/test_qual_T2_3.R | 19 +++++++------- tests/testthat/test_qual_T2_4.R | 17 ++++++------ tests/testthat/test_qual_T2_5.R | 17 ++++++------ tests/testthat/test_qual_T2_6.R | 17 ++++++------ tests/testthat/test_qual_T3_1.R | 22 +++++++++------- tests/testthat/test_qual_T3_2.R | 22 +++++++++------- tests/testthat/test_qual_T3_3.R | 22 +++++++++------- tests/testthat/test_qual_T4_1.R | 22 +++++++++------- tests/testthat/test_qual_T4_2.R | 22 +++++++++------- 20 files changed, 202 insertions(+), 198 deletions(-) diff --git a/tests/testthat/helper-qualification.R b/tests/testthat/helper-qualification.R index 1827f8d2e..cea3e4575 100644 --- a/tests/testthat/helper-qualification.R +++ b/tests/testthat/helper-qualification.R @@ -1,13 +1,18 @@ -qualification_transform_counts <- function(dfInput, countCol = "Count", exposureCol = "Exposure") { +qualification_transform_counts <- function(dfInput, + countCol = "Count", + exposureCol = "Exposure", + KRILabel = "") { if (is.na(exposureCol)) { dfTransformed <- dfInput %>% filter(!is.na(.data[[countCol]])) %>% group_by(.data$SiteID) %>% summarise( N = n(), - TotalCount = sum(.data[[countCol]]) + TotalCount = sum(.data[[countCol]]), + KRI = TotalCount, + KRILabel = KRILabel ) %>% - select(SiteID, N, TotalCount) + select(SiteID, N, TotalCount, KRI, KRILabel) } else { dfTransformed <- dfInput %>% filter(!is.na(.data[[countCol]])) %>% @@ -15,10 +20,11 @@ qualification_transform_counts <- function(dfInput, countCol = "Count", exposure summarise( N = n(), TotalCount = sum(.data[[countCol]]), - TotalExposure = sum(.data[[exposureCol]]) + TotalExposure = sum(.data[[exposureCol]]), + KRILabel = KRILabel ) %>% - mutate(Rate = .data$TotalCount / .data$TotalExposure) %>% - select(SiteID, N, TotalCount, TotalExposure, Rate) + mutate(KRI = .data$TotalCount / .data$TotalExposure) %>% + select(SiteID, N, TotalCount, TotalExposure, KRI, KRILabel) } return(dfTransformed) @@ -34,11 +40,12 @@ qualification_analyze_poisson <- function(dfTransformed) { outputDF <- dfTransformed %>% mutate( - Residuals = unname(residuals(model)), - PredictedCount = exp(LogExposure * model$coefficients[2] + model$coefficients[1]) + Score = unname(residuals(model)), + PredictedCount = exp(LogExposure * model$coefficients[2] + model$coefficients[1]), + ScoreLabel = "Residuals" ) %>% - arrange(Residuals) %>% - select(SiteID, N, TotalExposure, TotalCount, Rate, Residuals, PredictedCount) + arrange(Score) %>% + select(SiteID, N, TotalCount, TotalExposure, KRI, KRILabel, Score, ScoreLabel, PredictedCount) return(outputDF) } @@ -52,7 +59,7 @@ qualification_analyze_wilcoxon <- function(dfTransformed) { colnames(dfSummary) <- c("N", "Mean", "SD", "Median", "Q1", "Q3", "Min", "Max") for (i in 1:length(sites)) { - testres <- wilcox.test(dfTransformed$Rate ~ dfTransformed$SiteID == sites[i], exact = FALSE, conf.int = TRUE) + testres <- wilcox.test(dfTransformed$KRI ~ dfTransformed$SiteID == sites[i], exact = FALSE, conf.int = TRUE) pvals[i] <- testres$p.value estimates[i] <- testres$estimate * -1 @@ -60,11 +67,12 @@ qualification_analyze_wilcoxon <- function(dfTransformed) { outputDF <- data.frame( dfTransformed, - PValue = pvals, - Estimate = estimates + Score = pvals, + Estimate = estimates, + ScoreLabel = "P value" ) %>% - arrange(PValue) %>% - select(SiteID, N, TotalCount, TotalExposure, Rate, Estimate, PValue) + arrange(Score) %>% + select(SiteID, N, TotalCount, TotalExposure, KRI, KRILabel, Estimate, Score, ScoreLabel) return(outputDF) } diff --git a/tests/testthat/test_qual_T1_1.R b/tests/testthat/test_qual_T1_1.R index 3ad1021f7..47322df92 100644 --- a/tests/testthat/test_qual_T1_1.R +++ b/tests/testthat/test_qual_T1_1.R @@ -12,7 +12,7 @@ test_that("AE assessment can return a correctly assessed data frame for the pois t1_input <- dfInput t1_transformed <- dfInput %>% - qualification_transform_counts() + qualification_transform_counts(KRILabel = "AEs/Week") t1_analyzed <- t1_transformed %>% qualification_analyze_poisson() @@ -23,12 +23,12 @@ test_that("AE assessment can return a correctly assessed data frame for the pois mutate( ThresholdLow = -5, ThresholdHigh = 5, - ThresholdCol = "Residuals", + ThresholdCol = "Score", Flag = case_when( - Residuals < -5 ~ -1, - Residuals > 5 ~ 1, - is.na(Residuals) ~ NA_real_, - is.nan(Residuals) ~ NA_real_, + Score < -5 ~ -1, + Score > 5 ~ 1, + is.na(Score) ~ NA_real_, + is.nan(Score) ~ NA_real_, TRUE ~ 0 ), ) %>% @@ -36,11 +36,10 @@ test_that("AE assessment can return a correctly assessed data frame for the pois t1_summary <- t1_flagged %>% mutate( - Assessment = "AE", - Score = Residuals + Assessment = "AE" ) %>% - select(SiteID, N, Score, Flag, Assessment) %>% - arrange(desc(abs(.data$Score))) %>% + select(SiteID, N, KRI, KRILabel, Score, ScoreLabel, Flag, Assessment) %>% + arrange(desc(abs(KRI))) %>% arrange(match(Flag, c(1, -1, 0))) diff --git a/tests/testthat/test_qual_T1_2.R b/tests/testthat/test_qual_T1_2.R index 495a88350..77ab797e5 100644 --- a/tests/testthat/test_qual_T1_2.R +++ b/tests/testthat/test_qual_T1_2.R @@ -14,7 +14,7 @@ test_that("AE assessment can return a correctly assessed data frame for the pois t1_2_input <- dfInput t1_2_transformed <- dfInput %>% - qualification_transform_counts() + qualification_transform_counts(KRILabel = "AEs/Week") t1_2_analyzed <- t1_2_transformed %>% qualification_analyze_poisson() @@ -25,12 +25,12 @@ test_that("AE assessment can return a correctly assessed data frame for the pois mutate( ThresholdLow = -3, ThresholdHigh = 3, - ThresholdCol = "Residuals", + ThresholdCol = "Score", Flag = case_when( - Residuals < -3 ~ -1, - Residuals > 3 ~ 1, - is.na(Residuals) ~ NA_real_, - is.nan(Residuals) ~ NA_real_, + Score < -3 ~ -1, + Score > 3 ~ 1, + is.na(Score) ~ NA_real_, + is.nan(Score) ~ NA_real_, TRUE ~ 0 ), ) %>% @@ -38,11 +38,10 @@ test_that("AE assessment can return a correctly assessed data frame for the pois t1_2_summary <- t1_2_flagged %>% mutate( - Assessment = "AE", - Score = Residuals + Assessment = "AE" ) %>% - select(SiteID, N, Score, Flag, Assessment) %>% - arrange(desc(abs(Score))) %>% + select(SiteID, N, KRI, KRILabel, Score, ScoreLabel, Flag, Assessment) %>% + arrange(desc(abs(KRI))) %>% arrange(match(Flag, c(1, -1, 0))) t1_2 <- list( diff --git a/tests/testthat/test_qual_T1_3.R b/tests/testthat/test_qual_T1_3.R index ecc33f2df..4147eb037 100644 --- a/tests/testthat/test_qual_T1_3.R +++ b/tests/testthat/test_qual_T1_3.R @@ -12,7 +12,7 @@ test_that("AE assessment can return a correctly assessed data frame for the pois t1_3_input <- dfInput t1_3_transformed <- dfInput %>% - qualification_transform_counts() + qualification_transform_counts(KRILabel = "AEs/Week") t1_3_analyzed <- t1_3_transformed %>% qualification_analyze_poisson() @@ -23,12 +23,12 @@ test_that("AE assessment can return a correctly assessed data frame for the pois mutate( ThresholdLow = -5, ThresholdHigh = 5, - ThresholdCol = "Residuals", + ThresholdCol = "Score", Flag = case_when( - Residuals < -5 ~ -1, - Residuals > 5 ~ 1, - is.na(Residuals) ~ NA_real_, - is.nan(Residuals) ~ NA_real_, + Score < -5 ~ -1, + Score > 5 ~ 1, + is.na(Score) ~ NA_real_, + is.nan(Score) ~ NA_real_, TRUE ~ 0 ), ) %>% @@ -36,11 +36,10 @@ test_that("AE assessment can return a correctly assessed data frame for the pois t1_3_summary <- t1_3_flagged %>% mutate( - Assessment = "AE", - Score = Residuals + Assessment = "AE" ) %>% - select(SiteID, N, Score, Flag, Assessment) %>% - arrange(desc(abs(.data$Score))) %>% + select(SiteID, N, KRI, KRILabel, Score, ScoreLabel, Flag, Assessment) %>% + arrange(desc(abs(KRI))) %>% arrange(match(Flag, c(1, -1, 0))) t1_3 <- list( diff --git a/tests/testthat/test_qual_T1_4.R b/tests/testthat/test_qual_T1_4.R index 8989c0882..122594e53 100644 --- a/tests/testthat/test_qual_T1_4.R +++ b/tests/testthat/test_qual_T1_4.R @@ -20,7 +20,7 @@ test_that("AE assessment can return a correctly assessed data frame for the pois t1_4_input <- dfInput t1_4_transformed <- dfInput %>% - qualification_transform_counts() + qualification_transform_counts(KRILabel = "AEs/Week") t1_4_analyzed <- t1_4_transformed %>% qualification_analyze_poisson() @@ -31,12 +31,12 @@ test_that("AE assessment can return a correctly assessed data frame for the pois mutate( ThresholdLow = -5, ThresholdHigh = 5, - ThresholdCol = "Residuals", + ThresholdCol = "Score", Flag = case_when( - Residuals < -5 ~ -1, - Residuals > 5 ~ 1, - is.na(Residuals) ~ NA_real_, - is.nan(Residuals) ~ NA_real_, + Score < -5 ~ -1, + Score > 5 ~ 1, + is.na(Score) ~ NA_real_, + is.nan(Score) ~ NA_real_, TRUE ~ 0 ), ) %>% @@ -44,11 +44,10 @@ test_that("AE assessment can return a correctly assessed data frame for the pois t1_4_summary <- t1_4_flagged %>% mutate( - Assessment = "AE", - Score = Residuals + Assessment = "AE" ) %>% - select(SiteID, N, Score, Flag, Assessment) %>% - arrange(desc(abs(Score))) %>% + select(SiteID, N, KRI, KRILabel, Score, ScoreLabel, Flag, Assessment) %>% + arrange(desc(abs(KRI))) %>% arrange(match(Flag, c(1, -1, 0))) t1_4 <- c(t1_4, diff --git a/tests/testthat/test_qual_T1_5.R b/tests/testthat/test_qual_T1_5.R index 8e3ae9285..65825a336 100644 --- a/tests/testthat/test_qual_T1_5.R +++ b/tests/testthat/test_qual_T1_5.R @@ -12,7 +12,7 @@ test_that("AE assessment can return a correctly assessed data frame for the wilc t1_5_input <- dfInput t1_5_transformed <- dfInput %>% - qualification_transform_counts() + qualification_transform_counts(KRILabel = "AEs/Week") t1_5_analyzed <- t1_5_transformed %>% qualification_analyze_wilcoxon() @@ -24,11 +24,11 @@ test_that("AE assessment can return a correctly assessed data frame for the wilc mutate( ThresholdLow = .0001, ThresholdHigh = NA_integer_, - ThresholdCol = "PValue", + ThresholdCol = "Score", Flag = case_when( - PValue < 0.0001 ~ -1, - is.na(PValue) ~ NA_real_, - is.nan(PValue) ~ NA_real_, + Score < 0.0001 ~ -1, + is.na(Score) ~ NA_real_, + is.nan(Score) ~ NA_real_, TRUE ~ 0 ), median = median(Estimate), @@ -43,11 +43,10 @@ test_that("AE assessment can return a correctly assessed data frame for the wilc t1_5_summary <- t1_5_flagged %>% mutate( - Assessment = "AE", - Score = PValue + Assessment = "AE" ) %>% - select(SiteID, N, Score, Flag, Assessment) %>% - arrange(desc(abs(.data$Score))) %>% + select(SiteID, N, KRI, KRILabel, Score, ScoreLabel, Flag, Assessment) %>% + arrange(desc(abs(KRI))) %>% arrange(match(Flag, c(1, -1, 0))) diff --git a/tests/testthat/test_qual_T1_6.R b/tests/testthat/test_qual_T1_6.R index da49e0972..765838227 100644 --- a/tests/testthat/test_qual_T1_6.R +++ b/tests/testthat/test_qual_T1_6.R @@ -13,7 +13,7 @@ test_that("AE assessment can return a correctly assessed data frame for the wilc t1_6_input <- dfInput t1_6_transformed <- dfInput %>% - qualification_transform_counts() + qualification_transform_counts(KRILabel = "AEs/Week") t1_6_analyzed <- t1_6_transformed %>% qualification_analyze_wilcoxon() @@ -25,11 +25,11 @@ test_that("AE assessment can return a correctly assessed data frame for the wilc mutate( ThresholdLow = 0.1, ThresholdHigh = NA_integer_, - ThresholdCol = "PValue", + ThresholdCol = "Score", Flag = case_when( - PValue < 0.1 ~ -1, - is.na(PValue) ~ NA_real_, - is.nan(PValue) ~ NA_real_, + Score < 0.1 ~ -1, + is.na(Score) ~ NA_real_, + is.nan(Score) ~ NA_real_, TRUE ~ 0 ), median = median(Estimate), @@ -44,11 +44,10 @@ test_that("AE assessment can return a correctly assessed data frame for the wilc t1_6_summary <- t1_6_flagged %>% mutate( - Assessment = "AE", - Score = PValue + Assessment = "AE" ) %>% - select(SiteID, N, Score, Flag, Assessment) %>% - arrange(desc(abs(.data$Score))) %>% + select(SiteID, N, KRI, KRILabel, Score, ScoreLabel, Flag, Assessment) %>% + arrange(desc(abs(KRI))) %>% arrange(match(Flag, c(1, -1, 0))) t1_6 <- list( diff --git a/tests/testthat/test_qual_T1_7.R b/tests/testthat/test_qual_T1_7.R index 0b3842f2a..e04fb45b7 100644 --- a/tests/testthat/test_qual_T1_7.R +++ b/tests/testthat/test_qual_T1_7.R @@ -15,7 +15,7 @@ test_that("AE assessment can return a correctly assessed data frame for the wilc t1_7_input <- dfInput t1_7_transformed <- dfInput %>% - qualification_transform_counts() + qualification_transform_counts(KRILabel = "AEs/Week") t1_7_analyzed <- t1_7_transformed %>% qualification_analyze_wilcoxon() @@ -27,11 +27,11 @@ test_that("AE assessment can return a correctly assessed data frame for the wilc mutate( ThresholdLow = .0001, ThresholdHigh = NA_integer_, - ThresholdCol = "PValue", + ThresholdCol = "Score", Flag = case_when( - PValue < 0.0001 ~ -1, - is.na(PValue) ~ NA_real_, - is.nan(PValue) ~ NA_real_, + Score < 0.0001 ~ -1, + is.na(Score) ~ NA_real_, + is.nan(Score) ~ NA_real_, TRUE ~ 0 ), median = median(Estimate), @@ -46,11 +46,10 @@ test_that("AE assessment can return a correctly assessed data frame for the wilc t1_7_summary <- t1_7_flagged %>% mutate( - Assessment = "AE", - Score = PValue + Assessment = "AE" ) %>% - select(SiteID, N, Score, Flag, Assessment) %>% - arrange(desc(abs(.data$Score))) %>% + select(SiteID, N, KRI, KRILabel, Score, ScoreLabel, Flag, Assessment) %>% + arrange(desc(abs(KRI))) %>% arrange(match(Flag, c(1, -1, 0))) diff --git a/tests/testthat/test_qual_T1_8.R b/tests/testthat/test_qual_T1_8.R index 85e9fa5a8..0d8b6e488 100644 --- a/tests/testthat/test_qual_T1_8.R +++ b/tests/testthat/test_qual_T1_8.R @@ -20,7 +20,7 @@ test_that("AE assessment can return a correctly assessed data frame for the wilc t1_8_input <- dfInput t1_8_transformed <- dfInput %>% - qualification_transform_counts() + qualification_transform_counts(KRILabel = "AEs/Week") t1_8_analyzed <- t1_8_transformed %>% qualification_analyze_wilcoxon() @@ -32,11 +32,11 @@ test_that("AE assessment can return a correctly assessed data frame for the wilc mutate( ThresholdLow = 0.0001, ThresholdHigh = NA_integer_, - ThresholdCol = "PValue", + ThresholdCol = "Score", Flag = case_when( - PValue < 0.0001 ~ -1, - is.na(PValue) ~ NA_real_, - is.nan(PValue) ~ NA_real_, + Score < 0.0001 ~ -1, + is.na(Score) ~ NA_real_, + is.nan(Score) ~ NA_real_, TRUE ~ 0 ), median = median(Estimate), @@ -51,11 +51,10 @@ test_that("AE assessment can return a correctly assessed data frame for the wilc t1_8_summary <- t1_8_flagged %>% mutate( - Assessment = "AE", - Score = PValue + Assessment = "AE" ) %>% - select(SiteID, N, Score, Flag, Assessment) %>% - arrange(desc(abs(Score))) %>% + select(SiteID, N, KRI, KRILabel, Score, ScoreLabel, Flag, Assessment) %>% + arrange(desc(abs(KRI))) %>% arrange(match(Flag, c(1, -1, 0))) t1_8 <- c(t1_8, diff --git a/tests/testthat/test_qual_T2_1.R b/tests/testthat/test_qual_T2_1.R index c0ebcdf11..6c2d92372 100644 --- a/tests/testthat/test_qual_T2_1.R +++ b/tests/testthat/test_qual_T2_1.R @@ -13,7 +13,7 @@ test_that("PD assessment can return a correctly assessed data frame for the pois t2_1_input <- dfInput t2_1_transformed <- dfInput %>% - qualification_transform_counts() + qualification_transform_counts(KRILabel = "PDs/Week") t2_1_analyzed <- t2_1_transformed %>% qualification_analyze_poisson() @@ -24,12 +24,12 @@ test_that("PD assessment can return a correctly assessed data frame for the pois mutate( ThresholdLow = -3, ThresholdHigh = 3, - ThresholdCol = "Residuals", + ThresholdCol = "Score", Flag = case_when( - Residuals < -3 ~ -1, - Residuals > 3 ~ 1, - is.na(Residuals) ~ NA_real_, - is.nan(Residuals) ~ NA_real_, + Score < -3 ~ -1, + Score > 3 ~ 1, + is.na(Score) ~ NA_real_, + is.nan(Score) ~ NA_real_, TRUE ~ 0 ), ) %>% @@ -37,11 +37,10 @@ test_that("PD assessment can return a correctly assessed data frame for the pois t2_1_summary <- t2_1_flagged %>% mutate( - Assessment = "PD", - Score = Residuals + Assessment = "PD" ) %>% - select(SiteID, N, Score, Flag, Assessment) %>% - arrange(desc(abs(Score))) %>% + select(SiteID, N, KRI, KRILabel, Score, ScoreLabel, Flag, Assessment) %>% + arrange(desc(abs(KRI))) %>% arrange(match(Flag, c(1, -1, 0))) t2_1 <- list( diff --git a/tests/testthat/test_qual_T2_2.R b/tests/testthat/test_qual_T2_2.R index 4236458cc..7cd050aa3 100644 --- a/tests/testthat/test_qual_T2_2.R +++ b/tests/testthat/test_qual_T2_2.R @@ -15,7 +15,7 @@ test_that("PD assessment can return a correctly assessed data frame for the pois t2_2_input <- dfInput t2_2_transformed <- dfInput %>% - qualification_transform_counts() + qualification_transform_counts(KRILabel = "PDs/Week") t2_2_analyzed <- t2_2_transformed %>% qualification_analyze_poisson() @@ -26,12 +26,12 @@ test_that("PD assessment can return a correctly assessed data frame for the pois mutate( ThresholdLow = -5, ThresholdHigh = 5, - ThresholdCol = "Residuals", + ThresholdCol = "Score", Flag = case_when( - Residuals < -5 ~ -1, - Residuals > 5 ~ 1, - is.na(Residuals) ~ NA_real_, - is.nan(Residuals) ~ NA_real_, + Score < -5 ~ -1, + Score > 5 ~ 1, + is.na(Score) ~ NA_real_, + is.nan(Score) ~ NA_real_, TRUE ~ 0 ), ) %>% @@ -39,11 +39,10 @@ test_that("PD assessment can return a correctly assessed data frame for the pois t2_2_summary <- t2_2_flagged %>% mutate( - Assessment = "PD", - Score = Residuals + Assessment = "PD" ) %>% - select(SiteID, N, Score, Flag, Assessment) %>% - arrange(desc(abs(Score))) %>% + select(SiteID, N, KRI, KRILabel, Score, ScoreLabel, Flag, Assessment) %>% + arrange(desc(abs(KRI))) %>% arrange(match(Flag, c(1, -1, 0))) t2_2 <- list( diff --git a/tests/testthat/test_qual_T2_3.R b/tests/testthat/test_qual_T2_3.R index 441443bfe..d39a70380 100644 --- a/tests/testthat/test_qual_T2_3.R +++ b/tests/testthat/test_qual_T2_3.R @@ -21,7 +21,7 @@ test_that("PD assessment can return a correctly assessed data frame for the pois t2_3_input <- dfInput t2_3_transformed <- dfInput %>% - qualification_transform_counts() + qualification_transform_counts(KRILabel = "PDs/Week") t2_3_analyzed <- t2_3_transformed %>% qualification_analyze_poisson() @@ -32,12 +32,12 @@ test_that("PD assessment can return a correctly assessed data frame for the pois mutate( ThresholdLow = -5, ThresholdHigh = 5, - ThresholdCol = "Residuals", + ThresholdCol = "Score", Flag = case_when( - Residuals < -5 ~ -1, - Residuals > 5 ~ 1, - is.na(Residuals) ~ NA_real_, - is.nan(Residuals) ~ NA_real_, + Score < -5 ~ -1, + Score > 5 ~ 1, + is.na(Score) ~ NA_real_, + is.nan(Score) ~ NA_real_, TRUE ~ 0 ), ) %>% @@ -45,11 +45,10 @@ test_that("PD assessment can return a correctly assessed data frame for the pois t2_3_summary <- t2_3_flagged %>% mutate( - Assessment = "PD", - Score = Residuals + Assessment = "PD" ) %>% - select(SiteID, N, Score, Flag, Assessment) %>% - arrange(desc(abs(Score))) %>% + select(SiteID, N, KRI, KRILabel, Score, ScoreLabel, Flag, Assessment) %>% + arrange(desc(abs(KRI))) %>% arrange(match(Flag, c(1, -1, 0))) t2_3 <- c(t2_3, diff --git a/tests/testthat/test_qual_T2_4.R b/tests/testthat/test_qual_T2_4.R index 66cd74b34..a9ad13bdb 100644 --- a/tests/testthat/test_qual_T2_4.R +++ b/tests/testthat/test_qual_T2_4.R @@ -13,7 +13,7 @@ test_that("AE assessment can return a correctly assessed data frame for the wilc t2_4_input <- dfInput t2_4_transformed <- dfInput %>% - qualification_transform_counts() + qualification_transform_counts(KRILabel = "PDs/Week") t2_4_analyzed <- t2_4_transformed %>% qualification_analyze_wilcoxon() @@ -25,11 +25,11 @@ test_that("AE assessment can return a correctly assessed data frame for the wilc mutate( ThresholdLow = 0.1, ThresholdHigh = NA_integer_, - ThresholdCol = "PValue", + ThresholdCol = "Score", Flag = case_when( - PValue < 0.1 ~ -1, - is.na(PValue) ~ NA_real_, - is.nan(PValue) ~ NA_real_, + Score < 0.1 ~ -1, + is.na(Score) ~ NA_real_, + is.nan(Score) ~ NA_real_, TRUE ~ 0 ), median = median(Estimate), @@ -44,11 +44,10 @@ test_that("AE assessment can return a correctly assessed data frame for the wilc t2_4_summary <- t2_4_flagged %>% mutate( - Assessment = "PD", - Score = PValue + Assessment = "PD" ) %>% - select(SiteID, N, Score, Flag, Assessment) %>% - arrange(desc(abs(Score))) %>% + select(SiteID, N, KRI, KRILabel, Score, ScoreLabel, Flag, Assessment) %>% + arrange(desc(abs(KRI))) %>% arrange(match(Flag, c(1, -1, 0))) t2_4 <- list( diff --git a/tests/testthat/test_qual_T2_5.R b/tests/testthat/test_qual_T2_5.R index 881db7512..15fdfe0d0 100644 --- a/tests/testthat/test_qual_T2_5.R +++ b/tests/testthat/test_qual_T2_5.R @@ -15,7 +15,7 @@ test_that("PD assessment can return a correctly assessed data frame for the wilc t2_5_input <- dfInput t2_5_transformed <- dfInput %>% - qualification_transform_counts() + qualification_transform_counts(KRILabel = "PDs/Week") t2_5_analyzed <- t2_5_transformed %>% qualification_analyze_wilcoxon() @@ -27,11 +27,11 @@ test_that("PD assessment can return a correctly assessed data frame for the wilc mutate( ThresholdLow = 0.0001, ThresholdHigh = NA_integer_, - ThresholdCol = "PValue", + ThresholdCol = "Score", Flag = case_when( - PValue < 0.0001 ~ -1, - is.na(PValue) ~ NA_real_, - is.nan(PValue) ~ NA_real_, + Score < 0.0001 ~ -1, + is.na(Score) ~ NA_real_, + is.nan(Score) ~ NA_real_, TRUE ~ 0 ), median = median(Estimate), @@ -46,11 +46,10 @@ test_that("PD assessment can return a correctly assessed data frame for the wilc t2_5_summary <- t2_5_flagged %>% mutate( - Assessment = "PD", - Score = PValue + Assessment = "PD" ) %>% - select(SiteID, N, Score, Flag, Assessment) %>% - arrange(desc(abs(Score))) %>% + select(SiteID, N, KRI, KRILabel, Score, ScoreLabel, Flag, Assessment) %>% + arrange(desc(abs(KRI))) %>% arrange(match(Flag, c(1, -1, 0))) t2_5 <- list( diff --git a/tests/testthat/test_qual_T2_6.R b/tests/testthat/test_qual_T2_6.R index e28184c32..bdc020d4e 100644 --- a/tests/testthat/test_qual_T2_6.R +++ b/tests/testthat/test_qual_T2_6.R @@ -27,7 +27,7 @@ test_that("PD assessment can return a correctly assessed data frame for the wilc t2_6_input <- dfInput t2_6_transformed <- dfInput %>% - qualification_transform_counts() + qualification_transform_counts(KRILabel = "PDs/Week") t2_6_analyzed <- t2_6_transformed %>% qualification_analyze_wilcoxon() @@ -39,11 +39,11 @@ test_that("PD assessment can return a correctly assessed data frame for the wilc mutate( ThresholdLow = 0.0001, ThresholdHigh = NA_integer_, - ThresholdCol = "PValue", + ThresholdCol = "Score", Flag = case_when( - PValue < 0.0001 ~ -1, - is.na(PValue) ~ NA_real_, - is.nan(PValue) ~ NA_real_, + Score < 0.0001 ~ -1, + is.na(Score) ~ NA_real_, + is.nan(Score) ~ NA_real_, TRUE ~ 0 ), median = median(Estimate), @@ -58,11 +58,10 @@ test_that("PD assessment can return a correctly assessed data frame for the wilc t2_6_summary <- t2_6_flagged %>% mutate( - Assessment = "PD", - Score = PValue + Assessment = "PD" ) %>% - select(SiteID, N, Score, Flag, Assessment) %>% - arrange(desc(abs(Score))) %>% + select(SiteID, N, KRI, KRILabel, Score, ScoreLabel, Flag, Assessment) %>% + arrange(desc(abs(KRI))) %>% arrange(match(Flag, c(1, -1, 0))) t2_6 <- c(t2_6, diff --git a/tests/testthat/test_qual_T3_1.R b/tests/testthat/test_qual_T3_1.R index e559043f9..117d590d7 100644 --- a/tests/testthat/test_qual_T3_1.R +++ b/tests/testthat/test_qual_T3_1.R @@ -11,10 +11,13 @@ test_that("IE assessment can return a correctly assessed data frame grouped by t t3_1_input <- dfInput t3_1_transformed <- dfInput %>% - qualification_transform_counts(exposureCol = NA) + qualification_transform_counts(exposureCol = NA, KRILabel = "# of Inclusion/Exclusion Issues") t3_1_analyzed <- t3_1_transformed %>% - mutate(Estimate = TotalCount) + mutate( + Score = TotalCount, + ScoreLabel = "# of Inclusion/Exclusion Issues" + ) class(t3_1_analyzed) <- c("tbl_df", "tbl", "data.frame") @@ -22,11 +25,11 @@ test_that("IE assessment can return a correctly assessed data frame grouped by t mutate( ThresholdLow = NA_real_, ThresholdHigh = 0.5, - ThresholdCol = "Estimate", + ThresholdCol = "Score", Flag = case_when( - Estimate > 0.5 ~ 1, - is.na(Estimate) ~ NA_real_, - is.nan(Estimate) ~ NA_real_, + Score > 0.5 ~ 1, + is.na(Score) ~ NA_real_, + is.nan(Score) ~ NA_real_, TRUE ~ 0 ), ) %>% @@ -34,11 +37,10 @@ test_that("IE assessment can return a correctly assessed data frame grouped by t t3_1_summary <- t3_1_flagged %>% mutate( - Assessment = "IE", - Score = Estimate + Assessment = "IE" ) %>% - select(SiteID, N, Score, Flag, Assessment) %>% - arrange(desc(abs(Score))) %>% + select(SiteID, N, KRI, KRILabel, Score, ScoreLabel,Flag, Assessment) %>% + arrange(desc(abs(KRI))) %>% arrange(match(Flag, c(1, -1, 0))) t3_1 <- list( diff --git a/tests/testthat/test_qual_T3_2.R b/tests/testthat/test_qual_T3_2.R index b304a5c9c..9450f988c 100644 --- a/tests/testthat/test_qual_T3_2.R +++ b/tests/testthat/test_qual_T3_2.R @@ -11,10 +11,13 @@ test_that("IE assessment can return a correctly assessed data frame grouped by t t3_1_input <- dfInput t3_1_transformed <- dfInput %>% - qualification_transform_counts(exposureCol = NA) + qualification_transform_counts(exposureCol = NA, KRILabel = "# of Inclusion/Exclusion Issues") t3_1_analyzed <- t3_1_transformed %>% - mutate(Estimate = TotalCount) + mutate( + Score = TotalCount, + ScoreLabel = "# of Inclusion/Exclusion Issues" + ) class(t3_1_analyzed) <- c("tbl_df", "tbl", "data.frame") @@ -22,11 +25,11 @@ test_that("IE assessment can return a correctly assessed data frame grouped by t mutate( ThresholdLow = NA_real_, ThresholdHigh = 0.5, - ThresholdCol = "Estimate", + ThresholdCol = "Score", Flag = case_when( - Estimate > 0.5 ~ 1, - is.na(Estimate) ~ NA_real_, - is.nan(Estimate) ~ NA_real_, + Score > 0.5 ~ 1, + is.na(Score) ~ NA_real_, + is.nan(Score) ~ NA_real_, TRUE ~ 0 ), ) %>% @@ -34,11 +37,10 @@ test_that("IE assessment can return a correctly assessed data frame grouped by t t3_1_summary <- t3_1_flagged %>% mutate( - Assessment = "IE", - Score = Estimate + Assessment = "IE" ) %>% - select(SiteID, N, Score, Flag, Assessment) %>% - arrange(desc(abs(Score))) %>% + select(SiteID, N, KRI, KRILabel, Score, ScoreLabel,Flag, Assessment) %>% + arrange(desc(abs(KRI))) %>% arrange(match(Flag, c(1, -1, 0))) t3_1 <- list( diff --git a/tests/testthat/test_qual_T3_3.R b/tests/testthat/test_qual_T3_3.R index bc95ec474..fa19af20a 100644 --- a/tests/testthat/test_qual_T3_3.R +++ b/tests/testthat/test_qual_T3_3.R @@ -22,10 +22,13 @@ test_that("IE assessment can return a correctly assessed data frame grouped by t t3_3_input <- dfInput t3_3_transformed <- dfInput %>% - qualification_transform_counts(exposureCol = NA) + qualification_transform_counts(exposureCol = NA, KRILabel = "# of Inclusion/Exclusion Issues") t3_3_analyzed <- t3_3_transformed %>% - mutate(Estimate = TotalCount) + mutate( + Score = TotalCount, + ScoreLabel = "# of Inclusion/Exclusion Issues" + ) class(t3_3_analyzed) <- c("tbl_df", "tbl", "data.frame") @@ -33,11 +36,11 @@ test_that("IE assessment can return a correctly assessed data frame grouped by t mutate( ThresholdLow = NA_real_, ThresholdHigh = 0.5, - ThresholdCol = "Estimate", + ThresholdCol = "Score", Flag = case_when( - Estimate > 0.5 ~ 1, - is.na(Estimate) ~ NA_real_, - is.nan(Estimate) ~ NA_real_, + Score > 0.5 ~ 1, + is.na(Score) ~ NA_real_, + is.nan(Score) ~ NA_real_, TRUE ~ 0 ), ) %>% @@ -45,11 +48,10 @@ test_that("IE assessment can return a correctly assessed data frame grouped by t t3_3_summary <- t3_3_flagged %>% mutate( - Assessment = "IE", - Score = Estimate + Assessment = "IE" ) %>% - select(SiteID, N, Score, Flag, Assessment) %>% - arrange(desc(abs(Score))) %>% + select(SiteID, N, KRI, KRILabel, Score, ScoreLabel, Flag, Assessment) %>% + arrange(desc(abs(KRI))) %>% arrange(match(Flag, c(1, -1, 0))) t3_3 <- c(t3_3, diff --git a/tests/testthat/test_qual_T4_1.R b/tests/testthat/test_qual_T4_1.R index 340c8f90f..87e54caa9 100644 --- a/tests/testthat/test_qual_T4_1.R +++ b/tests/testthat/test_qual_T4_1.R @@ -11,10 +11,13 @@ test_that("Consent assessment can return a correctly assessed data frame grouped t4_1_input <- dfInput t4_1_transformed <- dfInput %>% - qualification_transform_counts(exposureCol = NA) + qualification_transform_counts(exposureCol = NA, KRILabel = "Total Number of Consent Issues") t4_1_analyzed <- t4_1_transformed %>% - mutate(Estimate = TotalCount) + mutate( + Score = TotalCount, + ScoreLabel = "Total Number of Consent Issues" + ) class(t4_1_analyzed) <- c("tbl_df", "tbl", "data.frame") @@ -22,11 +25,11 @@ test_that("Consent assessment can return a correctly assessed data frame grouped mutate( ThresholdLow = NA_real_, ThresholdHigh = 0.5, - ThresholdCol = "Estimate", + ThresholdCol = "Score", Flag = case_when( - Estimate > 0.5 ~ 1, - is.na(Estimate) ~ NA_real_, - is.nan(Estimate) ~ NA_real_, + Score > 0.5 ~ 1, + is.na(Score) ~ NA_real_, + is.nan(Score) ~ NA_real_, TRUE ~ 0 ), ) %>% @@ -34,11 +37,10 @@ test_that("Consent assessment can return a correctly assessed data frame grouped t4_1_summary <- t4_1_flagged %>% mutate( - Assessment = "Consent", - Score = Estimate + Assessment = "Consent" ) %>% - select(SiteID, N, Score, Flag, Assessment) %>% - arrange(desc(abs(Score))) %>% + select(SiteID, N, KRI, KRILabel, Score, ScoreLabel,Flag, Assessment) %>% + arrange(desc(abs(KRI))) %>% arrange(match(Flag, c(1, -1, 0))) t4_1 <- list( diff --git a/tests/testthat/test_qual_T4_2.R b/tests/testthat/test_qual_T4_2.R index 8b10e18f6..71c7e10a0 100644 --- a/tests/testthat/test_qual_T4_2.R +++ b/tests/testthat/test_qual_T4_2.R @@ -11,10 +11,13 @@ test_that("Consent assessment can return a correctly assessed data frame grouped t4_2_input <- dfInput t4_2_transformed <- dfInput %>% - qualification_transform_counts(exposureCol = NA) + qualification_transform_counts(exposureCol = NA, KRILabel = "Total Number of Consent Issues") t4_2_analyzed <- t4_2_transformed %>% - mutate(Estimate = TotalCount) + mutate( + Score = TotalCount, + ScoreLabel = "Total Number of Consent Issues" + ) class(t4_2_analyzed) <- c("tbl_df", "tbl", "data.frame") @@ -22,11 +25,11 @@ test_that("Consent assessment can return a correctly assessed data frame grouped mutate( ThresholdLow = NA_real_, ThresholdHigh = 0.5, - ThresholdCol = "Estimate", + ThresholdCol = "Score", Flag = case_when( - Estimate > 0.5 ~ 1, - is.na(Estimate) ~ NA_real_, - is.nan(Estimate) ~ NA_real_, + Score > 0.5 ~ 1, + is.na(Score) ~ NA_real_, + is.nan(Score) ~ NA_real_, TRUE ~ 0 ), ) %>% @@ -34,11 +37,10 @@ test_that("Consent assessment can return a correctly assessed data frame grouped t4_2_summary <- t4_2_flagged %>% mutate( - Assessment = "Consent", - Score = Estimate + Assessment = "Consent" ) %>% - select(SiteID, N, Score, Flag, Assessment) %>% - arrange(desc(abs(Score))) %>% + select(SiteID, N, KRI, KRILabel, Score, ScoreLabel,Flag, Assessment) %>% + arrange(desc(abs(KRI))) %>% arrange(match(Flag, c(1, -1, 0))) t4_2 <- list( From f54bae98b040b0b7e119601d02c09f731e29cc61 Mon Sep 17 00:00:00 2001 From: Matt Roumaya Date: Fri, 10 Jun 2022 16:54:16 +0000 Subject: [PATCH 57/87] report sort --- inst/report/studySummary.rmd | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/inst/report/studySummary.rmd b/inst/report/studySummary.rmd index 9dc7aad06..69bda34cf 100644 --- a/inst/report/studySummary.rmd +++ b/inst/report/studySummary.rmd @@ -149,11 +149,8 @@ for (assessment in results){ details <- assessment$dfFlagged %>% filter(Flag !=0) %>% - {if("TotalCount" %in% names(.)) arrange(., match(TotalCount, flagged$Score)) else .} %>% - {if("PValue" %in% names(.)) arrange(., match(PValue, flagged$Score)) else .} %>% - {if("Residuals" %in% names(.)) arrange(., match(Residuals, flagged$Score)) else .} + arrange(., match(SiteID, flagged$SiteID)) - if(nrow(details)>0){ details%>% kbl(escape=FALSE) %>% From 4334b2f0952662cc6b7e94223bfe76c6feaf05c0 Mon Sep 17 00:00:00 2001 From: Matt Roumaya Date: Fri, 10 Jun 2022 17:55:24 +0000 Subject: [PATCH 58/87] add Analyze_Identity() to pkgdown index --- _pkgdown.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/_pkgdown.yml b/_pkgdown.yml index 4b24891cb..a2276fa7b 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -23,6 +23,7 @@ reference: desc: Conduct statistical analysis based on input data - contents: - Analyze_Chisq + - Analyze_Identity - Analyze_Fisher - Analyze_Poisson - Analyze_Wilcoxon From 2185c2b4b978043248963b6d897413966be0b0d6 Mon Sep 17 00:00:00 2001 From: Spencer Childress Date: Fri, 10 Jun 2022 14:56:05 -0400 Subject: [PATCH 59/87] add map_raw helper functions --- R/tests-map_raw_helpers.R | 49 +++++++++++++++ tests/testthat/_snaps/IE_Map_Raw.md | 91 +++++++++++++++++++++++++++ tests/testthat/test_AE_Map_Raw.R | 8 +++ tests/testthat/test_Consent_Map_Raw.R | 8 +++ tests/testthat/test_IE_Map_Raw.R | 14 ++++- tests/testthat/test_PD_Map_Raw.R | 8 +++ 6 files changed, 176 insertions(+), 2 deletions(-) create mode 100644 R/tests-map_raw_helpers.R diff --git a/R/tests-map_raw_helpers.R b/R/tests-map_raw_helpers.R new file mode 100644 index 000000000..8a85ce48e --- /dev/null +++ b/R/tests-map_raw_helpers.R @@ -0,0 +1,49 @@ +test_incorrect_inputs <- function( + map_function, + df_domain, + df_name, + dfSUBJ, + spec +) { + # incorrect inputs throw errors ------------------------------------------- + test_that("incorrect inputs throw errors", { + dfs <- list( + dfSUBJ = dfSUBJ + ) + dfs[[ df_name ]] <- df_domain + + # empty data frames + expect_snapshot(map_function(dfs = imap(dfs, ~ list()), bQuiet = F)) + expect_snapshot(map_function(dfs = imap(dfs, ~ if (.y == 'dfSUBJ') list() else .x), bQuiet = F)) + expect_snapshot(map_function(dfs = imap(dfs, ~ if (.y == df_name) list() else .x), bQuiet = F)) + + # mistyped data frames + expect_snapshot(map_function(dfs = imap(dfs, ~ 'Hi Mom'), bQuiet = F)) + expect_snapshot(map_function(dfs = imap(dfs, ~ 9999), bQuiet = F)) + expect_snapshot(map_function(dfs = imap(dfs, ~ TRUE), bQuiet = F)) + + # empty mapping + expect_snapshot(map_function(dfs = imap(dfs, ~ .x), lMapping = list(), bQuiet = F)) + + # missing variables + for (domain in names(spec)) { + required_columns <- spec[[ domain ]]$vRequired + for (column in required_columns) { + dfs_edited <- dfs + dfs_edited[[ domain ]][[ column ]] <- NULL + print(names(dfs_edited[[ domain ]])) + expect_snapshot( + map_function( + dfs = dfs_edited, + bQuiet = F + ) + ) + } + } + + # duplicate subject IDs in subject-level data frame + dfs_edited <- dfs + dfs$dfSUBJ <- dfs$dfSUBJ %>% bind_rows(head(., 1)) + expect_snapshot(map_function(dfs = dfs_edited, bQuiet = F)) + }) +} diff --git a/tests/testthat/_snaps/IE_Map_Raw.md b/tests/testthat/_snaps/IE_Map_Raw.md index 0771fd8d4..a1060ce84 100644 --- a/tests/testthat/_snaps/IE_Map_Raw.md +++ b/tests/testthat/_snaps/IE_Map_Raw.md @@ -21,6 +21,42 @@ Output NULL +--- + + Code + IE_Map_Raw(dfs = list(dfIE = dfIE, dfSUBJ = list()), bQuiet = F) + Message + + -- Checking Input Data for `IE_Map_Raw()` -- + + x df is not a data.frame() + x the following columns not found in df: SubjectID, SiteID + x NA check not run + x Empty Value check not run + x Unique Column Check not run + ! Issues found for `IE_Map_Raw()` + ! `IE_Map_Raw()` did not run because of failed check. + Output + NULL + +--- + + Code + IE_Map_Raw(dfs = list(dfIE = list(), dfSUBJ = dfSUBJ), bQuiet = F) + Message + + -- Checking Input Data for `IE_Map_Raw()` -- + + x df is not a data.frame() + x the following columns not found in df: SubjectID, IE_CATEGORY, IE_VALUE + x NA check not run + x Empty Value check not run + x Unique Column Check not run + ! Issues found for `IE_Map_Raw()` + ! `IE_Map_Raw()` did not run because of failed check. + Output + NULL + --- Code @@ -44,6 +80,25 @@ Output NULL +--- + + Code + IE_Map_Raw(dfs = list(dfIE = dfIE, dfSUBJ = dfSUBJ), lMapping = list(), bQuiet = F) + Message + + -- Checking Input Data for `IE_Map_Raw()` -- + + x "mapping" does not contain required parameters: strIDCol, strCategoryCol, strValueCol + x mapping is not a list() + x Non-character column names found in mapping: + x "mapping" does not contain required parameters: strIDCol, strSiteCol + x mapping is not a list() + x Non-character column names found in mapping: + ! Issues found for `IE_Map_Raw()` + ! `IE_Map_Raw()` did not run because of failed check. + Output + NULL + --- Code @@ -98,6 +153,42 @@ Output NULL +--- + + Code + IE_Map_Raw(dfs = list(dfIE = dfIE, dfSUBJ = dfSUBJ %>% select(-SubjectID)), + bQuiet = F) + Message + + -- Checking Input Data for `IE_Map_Raw()` -- + + x the following columns not found in df: SubjectID + x NA check not run + x Empty Value check not run + x Unique Column Check not run + ! Issues found for `IE_Map_Raw()` + ! `IE_Map_Raw()` did not run because of failed check. + Output + NULL + +--- + + Code + IE_Map_Raw(dfs = list(dfIE = dfIE, dfSUBJ = dfSUBJ %>% select(-SiteID)), + bQuiet = F) + Message + + -- Checking Input Data for `IE_Map_Raw()` -- + + x the following columns not found in df: SiteID + x NA check not run + x Empty Value check not run + x Unique Column Check not run + ! Issues found for `IE_Map_Raw()` + ! `IE_Map_Raw()` did not run because of failed check. + Output + NULL + --- Code diff --git a/tests/testthat/test_AE_Map_Raw.R b/tests/testthat/test_AE_Map_Raw.R index d597a34e6..d73711eef 100644 --- a/tests/testthat/test_AE_Map_Raw.R +++ b/tests/testthat/test_AE_Map_Raw.R @@ -5,19 +5,27 @@ test_that("output is created as expected", { data <- AE_Map_Raw(dfs = list(dfAE = dfAE, dfSUBJ = dfSUBJ)) expect_true(is.data.frame(data)) expect_equal(names(data), c("SubjectID", "SiteID", "Count", "Exposure", "Rate")) + expect_type(data$SubjectID, "character") + expect_type(data$SiteID, "character") + expect_true(class(data$Count) %in% c("double", "integer", "numeric")) }) # incorrect inputs throw errors ------------------------------------------- test_that("incorrect inputs throw errors", { + # empty data frames expect_snapshot(AE_Map_Raw(dfs = list(dfAE = list(), dfSUBJ = list()), bQuiet = F)) expect_snapshot(AE_Map_Raw(dfs = list(dfAE = dfAE, dfSUBJ = list()), bQuiet = F)) expect_snapshot(AE_Map_Raw(dfs = list(dfAE = list(), dfSUBJ = dfSUBJ), bQuiet = F)) + # mistyped data frames expect_snapshot(AE_Map_Raw(dfs = list(dfAE = "Hi", dfSUBJ = "Mom"), bQuiet = F)) + # empty mapping expect_snapshot(AE_Map_Raw(dfs = list(dfAE = dfAE, dfSUBJ = dfSUBJ), lMapping = list(), bQuiet = F)) + # missing variables expect_snapshot(AE_Map_Raw(dfs = list(dfAE = dfAE %>% select(-SubjectID), dfSUBJ = dfSUBJ), bQuiet = F)) expect_snapshot(AE_Map_Raw(dfs = list(dfAE = dfAE, dfSUBJ = dfSUBJ %>% select(-SiteID)), bQuiet = F)) expect_snapshot(AE_Map_Raw(dfs = list(dfAE = dfAE, dfSUBJ = dfSUBJ %>% select(-SubjectID)), bQuiet = F)) expect_snapshot(AE_Map_Raw(dfs = list(dfAE = dfAE, dfSUBJ = dfSUBJ %>% select(-TimeOnTreatment)), bQuiet = F)) + # duplicate subject IDs expect_snapshot(AE_Map_Raw(dfs = list(dfAE = dfAE, dfSUBJ = bind_rows(dfSUBJ, head(dfSUBJ, 1))), bQuiet = F)) }) diff --git a/tests/testthat/test_Consent_Map_Raw.R b/tests/testthat/test_Consent_Map_Raw.R index 8e2771082..3426c131a 100644 --- a/tests/testthat/test_Consent_Map_Raw.R +++ b/tests/testthat/test_Consent_Map_Raw.R @@ -5,21 +5,29 @@ test_that("output created as expected ", { data <- Consent_Map_Raw(dfs = list(dfCONSENT = dfCONSENT, dfSUBJ = dfSUBJ)) expect_true(is.data.frame(data)) expect_equal(names(data), c("SubjectID", "SiteID", "Count")) + expect_type(data$SubjectID, "character") + expect_type(data$SiteID, "character") + expect_true(class(data$Count) %in% c("double", "integer", "numeric")) }) # incorrect inputs throw errors ------------------------------------------- test_that("incorrect inputs throw errors", { + # empty data frames expect_snapshot(Consent_Map_Raw(dfs = list(dfCONSENT = list(), dfSUBJ = list()), bQuiet = F)) expect_snapshot(Consent_Map_Raw(dfs = list(dfCONSENT = dfCONSENT, dfSUBJ = list()), bQuiet = F)) expect_snapshot(Consent_Map_Raw(dfs = list(dfCONSENT = list(), dfSUBJ = dfSUBJ), bQuiet = F)) + # mistyped data frames expect_snapshot(Consent_Map_Raw(dfs = list(dfCONSENT = "Hi", dfSUBJ = "Mom"), bQuiet = F)) + # empty mapping expect_snapshot(Consent_Map_Raw(dfs = list(dfCONSENT = dfCONSENT, dfSUBJ = dfSUBJ), lMapping = list(), bQuiet = F)) + # missing variables expect_snapshot(Consent_Map_Raw(dfs = list(dfCONSENT = dfCONSENT %>% select(-CONSENT_DATE), dfSUBJ = dfSUBJ), bQuiet = F)) expect_snapshot(Consent_Map_Raw(dfs = list(dfCONSENT = dfCONSENT %>% select(-CONSENT_TYPE), dfSUBJ = dfSUBJ), bQuiet = F)) expect_snapshot(Consent_Map_Raw(dfs = list(dfCONSENT = dfCONSENT %>% select(-CONSENT_VALUE), dfSUBJ = dfSUBJ), bQuiet = F)) expect_snapshot(Consent_Map_Raw(dfs = list(dfCONSENT = dfCONSENT, dfSUBJ = dfSUBJ %>% select(-SubjectID)), bQuiet = F)) expect_snapshot(Consent_Map_Raw(dfs = list(dfCONSENT = dfCONSENT, dfSUBJ = dfSUBJ %>% select(-SiteID)), bQuiet = F)) expect_snapshot(Consent_Map_Raw(dfs = list(dfCONSENT = dfCONSENT, dfSUBJ = dfSUBJ %>% select(-RandDate)), bQuiet = F)) + # duplicate subject IDs expect_snapshot(Consent_Map_Raw(dfs = list(dfCONSENT = dfCONSENT, dfSUBJ = bind_rows(dfSUBJ, head(dfSUBJ, 1))), bQuiet = F)) }) diff --git a/tests/testthat/test_IE_Map_Raw.R b/tests/testthat/test_IE_Map_Raw.R index 386ff5cce..19a104194 100644 --- a/tests/testthat/test_IE_Map_Raw.R +++ b/tests/testthat/test_IE_Map_Raw.R @@ -1,4 +1,6 @@ source(testthat::test_path("testdata/data.R")) +spec <- yaml::read_yaml(paste0(here::here(), '/inst/specs/IE_Map_Raw.yaml')) +print(spec) # output is created as expected ------------------------------------------- test_that("output created as expected", { @@ -10,15 +12,23 @@ test_that("output created as expected", { expect_true(class(data$Count) %in% c("double", "integer", "numeric")) }) - - # incorrect inputs throw errors ------------------------------------------- test_that("incorrect inputs throw errors", { + # empty data frames expect_snapshot(IE_Map_Raw(dfs = list(dfIE = list(), dfSUBJ = list()), bQuiet = F)) + expect_snapshot(IE_Map_Raw(dfs = list(dfIE = dfIE, dfSUBJ = list()), bQuiet = F)) + expect_snapshot(IE_Map_Raw(dfs = list(dfIE = list(), dfSUBJ = dfSUBJ), bQuiet = F)) + # mistyped data frames expect_snapshot(IE_Map_Raw(dfs = list(dfIE = "Hi", dfSUBJ = "Mom"), bQuiet = F)) + # empty mapping + expect_snapshot(IE_Map_Raw(dfs = list(dfIE = dfIE, dfSUBJ = dfSUBJ), lMapping = list(), bQuiet = F)) + # missing variables expect_snapshot(IE_Map_Raw(dfs = list(dfIE = dfIE %>% select(-SubjectID), dfSUBJ = dfSUBJ), bQuiet = F)) expect_snapshot(IE_Map_Raw(dfs = list(dfIE = dfIE %>% select(-IE_CATEGORY), dfSUBJ = dfSUBJ), bQuiet = F)) expect_snapshot(IE_Map_Raw(dfs = list(dfIE = dfIE %>% select(-IE_VALUE), dfSUBJ = dfSUBJ), bQuiet = F)) + expect_snapshot(IE_Map_Raw(dfs = list(dfIE = dfIE, dfSUBJ = dfSUBJ %>% select(-SubjectID)), bQuiet = F)) + expect_snapshot(IE_Map_Raw(dfs = list(dfIE = dfIE, dfSUBJ = dfSUBJ %>% select(-SiteID)), bQuiet = F)) + # duplicate subject IDs expect_snapshot(IE_Map_Raw(dfs = list(dfIE = dfIE, dfSUBJ = bind_rows(dfSUBJ, head(dfSUBJ, 1))), bQuiet = F)) }) diff --git a/tests/testthat/test_PD_Map_Raw.R b/tests/testthat/test_PD_Map_Raw.R index 74847c397..dc08afbdc 100644 --- a/tests/testthat/test_PD_Map_Raw.R +++ b/tests/testthat/test_PD_Map_Raw.R @@ -5,19 +5,27 @@ test_that("output is created as expected", { data <- PD_Map_Raw(dfs = list(dfPD = dfPD, dfSUBJ = dfSUBJ)) expect_true(is.data.frame(data)) expect_equal(names(data), c("SubjectID", "SiteID", "Count", "Exposure", "Rate")) + expect_type(data$SubjectID, "character") + expect_type(data$SiteID, "character") + expect_true(class(data$Count) %in% c("double", "integer", "numeric")) }) # incorrect inputs throw errors ------------------------------------------- test_that("incorrect inputs throw errors", { + # empty data frames expect_snapshot(PD_Map_Raw(dfs = list(dfPD = list(), dfSUBJ = list()), bQuiet = F)) expect_snapshot(PD_Map_Raw(dfs = list(dfPD = dfPD, dfSUBJ = list()), bQuiet = F)) expect_snapshot(PD_Map_Raw(dfs = list(dfPD = list(), dfSUBJ = dfSUBJ), bQuiet = F)) + # mistyped data frames expect_snapshot(PD_Map_Raw(dfs = list(dfPD = "Hi", dfSUBJ = "Mom"), bQuiet = F)) + # empty mapping expect_snapshot(PD_Map_Raw(dfs = list(dfPD = dfPD, dfSUBJ = dfSUBJ), lMapping = list(), bQuiet = F)) + # missing variables expect_snapshot(PD_Map_Raw(dfs = list(dfPD = dfPD %>% select(-SubjectID), dfSUBJ = dfSUBJ), bQuiet = F)) expect_snapshot(PD_Map_Raw(dfs = list(dfPD = dfPD, dfSUBJ = dfSUBJ %>% select(-SubjectID)), bQuiet = F)) expect_snapshot(PD_Map_Raw(dfs = list(dfPD = dfPD, dfSUBJ = dfSUBJ %>% select(-SiteID)), bQuiet = F)) expect_snapshot(PD_Map_Raw(dfs = list(dfPD = dfPD, dfSUBJ = dfSUBJ %>% select(-TimeOnStudy)), bQuiet = F)) + # duplicate subject IDs expect_snapshot(PD_Map_Raw(dfs = list(dfPD = dfPD, dfSUBJ = bind_rows(dfSUBJ, head(dfSUBJ, 1))), bQuiet = F)) }) From c0d93db749c3ab11d0ed8768d760e73cd3a88cd7 Mon Sep 17 00:00:00 2001 From: Spencer Childress Date: Fri, 10 Jun 2022 15:52:24 -0400 Subject: [PATCH 60/87] todo: finish modularizing map_raw unit tests --- R/tests-map_raw_helpers.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/tests-map_raw_helpers.R b/R/tests-map_raw_helpers.R index 8a85ce48e..7477370a8 100644 --- a/R/tests-map_raw_helpers.R +++ b/R/tests-map_raw_helpers.R @@ -1,3 +1,4 @@ +# TODO: finish modularizing map_raw unit tests test_incorrect_inputs <- function( map_function, df_domain, From c36e53aeb4b2e1dff8873698c2ddab05f2049c77 Mon Sep 17 00:00:00 2001 From: Matt Roumaya Date: Fri, 10 Jun 2022 21:44:52 +0000 Subject: [PATCH 61/87] update data pipeline vignette --- vignettes/DataPipeline.Rmd | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/vignettes/DataPipeline.Rmd b/vignettes/DataPipeline.Rmd index 7b2ee73a1..25783ad2a 100644 --- a/vignettes/DataPipeline.Rmd +++ b/vignettes/DataPipeline.Rmd @@ -79,7 +79,7 @@ Each input data specification lists the data domains required for the function a - `vUniqueCols` - list of column parameters that should not contain duplicate values - `vNACols` - list of column parameters where NA and empty string values are acceptable. -The specification for the AE mapping function (`inst/mapping/AE_Map_Raw.yaml`) is shown below: +The specification for the AE mapping function (`inst/specs/AE_Map_Raw.yaml`) is shown below: ``` dfAE: @@ -113,7 +113,7 @@ list( ) ``` -Note that `Study_Assess()` is designed to share a `mapping` object across multiple assessments. The default mapping is saved as a `list` in {clindata} (`clindata::mapping_rawplus`), but users can also create a custom mapping object for thier use cases by making a custom YAML file, or by creating or modifying a list such as `clindata::mapping_rawplus`. +Note that `Study_Assess()` is designed to share a `mapping` object across multiple assessments. The default mapping is saved as a YAML file (`inst/mappings/mapping_rawplus.yaml`), but users can also create a custom mapping object for their use cases by making a custom YAML file, or by creating or modifying a `list` like that returned by `yaml::read_yaml(system.file("mappings", "mapping_rawplus.yaml", package = "gsm"))`. ## Assessment Workflow Metadata @@ -128,7 +128,7 @@ The `lAssessment` object is a named list of metadata defining how each assessmen - `workflow[]$output`: Specifies the output data from the workflow step; can be used as an input in the next step in the workflow. - `workflow[]$params`: Specifies parameters to be passed to the function. -For example, the assessment for the AE (`inst/assessments/ae.yaml`) is shown below: +For example, the workflow for the AE assessment (`inst/assessments/ae.yaml`) is shown below: ``` tags: From 00d2aad8816b85898ed8490b3e9f3afa336cb4bd Mon Sep 17 00:00:00 2001 From: Matt Roumaya <40671730+mattroumaya@users.noreply.github.com> Date: Mon, 13 Jun 2022 09:12:31 -0400 Subject: [PATCH 62/87] Update R/Analyze_Fisher.R Co-authored-by: Jeremy Wildfire --- R/Analyze_Fisher.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/Analyze_Fisher.R b/R/Analyze_Fisher.R index a061cecac..63dc5bc9a 100644 --- a/R/Analyze_Fisher.R +++ b/R/Analyze_Fisher.R @@ -26,7 +26,7 @@ #' #' @examples #' dfInput <- Disp_Map(dfDisp = safetyData::adam_adsl, strCol = "DCREASCD", strReason = "Adverse Event") -#' dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strKRILabel = "Discontinuations due to AE/Month") +#' dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strKRILabel = "Discontinuations due to AE") #' dfAnalyzed <- Analyze_Fisher(dfTransformed) #' #' @import dplyr From f78815e8b572b59a67ab768d23cb710bb1f0dce8 Mon Sep 17 00:00:00 2001 From: Matt Roumaya Date: Mon, 13 Jun 2022 14:12:43 +0000 Subject: [PATCH 63/87] update cookbook --- vignettes/Cookbook.Rmd | 393 ++++++++++++++++++++--------------------- 1 file changed, 188 insertions(+), 205 deletions(-) diff --git a/vignettes/Cookbook.Rmd b/vignettes/Cookbook.Rmd index 49d691767..a1b925281 100644 --- a/vignettes/Cookbook.Rmd +++ b/vignettes/Cookbook.Rmd @@ -17,7 +17,7 @@ knitr::opts_chunk$set( # Intro -This vignette contains a series of examples showing how to run analysis workflows for the {gsm} package using sample data from {clindata}. +This vignette contains a series of examples showing how to run analysis workflows for the {gsm} package using sample data from {clindata}. For more information on of the {gsm} package see the [package homepage](https://silver-potato-cfe8c2fb.pages.github.io/). The [Data Pipeline Vignette](https://github.com/Gilead-BioStats/gsm/wiki/Data-Pipeline-Vignette) provides additional technical details including data specifications, and other technical details. @@ -27,234 +27,220 @@ For more information on of the {gsm} package see the [package homepage](https:// Run the following: -``` -## Install devtools -install.packages('devtools') + ## Install devtools + install.packages('devtools') -## Install and load sample raw data -devtools::install_github("Gilead-BioStats/clindata", ref = "main") -library(clindata) + ## Install and load sample raw data + devtools::install_github("Gilead-BioStats/clindata", ref = "main") + library(clindata) -## Install and load sample SDTM and AdAM data -install.packages('safetyData') -library(safetyData) + ## Install and load sample SDTM and AdAM data + install.packages('safetyData') + library(safetyData) -## Install and load gsm -devtools::install_github("Gilead-BioStats/gsm", ref = "main") -library(gsm) -``` -To use the most recent development version from GitHub, run: -``` -devtools::install_github("Gilead-BioStats/gsm", ref = "dev") -``` + ## Install and load gsm + devtools::install_github("Gilead-BioStats/gsm", ref = "main") + library(gsm) + +To use the most recent development version from GitHub, run: + + devtools::install_github("Gilead-BioStats/gsm", ref = "dev") ## Example 1 - Running a Single Assessment -All assessments can be run as standalone processes that create several useful data summaries and a visualization. +All assessments can be run as standalone processes that create several useful data summaries and a visualization. -Running a single assessment is a 2-step process: +Running a single assessment is a 2-step process: -1. Map Domain-level data to the input data standard for the selected assessment (e.g. `dfInput <- AE_Map_Raw()`) -2. Run the assessment (e.g. `ae_assess <- AE_Assess(dfInput)`) +1. Map Domain-level data to the input data standard for the selected assessment (e.g. `dfInput <- AE_Map_Raw()`) +2. Run the assessment (e.g. `ae_assess <- AE_Assess(dfInput)`) Putting this all together for the AE Assessment looks like this: -``` -library(clindata) -library(safetyData) -library(gsm) -# Map Domain-level data to the input data standard for the selected assessment -dfInput <- AE_Map_Raw() + library(clindata) + library(safetyData) + library(gsm) -# Run the assessment -ae_assess <- AE_Assess(dfInput) + # Map Domain-level data to the input data standard for the selected assessment + dfInput <- AE_Map_Raw() -# Run the assessment using the Wilcoxon statistical model -ae_assess_wilcoxon <- AE_Assess(dfInput, strMethod = "wilcoxon") -``` + # Run the assessment + ae_assess <- AE_Assess(dfInput) + + # Run the assessment using the Wilcoxon statistical model + ae_assess_wilcoxon <- AE_Assess(dfInput, strMethod = "wilcoxon") Each assessment has representative examples in the help files - the example above was adapted from the example in `?AE_Assess`. ## Example 2 - Running a Single Assessment on non-standard data -Next, let's run the same assessment above, but this time using non-standard data. {gsm} is configured to accept Raw+ data by default, so for non-standard data, the user must perform some data transformations to pass to a mapping function. -``` -library(gsm) -library(clindata) -library(dplyr) - -# Configure raw AE data for correct input for dfAE -dfAE <- clindata::raw_ae %>% - select( - SubjectID = SUBJID, - AE_SERIOUS = AESER - ) %>% - mutate( - AE_TE_FLAG = sample(c(TRUE, FALSE), n(), replace = TRUE), - AE_GRADE = sample(1:4, n(), replace = TRUE) - ) %>% - filter( - !is.na(SubjectID) & SubjectID != "" - ) - -# Configure raw subject-level data for correct input for dfSUBJ -dfSUBJ <- clindata::CreateSUBJ( - dfDm = clindata::raw_dm, - dfIXRSrand = clindata::raw_iwrsrand, - dfEx = clindata::raw_ex, - dfVisit = clindata::raw_visdt, - dfStud = clindata::raw_studcomp, - dfSdrg = clindata::raw_sdrgcomp -) %>% - filter( - !is.na(TimeOnTreatment), - !is.na(SubjectID) & SubjectID != "" - ) - -# Map Domain-level data to the input data standard for the selected assessment -dfInput <- AE_Map_Raw( - dfs = list(dfAE = dfAE, dfSUBJ = dfSUBJ), - bQuiet = FALSE -) +Next, let's run the same assessment above, but this time using non-standard data. {gsm} is configured to accept Raw+ data by default, so for non-standard data, the user must perform some data transformations to pass to a mapping function. + + library(gsm) + library(clindata) + library(dplyr) + + # Configure raw AE data for correct input for dfAE + dfAE <- clindata::raw_ae %>% + select( + SubjectID = SUBJID, + AE_SERIOUS = AESER + ) %>% + mutate( + AE_TE_FLAG = sample(c(TRUE, FALSE), n(), replace = TRUE), + AE_GRADE = sample(1:4, n(), replace = TRUE) + ) %>% + filter( + !is.na(SubjectID) & SubjectID != "" + ) + + # Configure raw subject-level data for correct input for dfSUBJ + dfSUBJ <- clindata::CreateSUBJ( + dfDm = clindata::raw_dm, + dfIXRSrand = clindata::raw_iwrsrand, + dfEx = clindata::raw_ex, + dfVisit = clindata::raw_visdt, + dfStud = clindata::raw_studcomp, + dfSdrg = clindata::raw_sdrgcomp + ) %>% + filter( + !is.na(TimeOnTreatment), + !is.na(SubjectID) & SubjectID != "" + ) + + # Map Domain-level data to the input data standard for the selected assessment + dfInput <- AE_Map_Raw( + dfs = list(dfAE = dfAE, dfSUBJ = dfSUBJ), + bQuiet = FALSE + ) + + # Run the assessment + ae_assess <- AE_Assess(dfInput) -# Run the assessment -ae_assess <- AE_Assess(dfInput) -``` ### Troubleshooting Tips -- When using non-standard data, it will be helpful to reference the data specification for required column names for a given assessment. Run `?AE_Map_Raw` to view the documentation, and consult the **Data specification** section. -- If a mapping function returns `NULL`, it may be helpful to set `bQuiet == FALSE` to view diagnostic error messages that will point to the column or columns that are causing issues. -- Additionally, it may be helpful to set `bReturnChecks == TRUE`, which will return a list of checks that are run on all input data to ensure that all requirements (e.g., required columns, data types, unique, or non-missing data) are met. + +- When using non-standard data, it will be helpful to reference the data specification for required column names for a given assessment. Run `?AE_Map_Raw` to view the documentation, and consult the **Data specification** section. +- If a mapping function returns `NULL`, it may be helpful to set `bQuiet == FALSE` to view diagnostic error messages that will point to the column or columns that are causing issues. +- Additionally, it may be helpful to set `bReturnChecks == TRUE`, which will return a list of checks that are run on all input data to ensure that all requirements (e.g., required columns, data types, unique, or non-missing data) are met. ## Example 3 - Running Multiple Assessments using Raw+ data -Now, let's take a look at running multiple assessments instead of focusing solely on Adverse Events. +Now, let's take a look at running multiple assessments instead of focusing solely on Adverse Events. Running multiple assessments in {gsm} is made possible by the `Study_Assess()` function. By default, `Study_Assess()` uses sample data from {clindata} that is hard-coded to the `lData` parameter. Users can also provide their own Raw+ input data to the `lData` parameter. ### Using sample data from {clindata} To run multiple assessments using sample data from {clindata}, simply run the following: -``` -library(gsm) -library(clindata) -library(safetyData) -# Run multiple assessments -multiple_assessments <- Study_Assess() -``` + library(gsm) + library(clindata) + library(safetyData) + + # Run multiple assessments + multiple_assessments <- Study_Assess() ### Using user-provided Raw+ data -For the scope of this example, the data found in {clindata} will pose as user-provided Raw+ data, but this will likely come from Raw+ case report data. +For the scope of this example, the data found in {clindata} will pose as user-provided Raw+ data, but this will likely come from Raw+ case report data. -The example below illustrates that a user can pass a _named*_ list of Raw+ data to the `lData` parameter. +The example below illustrates that a user can pass a \_named\*\_ list of Raw+ data to the `lData` parameter. -_*`lData` expects a named list. To see a list of default data frame names, run `names(clindata::mapping_rawplus)`_ +*\*`lData` expects a named list. To see a list of default data frame names, run* `names(clindata::mapping_rawplus)` -``` -library(gsm) -library(clindata) -library(dplyr) - -# Include AE data where AE_GRADE is greater than 1 -dfAE <- clindata::rawplus_ae %>% - filter( - AE_GRADE > 1 - ) - -# Specify Raw+ data domains -dfSUBJ <- clindata::rawplus_subj -dfIE <- clindata::rawplus_ie -dfPD <- clindata::rawplus_pd -dfCONSENT <- clindata::rawplus_consent - -# Create named list of assessment data -assessment_data <- list( - dfAE = dfAE, - dfIE = dfIE, - dfPD = dfPD, - dfCONSENT = dfCONSENT, - dfSUBJ = dfSUBJ -) + library(gsm) + library(clindata) + library(dplyr) -# Run multiple assessments -multiple_assessments <- Study_Assess(lData = assessment_data) -``` + # Include AE data where AE_GRADE is greater than 1 + dfAE <- clindata::rawplus_ae %>% + filter( + AE_GRADE > 1 + ) + # Specify Raw+ data domains + dfSUBJ <- clindata::rawplus_subj + dfIE <- clindata::rawplus_ie + dfPD <- clindata::rawplus_pd + dfCONSENT <- clindata::rawplus_consent + + # Create named list of assessment data + assessment_data <- list( + dfAE = dfAE, + dfIE = dfIE, + dfPD = dfPD, + dfCONSENT = dfCONSENT, + dfSUBJ = dfSUBJ + ) + + # Run multiple assessments + multiple_assessments <- Study_Assess(lData = assessment_data) Note that `Study_Assess()` provides verbose console output alerting the user to success, warnings, or errors with the workflow. - ## Example 4 - Filtering Subject-Level Data For Multiple Assessments -Let's take a closer look at functionality that is built into `Study_Assess()`. As a practical example, a user may want to keep subjects from an assessment based on a some criteria (e.g., a specific site, region, etc.). +Let's take a closer look at functionality that is built into `Study_Assess()`. As a practical example, a user may want to keep subjects from an assessment based on a some criteria (e.g., a specific site, region, etc.). This can be done by performing some preliminary data wrangling before passing the subject-level data to `lData`, but for the example below, we will use a custom `lMapping` and a named list passed to `lSubjFilters`. (For a more detailed overview of mapping specifications, refer to the [Data Pipeline Vignette](https://github.com/Gilead-BioStats/gsm/wiki/Data-Pipeline-Vignette).) For this example, we will only keep subjects who have `SiteID == "X010X"`: -``` -library(gsm) -library(clindata) -library(dplyr) + library(gsm) + library(clindata) + library(dplyr) -# Start with the default lMapping -custom_mapping <- clindata::mapping_rawplus + # Start with the default lMapping + custom_mapping <- yaml::read_yaml(system.file("mappings", "mapping_rawplus.yaml", package = "gsm")) -# Add the value to filter on to the custom mapping for dfSUBJ -custom_mapping$dfSUBJ$strSiteVal <- "X010X" + # Add the value to filter on to the custom mapping for dfSUBJ + custom_mapping$dfSUBJ$strSiteVal <- "X010X" -# Create a list to pass to lSubjFilters -custom_filter <- list( - strSiteCol = "strSiteVal" -) + # Create a list to pass to lSubjFilters + custom_filter <- list( + strSiteCol = "strSiteVal" + ) + + # Run the assessments + multiple_assessments <- Study_Assess(lMapping = custom_mapping, lSubjFilters = custom_filter) -# Run the assessments -multiple_assessments <- Study_Assess(lMapping = custom_mapping, lSubjFilters = custom_filter) -``` Note that `Study_Assess()` provides detailed information about `FilterDomain()`, which shows the number of rows dropped when filtering subject-level data: -``` -── Checking Input Data for `FilterDomain()` ── -✔ No issues found for dfSUBJ domain -Filtering on SiteID == X010X -✔ Filtered on `SiteID=X010X`, to drop 1269 rows from 1297 to 28 rows. -``` + ── Checking Input Data for `FilterDomain()` ── + + ✔ No issues found for dfSUBJ domain + Filtering on SiteID == X010X + ✔ Filtered on `SiteID=X010X`, to drop 1269 rows from 1297 to 28 rows. # Reporting ## Example 5 - Creating an Assessment Overview Report for Multiple Assessments -The `Study_Report()` function creates the **Assessment Overview Report**, which is an HTML document that contains tables, visualizations, and error logging for all assessments run in the `Study_Assess()` workflow. +The `Study_Report()` function creates the **Assessment Overview Report**, which is an HTML document that contains tables, visualizations, and error logging for all assessments run in the `Study_Assess()` workflow. Let's create a report using sample data from {clindata}: -``` -library(gsm) -library(clindata) + library(gsm) + library(clindata) -multiple_assessments <- Study_Assess() + multiple_assessments <- Study_Assess() -Study_Report(lAssessments = multiple_assessments, lMeta = list(label = "My Study")) -``` -The report will render and be saved to your current working directory. You can optionally set an output directory using the `strOutpath` parameter. + Study_Report(lAssessments = multiple_assessments, lMeta = list(label = "My Study")) + +The report will render and be saved to your current working directory. You can optionally set an output directory using the `strOutpath` parameter. ## Example 6 - Viewing Error Checking Report -The **Assessment Overview Report** contains a Data Check Summary table in the appendix, which can be helpful for troubleshooting issues with input data provided to `lData` in `Study_Assess()`. +The **Assessment Overview Report** contains a Data Check Summary table in the appendix, which can be helpful for troubleshooting issues with input data provided to `lData` in `Study_Assess()`. -To view the report directly as an object in your IDE, run: -``` -library(gsm) -library(clindata) +To view the report directly as an object in your IDE, run: -multiple_assessments <- Study_Assess() + library(gsm) + library(clindata) -Study_AssessmentReport(lAssessments = multiple_assessments, bViewReport = TRUE) -``` -Here's an example of a report that shows no errors: + multiple_assessments <- Study_Assess() -![image](https://user-images.githubusercontent.com/40671730/169323890-b084efdb-2eea-43e9-b86b-4cf5770689bd.png) + Study_AssessmentReport(lAssessments = multiple_assessments, bViewReport = TRUE) # Visualizations @@ -262,66 +248,62 @@ By default, all `*_Assess()` functions return a visualization whether run indivi ## Example 7 - Creating a Scatter Plot -Currently, {gsm} creates scatter plots for Adverse Event and Protocol Deviation assessments. +Currently, {gsm} creates scatter plots for Adverse Event and Protocol Deviation assessments. -In some cases, a user may want to produce a visualization separately to make additional customizations. +In some cases, a user may want to produce a visualization separately to make additional customizations. Below is an example using the default Poisson statistical model for `AE_Assess()`: -``` -library(gsm) -library(clindata) + library(gsm) + library(clindata) -# Map Domain-level data to the input data standard for the selected assessment -dfInput <- AE_Map_Raw() + # Map Domain-level data to the input data standard for the selected assessment + dfInput <- AE_Map_Raw() -# Run the assessment -ae_assessment <- AE_Assess(dfInput) + # Run the assessment + ae_assessment <- AE_Assess(dfInput) -# Create threshold boundaries -dfBounds <- Analyze_Poisson_PredictBounds( - dfTransformed = ae_assessment$dfTransformed, - vThreshold = c(-5, 5) - ) + # Create threshold boundaries + dfBounds <- Analyze_Poisson_PredictBounds( + dfTransformed = ae_assessment$dfTransformed, + vThreshold = c(-5, 5) + ) -# Create the visualization -Visualize_Scatter( - dfFlagged = ae_assessment$dfFlagged, - dfBounds = dfBounds - ) -``` + # Create the visualization + Visualize_Scatter( + dfFlagged = ae_assessment$dfFlagged, + dfBounds = dfBounds + ) -Creating a scatter plot for a Wilcoxon model is similar to the example above, but there are no threshold boundaries. +Creating a scatter plot for a Wilcoxon model is similar to the example above, but there are no threshold boundaries. -``` -library(gsm) -library(clindata) + library(gsm) + library(clindata) -# Map Domain-level data to the input data standard for the selected assessment -dfInput <- AE_Map_Raw() + # Map Domain-level data to the input data standard for the selected assessment + dfInput <- AE_Map_Raw() -# Run the assessment -ae_assessment <- AE_Assess(dfInput, strMethod = "wilcoxon") + # Run the assessment + ae_assessment <- AE_Assess(dfInput, strMethod = "wilcoxon") -# Create the visualization -Visualize_Scatter(dfFlagged = ae_assessment$dfFlagged) + # Create the visualization + Visualize_Scatter(dfFlagged = ae_assessment$dfFlagged) -``` # Custom Mapping/YAML Specs -As mentioned in the [Data Pipeline Vignette](https://github.com/Gilead-BioStats/gsm/wiki/Data-Pipeline-Vignette#metadata-technical-specifications), `Study_Assess()` triggers a workflow that uses pre-defined YAML specs that organizes all of the required metadata for a given assessment or set of assessments. +As mentioned in the [Data Pipeline Vignette](https://github.com/Gilead-BioStats/gsm/wiki/Data-Pipeline-Vignette#metadata-technical-specifications), `Study_Assess()` triggers a workflow that uses pre-defined YAML specs that organizes all of the required metadata for a given assessment or set of assessments. -In some cases, the user might want to configure their own mappings, which can be done by providing custom YAML mappings for one or more assessments. +In some cases, the user might want to configure their own mappings, which can be done by providing custom YAML mappings for one or more assessments. -Let's take a look at a few examples of editing YAML files for a custom workflow below. +Let's take a look at a few examples of editing YAML files for a custom workflow below. ## Example 8 - Adding a Filtering Step to the Consent Assessment In the default Assessment Specification for Consent, there is no filter step. Let's add a step that filters the `dfCONSENT` dataframe so all values of `CONSENT_TYPE == "MAINCONSENT"`: -The default Assessments mapping for the Consent Assessment looks like this: +The default Assessments mapping for the Consent Assessment looks like this: -```yaml +``` yaml label: Consent Workflow tags: Assessment: Consent @@ -337,11 +319,11 @@ workflow: output: lResults ``` -First, add the `FilterDomain` steps to the mapping above. Because `dfCONSENT` needs to be filtered before it is used in `Consent_Map_Raw`, it needs to be placed first in the workflow. +First, add the `FilterDomain` steps to the mapping above. Because `dfCONSENT` needs to be filtered before it is used in `Consent_Map_Raw`, it needs to be placed first in the workflow. The updated YAML file should look like this, and then saved to a folder. Let's name it `consent_assessment_yaml.yaml`. -```yaml +``` yaml label: Consent Workflow tags: Assessment: Consent @@ -364,16 +346,17 @@ workflow: output: lResults ``` -After setting up a custom YAML mapping, there are a few more steps in setting up input values for `Study_Assess()`: -1. Read in the default assessment mapping from `gsm::MakeAssessmentList()`. -2. Overwrite `lAssessmentsCustom$consent` with the custom YAML file (`consent_assessment_yaml.yaml`). -3. Add a name value to the custom assessment list. -4. Add a relative path to the custom assessment list, to show where the custom YAML file is stored. -5. Read in the default Raw+ mappings from {clindata}. -6. Add the value to sort `strTypeCol` on. -7. Run the `Study_Assess()` workflow. +After setting up a custom YAML mapping, there are a few more steps in setting up input values for `Study_Assess()`: + +1. Read in the default assessment mapping from `gsm::MakeAssessmentList()`. +2. Overwrite `lAssessmentsCustom$consent` with the custom YAML file (`consent_assessment_yaml.yaml`). +3. Add a name value to the custom assessment list. +4. Add a relative path to the custom assessment list, to show where the custom YAML file is stored. +5. Read in the default Raw+ mappings from {clindata}. +6. Add the value to sort `strTypeCol` on. +7. Run the `Study_Assess()` workflow. -```r +``` r library(gsm) library(clindata) library(yaml) From 71a33c17d84878b85457e1ef7435821ab2d0858f Mon Sep 17 00:00:00 2001 From: Matt Roumaya Date: Mon, 13 Jun 2022 20:00:05 +0000 Subject: [PATCH 64/87] update documentation --- R/Analyze_Chisq.R | 2 +- R/Analyze_Fisher.R | 2 +- R/Analyze_Identity.R | 7 ++++++- R/Analyze_Poisson.R | 2 +- R/Analyze_Poisson_PredictBounds.R | 4 ++-- R/Analyze_Wilcoxon.R | 4 ++-- R/Disp_Map.R | 2 +- R/Flag.R | 13 ++++++------- R/Study_Assess.R | 4 ++-- R/Study_AssessmentReport.R | 2 +- R/Study_Report.R | 14 +++++++------- R/Transform_EventCount.R | 5 +++-- R/Visualize_Count.R | 3 +-- R/Visualize_Scatter.R | 3 ++- R/util-MakeAssessmentList.R | 2 +- R/util-MergeSubjects.R | 8 ++++---- R/util-ReportHelpers.R | 10 ++++++---- R/util-RunAssessment.R | 9 ++++----- R/util-RunStep.R | 4 +--- R/util-generate_md_table.R | 2 +- R/util-parse_data_mapping.R | 2 +- R/util-parse_data_spec.R | 2 +- man/Analyze_Chisq.Rd | 2 +- man/Analyze_Fisher.Rd | 4 ++-- man/Analyze_Identity.Rd | 8 +++++++- man/Analyze_Poisson.Rd | 2 +- man/Analyze_Poisson_PredictBounds.Rd | 4 ++-- man/Analyze_Wilcoxon.Rd | 3 +-- man/Disp_Map.Rd | 2 +- man/Flag.Rd | 10 ++++------ man/MakeAssessmentList.Rd | 2 +- man/MergeSubjects.Rd | 8 ++++---- man/RunAssessment.Rd | 7 +++---- man/RunStep.Rd | 2 +- man/Study_Assess.Rd | 4 ++-- man/Study_AssessmentReport.Rd | 2 +- man/Study_Report.Rd | 12 ++++++------ man/Transform_EventCount.Rd | 4 ++-- man/Visualize_Count.Rd | 3 +-- man/Visualize_Scatter.Rd | 2 +- man/generate_md_table.Rd | 2 +- man/parse_data_mapping.Rd | 2 +- man/parse_data_spec.Rd | 2 +- man/rank_chg.Rd | 8 +++++--- 44 files changed, 104 insertions(+), 97 deletions(-) diff --git a/R/Analyze_Chisq.R b/R/Analyze_Chisq.R index c2eef2b73..926d1364b 100644 --- a/R/Analyze_Chisq.R +++ b/R/Analyze_Chisq.R @@ -23,7 +23,7 @@ #' @param bQuiet `logical` Suppress warning messages? Default: `TRUE` #' #' -#' @return data.frame with one row per site, columns: SiteID, TotalCount, TotalCount_Other, N, N_Other, Prop, Prop_Other, Statistic, PValue +#' @return `data.frame` with one row per site with columns: SiteID, TotalCount, TotalCount_Other, N, N_Other, Prop, Prop_Other, Statistic, PValue. #' #' @examples #' dfInput <- Disp_Map(dfDisp = safetyData::adam_adsl, strCol = "DCREASCD", strReason = "Adverse Event") diff --git a/R/Analyze_Fisher.R b/R/Analyze_Fisher.R index 63dc5bc9a..244a960fb 100644 --- a/R/Analyze_Fisher.R +++ b/R/Analyze_Fisher.R @@ -22,7 +22,7 @@ #' @param strOutcome `character` required, name of column in dfTransformed dataset to perform Fisher test on. Default is "TotalCount". #' @param bQuiet `logical` Suppress warning messages? Default: `TRUE` #' -#' @return data.frame with one row per site, columns: SiteID, TotalCount, TotalCount_Other, N, N_Other, Prop, Prop_Other, Estimate, PValue +#' @return `data.frame` with one row per site with columns: SiteID, TotalCount, TotalCount_Other, N, N_Other, Prop, Prop_Other, Estimate, PValue. #' #' @examples #' dfInput <- Disp_Map(dfDisp = safetyData::adam_adsl, strCol = "DCREASCD", strReason = "Adverse Event") diff --git a/R/Analyze_Identity.R b/R/Analyze_Identity.R index f26db31c9..441a4965d 100644 --- a/R/Analyze_Identity.R +++ b/R/Analyze_Identity.R @@ -7,7 +7,12 @@ #' @param strLabelCol `character` Name of column that will be copied as `ScoreLabel` #' @param bQuiet `logical` Suppress warning messages? Default: `TRUE` #' -#' @return `data.frame` that adds two columns to `dfTransformed`: `Score` and `ScoreLabel` +#' @return `data.frame` with one row per site with columns: SiteID, N, TotalCount, KRI, KRILabel, Score, ScoreLabel. +#' +#' @examples +#' dfInput <- Consent_Map_Raw() +#' dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count") +#' dfAnalyzed <- Analyze_Identity(dfTransformed) #' #' @export diff --git a/R/Analyze_Poisson.R b/R/Analyze_Poisson.R index c4845a20f..a5df0f394 100644 --- a/R/Analyze_Poisson.R +++ b/R/Analyze_Poisson.R @@ -20,7 +20,7 @@ #' @param dfTransformed data.frame in format produced by \code{\link{Transform_EventCount}}. Must include SubjectID, SiteID, TotalCount and TotalExposure. #' @param bQuiet `logical` Suppress warning messages? Default: `TRUE` #' -#' @return input data.frame with columns added for "Residuals" and "PredictedCount" +#' @return `data.frame` with columns added for "Residuals" and "PredictedCount". #' #' @examples #' dfInput <- AE_Map_Raw() diff --git a/R/Analyze_Poisson_PredictBounds.R b/R/Analyze_Poisson_PredictBounds.R index cba8a6ca8..0e416bdaa 100644 --- a/R/Analyze_Poisson_PredictBounds.R +++ b/R/Analyze_Poisson_PredictBounds.R @@ -25,8 +25,8 @@ #' the thresholds used AE_Assess(). #' @param bQuiet `logical` Suppress warning messages? Default: `TRUE` #' -#' @return data frame containing predicted boundary values with upper and lower bounds across the -#' range of observed values +#' @return `data.frame` containing predicted boundary values with upper and lower bounds across the +#' range of observed values. #' #' @examples #' dfInput <- AE_Map_Adam() diff --git a/R/Analyze_Wilcoxon.R b/R/Analyze_Wilcoxon.R index 5c59c6251..bdd9fba29 100644 --- a/R/Analyze_Wilcoxon.R +++ b/R/Analyze_Wilcoxon.R @@ -2,7 +2,7 @@ #' #' Create analysis results data for event assessment using the Wilcoxon sign-ranked test. #' -#' @details +#' @details #' Fits a Wilcoxon model to site-level data. #' #' @section Statistical Methods: @@ -25,7 +25,7 @@ #' @param bQuiet `logical` Suppress warning messages? Default: `TRUE` #' #' @return `data.frame` with one row per site, columns: SiteID, N, TotalCount, TotalExposure, Rate, -#' Estimate, PValue +#' Estimate, PValue. #' #' @examples #' dfInput <- AE_Map_Raw() diff --git a/R/Disp_Map.R b/R/Disp_Map.R index 4148d47b3..e45ff6d5f 100644 --- a/R/Disp_Map.R +++ b/R/Disp_Map.R @@ -18,7 +18,7 @@ #' @param strReason character string containing reason for discontinuation. Can be a value found in `dfDisp$strCol` or "any" (the default), which selects all reasons not included in `vReasonIgnore` #' @param vReasonIgnore character vector containing reasons to ignore when counting Discontinuation Reason (i.e., "Completed", "", etc.) #' -#' @return Data frame with one record per person with columns: SubjectID, SiteID, Count, and the value passed to strCol. +#' @return `data.frame` with one record per person with columns: SubjectID, SiteID, Count, and the value passed to strCol. #' #' @examples #' df <- Disp_Map(dfDisp = safetyData::adam_adsl, strCol = "DCREASCD", strReason = "adverse event") diff --git a/R/Flag.R b/R/Flag.R index b4de85520..b6531b894 100644 --- a/R/Flag.R +++ b/R/Flag.R @@ -1,11 +1,9 @@ -#' Make data frame with flagged values +#' Flag #' -#' Adds columns flagging sites that represent possible statistical outliers. Rows with PValue less -#' than 0.05 are flagged by default. +#' Add columns flagging sites that represent possible statistical outliers. #' #' @details -#' This function provides a generalized framework for flagging sites as part of the GSM data -#' pipeline (TODO add link to data vignette). +#' This function provides a generalized framework for flagging sites as part of the [GSM data pipeline](https://silver-potato-cfe8c2fb.pages.github.io/articles/DataPipeline.html). #' #' @section Data Specification: #' \code{Flag} is designed to support the input data (` dfAnalyzed`) input data from many different @@ -27,7 +25,7 @@ #' @param strValueColumn Optional, Name of the Column to use for sign of Flag. If value for that row #' is higher than median of strValueColumn then Flag = 1, if lower then Flag = -1. #' -#' @return input data frame with the columns added for "ThresholdLow","ThresholdHigh","ThresholdCol" +#' @return `data.frame` with columns added for "ThresholdLow","ThresholdHigh","ThresholdCol" #' and "Flag" #' #' @examples @@ -98,7 +96,8 @@ Flag <- function( ) } - dfFlagged <- dfFlagged %>% arrange(match(.data$Flag, c(1, -1, 0))) + dfFlagged <- dfFlagged %>% + arrange(match(.data$Flag, c(1, -1, 0))) return(dfFlagged) } diff --git a/R/Study_Assess.R b/R/Study_Assess.R index 8b422b41b..f815b8afd 100644 --- a/R/Study_Assess.R +++ b/R/Study_Assess.R @@ -7,12 +7,12 @@ #' @param lAssessments a named list of metadata defining how each assessment should be run. By default, `MakeAssessmentList()` imports YAML specifications from `inst/assessments`. #' @param lSubjFilters a named list of parameters to filter subject-level data on. #' @param lTags a named list of Tags to be passed to each assessment. Default is `list(Study="myStudy")` could be expanded to include other important metadata such as analysis population or study phase. -#' @param bQuiet Default is TRUE, which means warning messages are suppressed. Set to FALSE to see warning messages. +#' @param bQuiet `logical` Suppress warning messages? Default: `TRUE` #' #' @examples #' results <- Study_Assess() # run using defaults #' -#' @return A list of assessments containing status information and results. +#' @return `list` of assessments containing status information and results. #' #' @import dplyr #' @importFrom cli cli_alert_danger diff --git a/R/Study_AssessmentReport.R b/R/Study_AssessmentReport.R index ab2650df5..ff2afe653 100644 --- a/R/Study_AssessmentReport.R +++ b/R/Study_AssessmentReport.R @@ -5,7 +5,7 @@ #' @param lAssessments List of 1+ assessments like those created by `runAssessment()` or `Study_Assess()` #' @param bViewReport HTML table of dfSummary that can be viewed in most IDEs. #' -#' @return `list` Returns a list containing a data.frame summarizing the checks `dfSummary` and a dataframe listing all checks (`dfAllChecks`) +#' @return `list` containing a `data.frame` summarizing the checks `dfSummary` and a `data.frame` listing all checks (`dfAllChecks`). #' #' @examples #' assessment <- Study_Assess() diff --git a/R/Study_Report.R b/R/Study_Report.R index f786aefe0..ee4b7d737 100644 --- a/R/Study_Report.R +++ b/R/Study_Report.R @@ -1,17 +1,17 @@ #' Study Report #' -#' Pulls needed study data and runs one or more assessments +#' Create HTML summary report using the results of `Study_Assess`, including tables, charts, and error checking. #' -#' @param lAssessments character vector listing assessments -#' @param lMeta list of metadata related to study -#' @param strOutpath path to save the report +#' @param lAssessments `list` The results of multiple assessments run using `Study_Assess`. +#' @param lMeta `list` Metadata related to study. +#' @param strOutpath `character` File path; location where the report will be saved. #' #' @return HTML report of study data. #' #' @examples #' \dontrun{ -#' assessment <- Study_Assess() -#' Study_Report(assessment, lMeta = list(study = "my study name")) +#' lAssessment <- Study_Assess() +#' Study_Report(lAssessment, lMeta = list(study = "my study name")) #' } #' #' @importFrom rmarkdown render @@ -29,6 +29,6 @@ Study_Report <- function(lAssessments, lMeta = list(Project = "My Project"), str assessments = lAssessments, meta = lMeta ), - envir = new.env(parent = globalenv()) ## eval in child of global env + envir = new.env(parent = globalenv()) ) } diff --git a/R/Transform_EventCount.R b/R/Transform_EventCount.R index 593a38291..bb6a9f257 100644 --- a/R/Transform_EventCount.R +++ b/R/Transform_EventCount.R @@ -1,6 +1,7 @@ #' Transform Event Count #' -#' Convert from ADaM format to needed input format for Safety Assessment +#' Convert from input data format to needed input format to derive KRI for an Assessment. +#' #' @details #' #' This function transforms data to prepare it for the Analysis step @@ -29,7 +30,7 @@ #' @param strExposureCol Optional. Numerical `Exposure` column. #' @param strKRILabel Optional. Character vector to describe the `KRI` column. #' -#' @return data.frame with one row per site with columns SiteID, N, TotalCount with additional columns Exposure and Rate if strExposureCol is used. +#' @return `data.frame` with one row per site with columns SiteID, N, TotalCount with additional columns Exposure and Rate if strExposureCol is used. #' #' @examples #' dfInput <- AE_Map_Adam() diff --git a/R/Visualize_Count.R b/R/Visualize_Count.R index bd6639a9b..16642a91c 100644 --- a/R/Visualize_Count.R +++ b/R/Visualize_Count.R @@ -5,10 +5,9 @@ #' @param strCountCol Column containing total number of site-level occurrences. Default is "TotalCount" from \code{\link{Transform_EventCount}}. #' @param strTitle Title of plot. NULL by default. #' -#' @return site level plot object +#' @return site-level plot object. #' #' @examples -#' #' IE_Input <- IE_Map_Raw() #' IE_Assess <- IE_Assess(IE_Input) #' Visualize_Count(IE_Assess$dfAnalyzed) diff --git a/R/Visualize_Scatter.R b/R/Visualize_Scatter.R index 8f476717a..d7aa8b633 100644 --- a/R/Visualize_Scatter.R +++ b/R/Visualize_Scatter.R @@ -4,7 +4,7 @@ #' @param dfBounds data.frame giving prediction bounds for range of dfFlagged. #' @param strUnit exposure time unit. Defaults to "days". #' -#' @return site level plot object +#' @return site-level plot object. #' #' @examples #' dfInput <- AE_Map_Adam() @@ -18,6 +18,7 @@ #' @import ggplot2 #' #' @export + Visualize_Scatter <- function(dfFlagged, dfBounds = NULL, strUnit = "days") { ### Plot of data diff --git a/R/util-MakeAssessmentList.R b/R/util-MakeAssessmentList.R index c7c14786a..516024da9 100644 --- a/R/util-MakeAssessmentList.R +++ b/R/util-MakeAssessmentList.R @@ -5,7 +5,7 @@ #' `MakeAssessmentList()` is a utility function that creates a workflow mapping for assessments used in `Study_Assess()`. #' #' @param path `character` The location of assessment YAML files. If package is specified, function will look in `/inst` folder. -#' @param package `character` package with assessments +#' @param package `character` The name of the package with assessments. #' #' @examples #' MakeAssessmentList(path = "assessments", package = "gsm") diff --git a/R/util-MergeSubjects.R b/R/util-MergeSubjects.R index 273b3078e..50c95bb0e 100644 --- a/R/util-MergeSubjects.R +++ b/R/util-MergeSubjects.R @@ -1,12 +1,12 @@ -#' Merge Domain data with subject-level data shell +#' Merge Domain data with subject-level data #' -#' @param dfSubjects Subject level data often using ADSL-like data. Should include one record per participant for each participant included in the analysis population (all other participants should be dropped before calling mergeSubjects) #' @param dfDomain Subject-level domain data containing one record per participant. +#' @param dfSubjects Subject level data often using ADSL-like data. Should include one record per participant for each participant included in the analysis population (all other participants should be dropped before calling mergeSubjects) #' @param strIDCol name of ID Column - default='SubjectID' #' @param vFillZero Columns from dfDomain to fill with zeros when no matching row is found in for an ID in dfSubject -#' @param bQuiet Default is TRUE, which means warning messages are suppressed. Set to FALSE to see warning messages. +#' @param bQuiet `logical` Suppress warning messages? Default: `TRUE` #' -#' @return data set with one record per IDCol +#' @return `data.frame` with one record per strIDCol. #' #' #' @examples diff --git a/R/util-ReportHelpers.R b/R/util-ReportHelpers.R index f51fab87a..5a64ce48f 100644 --- a/R/util-ReportHelpers.R +++ b/R/util-ReportHelpers.R @@ -1,9 +1,11 @@ - -#' insert icon for status in gt table +#' Report Helper Functions +#' +#' @description +#' `rank_chg` - inserts icons for status in {gt} table. #' -#' from https://themockup.blog/posts/2020-10-31-embedding-custom-features-in-gt-tables/ +#' Adopted from https://themockup.blog/posts/2020-10-31-embedding-custom-features-in-gt-tables/. #' -#' @param status boolean status +#' @param status `boolean` fontawesome emoji indicator that describes the status of error checking for all assessments run in `Study_Assess()` #' #' @importFrom fontawesome fa #' @importFrom gt gt diff --git a/R/util-RunAssessment.R b/R/util-RunAssessment.R index 02fa2ac0d..c1cf910f9 100644 --- a/R/util-RunAssessment.R +++ b/R/util-RunAssessment.R @@ -1,15 +1,15 @@ #' Run a single assessment #' -#' Attempts to run a single assessments (`lAssessment`) using shared data (`lData`) and metadata (`lMapping`). -#' Calls `RunStep` for each item in `lAssessment$Workflow` and saves the results to `lAssessment` +#' Attempts to run a single assessment (`lAssessment`) using shared data (`lData`) and metadata (`lMapping`). +#' Calls `RunStep` for each item in `lAssessment$workflow` and saves the results to `lAssessment` #' +#' @param lAssessment `list` A named list of metadata defining how each assessment should be run. Properties should include: `label`, `tags` and `workflow` #' @param lData `list` A named list of domain-level data frames. Names should match the values specified in `lMapping` and `lAssessments`, which are generally based on the expected inputs from `X_Map_Raw`. #' @param lMapping `list` A named list identifying the columns needed in each data domain. -#' @param lAssessment `list` A named list of metadata defining how each assessment should be run. Properties should include: `label`, `tags` and `workflow` #' @param lTags `list` A named list of tags describing the assessment. `lTags` is returned as part of the assessment (`lAssess$lTags`) and each tag is added as columns in `lassess$dfSummary`. #' @param bQuiet `logical` Suppress warning messages? Default: `TRUE` #' -#' @return `list` Returns `lAssessment` with `label`, `tags`, `workflow`, `path`, `name`, `lData`, `lChecks`, `bStatus`, `checks`, and `lResults` added based on the results of the execution of `assessment$workflow`. +#' @return `list` containing `lAssessment` with `tags`, `workflow`, `path`, `name`, `lData`, `lChecks`, `bStatus`, `checks`, and `lResults` added based on the results of the execution of `assessment$workflow`. #' #' @examples #' lAssessments <- MakeAssessmentList() @@ -25,7 +25,6 @@ #' ) #' lMapping <- clindata::mapping_rawplus #' -#' #' ae_assessment <- RunAssessment(lAssessments$ae, lData = lData, lMapping = lMapping, lTags = lTags) #' #' @importFrom cli cli_alert_success cli_alert_warning cli_h1 cli_h2 cli_text diff --git a/R/util-RunStep.R b/R/util-RunStep.R index 335719425..20f4c3793 100644 --- a/R/util-RunStep.R +++ b/R/util-RunStep.R @@ -8,9 +8,7 @@ #' @param lTags tags #' @param bQuiet Default is TRUE, which means warning messages are suppressed. Set to FALSE to see warning messages. #' -#' @return A list containing the results of the `lStep$name` function call should contain `.$checks` parameter with results from `is_mapping_vald` for each domain in `lStep$inputs`. -#' -#' +#' @return `list` containing the results of the `lStep$name` function call should contain `.$checks` parameter with results from `is_mapping_vald` for each domain in `lStep$inputs`. #' #' @examples #' lStep <- MakeAssessmentList()[["ae"]][["workflow"]][[1]] diff --git a/R/util-generate_md_table.R b/R/util-generate_md_table.R index a5d5f3726..51e0eb4d3 100644 --- a/R/util-generate_md_table.R +++ b/R/util-generate_md_table.R @@ -1,6 +1,6 @@ #' Generate Markdown Table #' -#' Combine data mapping and specification then output as markdown table. +#' Combine data mapping and specification, and then output as markdown table. #' #' @param domain `character` domain name #' @param mapping `data.frame` data mapping diff --git a/R/util-parse_data_mapping.R b/R/util-parse_data_mapping.R index 466768753..159fe71f6 100644 --- a/R/util-parse_data_mapping.R +++ b/R/util-parse_data_mapping.R @@ -1,6 +1,6 @@ #' Parse Data Mapping #' -#' Transform nested data mapping to tabular structure +#' Transform nested data mapping to tabular structure for use in documentation. #' #' @param content `list` data mapping #' @param file `character` file path of .yaml file diff --git a/R/util-parse_data_spec.R b/R/util-parse_data_spec.R index c6159cce9..a7bf40af2 100644 --- a/R/util-parse_data_spec.R +++ b/R/util-parse_data_spec.R @@ -1,6 +1,6 @@ #' Parse Data Specification #' -#' Transform nested data specification to tabular structure +#' Transform nested data specification to tabular structure for use in documentation. #' #' @param content `list` data specification #' @param file `character` file path of .yaml file diff --git a/man/Analyze_Chisq.Rd b/man/Analyze_Chisq.Rd index 814e01ea0..c011ddd2e 100644 --- a/man/Analyze_Chisq.Rd +++ b/man/Analyze_Chisq.Rd @@ -14,7 +14,7 @@ Analyze_Chisq(dfTransformed, strOutcome = "TotalCount", bQuiet = TRUE) \item{bQuiet}{\code{logical} Suppress warning messages? Default: \code{TRUE}} } \value{ -data.frame with one row per site, columns: SiteID, TotalCount, TotalCount_Other, N, N_Other, Prop, Prop_Other, Statistic, PValue +\code{data.frame} with one row per site with columns: SiteID, TotalCount, TotalCount_Other, N, N_Other, Prop, Prop_Other, Statistic, PValue. } \description{ Creates Analysis results data for count data using the chi-squared test diff --git a/man/Analyze_Fisher.Rd b/man/Analyze_Fisher.Rd index a9da234c7..141eede7a 100644 --- a/man/Analyze_Fisher.Rd +++ b/man/Analyze_Fisher.Rd @@ -14,7 +14,7 @@ Analyze_Fisher(dfTransformed, strOutcome = "TotalCount", bQuiet = TRUE) \item{bQuiet}{\code{logical} Suppress warning messages? Default: \code{TRUE}} } \value{ -data.frame with one row per site, columns: SiteID, TotalCount, TotalCount_Other, N, N_Other, Prop, Prop_Other, Estimate, PValue +\code{data.frame} with one row per site with columns: SiteID, TotalCount, TotalCount_Other, N, N_Other, Prop, Prop_Other, Estimate, PValue. } \description{ Creates Analysis results data for count data using the Fisher's exact test @@ -41,7 +41,7 @@ The input data (\code{dfTransformed}) for Analyze_Fisher is typically created us \examples{ dfInput <- Disp_Map(dfDisp = safetyData::adam_adsl, strCol = "DCREASCD", strReason = "Adverse Event") -dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strKRILabel = "Discontinuations due to AE/Month") +dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strKRILabel = "Discontinuations due to AE") dfAnalyzed <- Analyze_Fisher(dfTransformed) } diff --git a/man/Analyze_Identity.Rd b/man/Analyze_Identity.Rd index be5792761..5613c13f5 100644 --- a/man/Analyze_Identity.Rd +++ b/man/Analyze_Identity.Rd @@ -21,8 +21,14 @@ Analyze_Identity( \item{bQuiet}{\code{logical} Suppress warning messages? Default: \code{TRUE}} } \value{ -\code{data.frame} that adds two columns to \code{dfTransformed}: \code{Score} and \code{ScoreLabel} +\code{data.frame} with one row per site with columns: SiteID, N, TotalCount, KRI, KRILabel, Score, ScoreLabel. } \description{ Used in the data pipeline between \code{Transform} and \code{Flag} to rename KRI and Score columns. } +\examples{ +dfInput <- Consent_Map_Raw() +dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count") +dfAnalyzed <- Analyze_Identity(dfTransformed) + +} diff --git a/man/Analyze_Poisson.Rd b/man/Analyze_Poisson.Rd index c24e1a4d9..bbeeba757 100644 --- a/man/Analyze_Poisson.Rd +++ b/man/Analyze_Poisson.Rd @@ -12,7 +12,7 @@ Analyze_Poisson(dfTransformed, bQuiet = TRUE) \item{bQuiet}{\code{logical} Suppress warning messages? Default: \code{TRUE}} } \value{ -input data.frame with columns added for "Residuals" and "PredictedCount" +\code{data.frame} with columns added for "Residuals" and "PredictedCount". } \description{ Poisson Analysis - Site Residuals diff --git a/man/Analyze_Poisson_PredictBounds.Rd b/man/Analyze_Poisson_PredictBounds.Rd index a4a05e0c9..72d474685 100644 --- a/man/Analyze_Poisson_PredictBounds.Rd +++ b/man/Analyze_Poisson_PredictBounds.Rd @@ -20,8 +20,8 @@ the thresholds used AE_Assess().} \item{bQuiet}{\code{logical} Suppress warning messages? Default: \code{TRUE}} } \value{ -data frame containing predicted boundary values with upper and lower bounds across the -range of observed values +\code{data.frame} containing predicted boundary values with upper and lower bounds across the +range of observed values. } \description{ Poisson Analysis - Predicted Boundaries diff --git a/man/Analyze_Wilcoxon.Rd b/man/Analyze_Wilcoxon.Rd index 32f911c8c..0fc931c2d 100644 --- a/man/Analyze_Wilcoxon.Rd +++ b/man/Analyze_Wilcoxon.Rd @@ -23,13 +23,12 @@ Default: \code{"SiteID"}} } \value{ \code{data.frame} with one row per site, columns: SiteID, N, TotalCount, TotalExposure, Rate, -Estimate, PValue +Estimate, PValue. } \description{ Create analysis results data for event assessment using the Wilcoxon sign-ranked test. } \details{ -@details Fits a Wilcoxon model to site-level data. } \section{Statistical Methods}{ diff --git a/man/Disp_Map.Rd b/man/Disp_Map.Rd index 0f14d620a..8bc24bf26 100644 --- a/man/Disp_Map.Rd +++ b/man/Disp_Map.Rd @@ -21,7 +21,7 @@ Disp_Map( \item{vReasonIgnore}{character vector containing reasons to ignore when counting Discontinuation Reason (i.e., "Completed", "", etc.)} } \value{ -Data frame with one record per person with columns: SubjectID, SiteID, Count, and the value passed to strCol. +\code{data.frame} with one record per person with columns: SubjectID, SiteID, Count, and the value passed to strCol. } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} diff --git a/man/Flag.Rd b/man/Flag.Rd index f87c2d857..3973a08eb 100644 --- a/man/Flag.Rd +++ b/man/Flag.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/Flag.R \name{Flag} \alias{Flag} -\title{Make data frame with flagged values} +\title{Flag} \usage{ Flag( dfAnalyzed, @@ -23,16 +23,14 @@ values in strColumn are compared to vThreshold using strict comparisons. Values is higher than median of strValueColumn then Flag = 1, if lower then Flag = -1.} } \value{ -input data frame with the columns added for "ThresholdLow","ThresholdHigh","ThresholdCol" +\code{data.frame} with columns added for "ThresholdLow","ThresholdHigh","ThresholdCol" and "Flag" } \description{ -Adds columns flagging sites that represent possible statistical outliers. Rows with PValue less -than 0.05 are flagged by default. +Add columns flagging sites that represent possible statistical outliers. } \details{ -This function provides a generalized framework for flagging sites as part of the GSM data -pipeline (TODO add link to data vignette). +This function provides a generalized framework for flagging sites as part of the \href{https://silver-potato-cfe8c2fb.pages.github.io/articles/DataPipeline.html}{GSM data pipeline}. } \section{Data Specification}{ diff --git a/man/MakeAssessmentList.Rd b/man/MakeAssessmentList.Rd index acbc5e0df..f45da63e5 100644 --- a/man/MakeAssessmentList.Rd +++ b/man/MakeAssessmentList.Rd @@ -9,7 +9,7 @@ MakeAssessmentList(path = "assessments", package = "gsm") \arguments{ \item{path}{\code{character} The location of assessment YAML files. If package is specified, function will look in \verb{/inst} folder.} -\item{package}{\code{character} package with assessments} +\item{package}{\code{character} The name of the package with assessments.} } \value{ \code{list} A list of assessments with workflow and parameter metadata. diff --git a/man/MergeSubjects.Rd b/man/MergeSubjects.Rd index 9c3f167d7..4c653675d 100644 --- a/man/MergeSubjects.Rd +++ b/man/MergeSubjects.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/util-MergeSubjects.R \name{MergeSubjects} \alias{MergeSubjects} -\title{Merge Domain data with subject-level data shell} +\title{Merge Domain data with subject-level data} \usage{ MergeSubjects( dfDomain, @@ -21,13 +21,13 @@ MergeSubjects( \item{vFillZero}{Columns from dfDomain to fill with zeros when no matching row is found in for an ID in dfSubject} -\item{bQuiet}{Default is TRUE, which means warning messages are suppressed. Set to FALSE to see warning messages.} +\item{bQuiet}{\code{logical} Suppress warning messages? Default: \code{TRUE}} } \value{ -data set with one record per IDCol +\code{data.frame} with one record per strIDCol. } \description{ -Merge Domain data with subject-level data shell +Merge Domain data with subject-level data } \examples{ MergeSubjects( diff --git a/man/RunAssessment.Rd b/man/RunAssessment.Rd index 0be24dc20..9da3dd5cf 100644 --- a/man/RunAssessment.Rd +++ b/man/RunAssessment.Rd @@ -18,11 +18,11 @@ RunAssessment(lAssessment, lData, lMapping, lTags = NULL, bQuiet = FALSE) \item{bQuiet}{\code{logical} Suppress warning messages? Default: \code{TRUE}} } \value{ -\code{list} Returns \code{lAssessment} with \code{label}, \code{tags}, \code{workflow}, \code{path}, \code{name}, \code{lData}, \code{lChecks}, \code{bStatus}, \code{checks}, and \code{lResults} added based on the results of the execution of \code{assessment$workflow}. +\code{list} containing \code{lAssessment} with \code{tags}, \code{workflow}, \code{path}, \code{name}, \code{lData}, \code{lChecks}, \code{bStatus}, \code{checks}, and \code{lResults} added based on the results of the execution of \code{assessment$workflow}. } \description{ -Attempts to run a single assessments (\code{lAssessment}) using shared data (\code{lData}) and metadata (\code{lMapping}). -Calls \code{RunStep} for each item in \code{lAssessment$Workflow} and saves the results to \code{lAssessment} +Attempts to run a single assessment (\code{lAssessment}) using shared data (\code{lData}) and metadata (\code{lMapping}). +Calls \code{RunStep} for each item in \code{lAssessment$workflow} and saves the results to \code{lAssessment} } \examples{ lAssessments <- MakeAssessmentList() @@ -38,7 +38,6 @@ lTags <- list( ) lMapping <- clindata::mapping_rawplus - ae_assessment <- RunAssessment(lAssessments$ae, lData = lData, lMapping = lMapping, lTags = lTags) } diff --git a/man/RunStep.Rd b/man/RunStep.Rd index f4a3e1bbc..e2c535d05 100644 --- a/man/RunStep.Rd +++ b/man/RunStep.Rd @@ -18,7 +18,7 @@ RunStep(lStep, lMapping, lData, lTags, bQuiet) \item{bQuiet}{Default is TRUE, which means warning messages are suppressed. Set to FALSE to see warning messages.} } \value{ -A list containing the results of the \code{lStep$name} function call should contain \code{.$checks} parameter with results from \code{is_mapping_vald} for each domain in \code{lStep$inputs}. +\code{list} containing the results of the \code{lStep$name} function call should contain \code{.$checks} parameter with results from \code{is_mapping_vald} for each domain in \code{lStep$inputs}. } \description{ Calls a step in an assessment workflow. Currently supports \verb{*_Map_*}, \verb{*_Assess} and \verb{*_FilterDomain} diff --git a/man/Study_Assess.Rd b/man/Study_Assess.Rd index 751b4ca20..fe1e3e992 100644 --- a/man/Study_Assess.Rd +++ b/man/Study_Assess.Rd @@ -24,10 +24,10 @@ Study_Assess( \item{lTags}{a named list of Tags to be passed to each assessment. Default is \code{list(Study="myStudy")} could be expanded to include other important metadata such as analysis population or study phase.} -\item{bQuiet}{Default is TRUE, which means warning messages are suppressed. Set to FALSE to see warning messages.} +\item{bQuiet}{\code{logical} Suppress warning messages? Default: \code{TRUE}} } \value{ -A list of assessments containing status information and results. +\code{list} of assessments containing status information and results. } \description{ Attempts to run one or more assessments (\code{lAssessments}) using shared data (\code{lData}) and metadata (\code{lMapping}). By default, the sample \code{rawplus} data from the {clindata} package is used, and all assessments defined in \code{inst/assessments} are evaluated. Individual assessments are run using \code{gsm::RunAssessment()} diff --git a/man/Study_AssessmentReport.Rd b/man/Study_AssessmentReport.Rd index 524791934..ce5639eea 100644 --- a/man/Study_AssessmentReport.Rd +++ b/man/Study_AssessmentReport.Rd @@ -12,7 +12,7 @@ Study_AssessmentReport(lAssessments, bViewReport = FALSE) \item{bViewReport}{HTML table of dfSummary that can be viewed in most IDEs.} } \value{ -\code{list} Returns a list containing a data.frame summarizing the checks \code{dfSummary} and a dataframe listing all checks (\code{dfAllChecks}) +\code{list} containing a \code{data.frame} summarizing the checks \code{dfSummary} and a \code{data.frame} listing all checks (\code{dfAllChecks}). } \description{ Make overview table with one row per assessment and one column per site showing flagged assessments. diff --git a/man/Study_Report.Rd b/man/Study_Report.Rd index faf30d7d1..d98d5a0c0 100644 --- a/man/Study_Report.Rd +++ b/man/Study_Report.Rd @@ -11,22 +11,22 @@ Study_Report( ) } \arguments{ -\item{lAssessments}{character vector listing assessments} +\item{lAssessments}{\code{list} The results of multiple assessments run using \code{Study_Assess}.} -\item{lMeta}{list of metadata related to study} +\item{lMeta}{\code{list} Metadata related to study.} -\item{strOutpath}{path to save the report} +\item{strOutpath}{\code{character} File path; location where the report will be saved.} } \value{ HTML report of study data. } \description{ -Pulls needed study data and runs one or more assessments +Create HTML summary report using the results of \code{Study_Assess}, including tables, charts, and error checking. } \examples{ \dontrun{ -assessment <- Study_Assess() -Study_Report(assessment, lMeta = list(study = "my study name")) +lAssessment <- Study_Assess() +Study_Report(lAssessment, lMeta = list(study = "my study name")) } } diff --git a/man/Transform_EventCount.Rd b/man/Transform_EventCount.Rd index 44a009e84..0116283df 100644 --- a/man/Transform_EventCount.Rd +++ b/man/Transform_EventCount.Rd @@ -21,10 +21,10 @@ Transform_EventCount( \item{strKRILabel}{Optional. Character vector to describe the \code{KRI} column.} } \value{ -data.frame with one row per site with columns SiteID, N, TotalCount with additional columns Exposure and Rate if strExposureCol is used. +\code{data.frame} with one row per site with columns SiteID, N, TotalCount with additional columns Exposure and Rate if strExposureCol is used. } \description{ -Convert from ADaM format to needed input format for Safety Assessment +Convert from input data format to needed input format to derive KRI for an Assessment. } \details{ This function transforms data to prepare it for the Analysis step diff --git a/man/Visualize_Count.Rd b/man/Visualize_Count.Rd index 033f274fc..04fbbf21e 100644 --- a/man/Visualize_Count.Rd +++ b/man/Visualize_Count.Rd @@ -21,13 +21,12 @@ Visualize_Count( \item{strTitle}{Title of plot. NULL by default.} } \value{ -site level plot object +site-level plot object. } \description{ Site-level visualization of site-level Inclusion/Exclusion results } \examples{ - IE_Input <- IE_Map_Raw() IE_Assess <- IE_Assess(IE_Input) Visualize_Count(IE_Assess$dfAnalyzed) diff --git a/man/Visualize_Scatter.Rd b/man/Visualize_Scatter.Rd index a058d75be..60d0ee135 100644 --- a/man/Visualize_Scatter.Rd +++ b/man/Visualize_Scatter.Rd @@ -14,7 +14,7 @@ Visualize_Scatter(dfFlagged, dfBounds = NULL, strUnit = "days") \item{strUnit}{exposure time unit. Defaults to "days".} } \value{ -site level plot object +site-level plot object. } \description{ Site-level visualization of site-level results using a Poisson or Wilcoxon model. diff --git a/man/generate_md_table.Rd b/man/generate_md_table.Rd index cade41700..61c2b6696 100644 --- a/man/generate_md_table.Rd +++ b/man/generate_md_table.Rd @@ -30,5 +30,5 @@ generate_md_table( \item{header}{\code{character} section header} } \description{ -Combine data mapping and specification then output as markdown table. +Combine data mapping and specification, and then output as markdown table. } diff --git a/man/parse_data_mapping.Rd b/man/parse_data_mapping.Rd index ca60aeae8..8ad3dbd4a 100644 --- a/man/parse_data_mapping.Rd +++ b/man/parse_data_mapping.Rd @@ -12,5 +12,5 @@ parse_data_mapping(content = NULL, file = NULL) \item{file}{\code{character} file path of .yaml file} } \description{ -Transform nested data mapping to tabular structure +Transform nested data mapping to tabular structure for use in documentation. } diff --git a/man/parse_data_spec.Rd b/man/parse_data_spec.Rd index ac9a80251..0f3e2c994 100644 --- a/man/parse_data_spec.Rd +++ b/man/parse_data_spec.Rd @@ -12,5 +12,5 @@ parse_data_spec(content = NULL, file = NULL) \item{file}{\code{character} file path of .yaml file} } \description{ -Transform nested data specification to tabular structure +Transform nested data specification to tabular structure for use in documentation. } diff --git a/man/rank_chg.Rd b/man/rank_chg.Rd index 9c596f342..bbd92fa49 100644 --- a/man/rank_chg.Rd +++ b/man/rank_chg.Rd @@ -2,13 +2,15 @@ % Please edit documentation in R/util-ReportHelpers.R \name{rank_chg} \alias{rank_chg} -\title{insert icon for status in gt table} +\title{Report Helper Functions} \usage{ rank_chg(status) } \arguments{ -\item{status}{boolean status} +\item{status}{\code{boolean} fontawesome emoji indicator that describes the status of error checking for all assessments run in \code{Study_Assess()}} } \description{ -from https://themockup.blog/posts/2020-10-31-embedding-custom-features-in-gt-tables/ +\code{rank_chg} - inserts icons for status in {gt} table. + +Adopted from https://themockup.blog/posts/2020-10-31-embedding-custom-features-in-gt-tables/. } From de82006abca272c8c00aa022706c31db5d06863a Mon Sep 17 00:00:00 2001 From: Matt Roumaya <40671730+mattroumaya@users.noreply.github.com> Date: Tue, 14 Jun 2022 09:22:25 -0400 Subject: [PATCH 65/87] Update vignettes/Cookbook.Rmd Co-authored-by: Spencer Childress --- vignettes/Cookbook.Rmd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vignettes/Cookbook.Rmd b/vignettes/Cookbook.Rmd index a1b925281..0b554b539 100644 --- a/vignettes/Cookbook.Rmd +++ b/vignettes/Cookbook.Rmd @@ -19,7 +19,7 @@ knitr::opts_chunk$set( This vignette contains a series of examples showing how to run analysis workflows for the {gsm} package using sample data from {clindata}. -For more information on of the {gsm} package see the [package homepage](https://silver-potato-cfe8c2fb.pages.github.io/). The [Data Pipeline Vignette](https://github.com/Gilead-BioStats/gsm/wiki/Data-Pipeline-Vignette) provides additional technical details including data specifications, and other technical details. +For more information on the {gsm} package see the [package homepage](https://silver-potato-cfe8c2fb.pages.github.io/). The [Data Pipeline Vignette](https://github.com/Gilead-BioStats/gsm/wiki/Data-Pipeline-Vignette) provides additional technical details including data specifications, and other technical details. ## Setup and Installation From 5e6bb29aabc25078cd698ee9bf3f47986c1e6605 Mon Sep 17 00:00:00 2001 From: Matt Roumaya <40671730+mattroumaya@users.noreply.github.com> Date: Tue, 14 Jun 2022 09:22:38 -0400 Subject: [PATCH 66/87] Update vignettes/Cookbook.Rmd Co-authored-by: Spencer Childress --- vignettes/Cookbook.Rmd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vignettes/Cookbook.Rmd b/vignettes/Cookbook.Rmd index 0b554b539..b2003c131 100644 --- a/vignettes/Cookbook.Rmd +++ b/vignettes/Cookbook.Rmd @@ -180,7 +180,7 @@ Note that `Study_Assess()` provides verbose console output alerting the user to ## Example 4 - Filtering Subject-Level Data For Multiple Assessments -Let's take a closer look at functionality that is built into `Study_Assess()`. As a practical example, a user may want to keep subjects from an assessment based on a some criteria (e.g., a specific site, region, etc.). +Let's take a closer look at functionality that is built into `Study_Assess()`. As a practical example, a user may want to keep subjects from an assessment based on some criteria (e.g., a specific site, region, etc.). This can be done by performing some preliminary data wrangling before passing the subject-level data to `lData`, but for the example below, we will use a custom `lMapping` and a named list passed to `lSubjFilters`. (For a more detailed overview of mapping specifications, refer to the [Data Pipeline Vignette](https://github.com/Gilead-BioStats/gsm/wiki/Data-Pipeline-Vignette).) From 54e26756aa907dfd7ae8384b94d832f6d453eabf Mon Sep 17 00:00:00 2001 From: Matt Roumaya <40671730+mattroumaya@users.noreply.github.com> Date: Tue, 14 Jun 2022 09:22:54 -0400 Subject: [PATCH 67/87] Update vignettes/Cookbook.Rmd Co-authored-by: Spencer Childress --- vignettes/Cookbook.Rmd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vignettes/Cookbook.Rmd b/vignettes/Cookbook.Rmd index b2003c131..38078172a 100644 --- a/vignettes/Cookbook.Rmd +++ b/vignettes/Cookbook.Rmd @@ -291,7 +291,7 @@ Creating a scatter plot for a Wilcoxon model is similar to the example above, bu # Custom Mapping/YAML Specs -As mentioned in the [Data Pipeline Vignette](https://github.com/Gilead-BioStats/gsm/wiki/Data-Pipeline-Vignette#metadata-technical-specifications), `Study_Assess()` triggers a workflow that uses pre-defined YAML specs that organizes all of the required metadata for a given assessment or set of assessments. +As mentioned in the [Data Pipeline Vignette](https://github.com/Gilead-BioStats/gsm/wiki/Data-Pipeline-Vignette#metadata-technical-specifications), `Study_Assess()` triggers a workflow that uses pre-defined YAML specs that organize all of the required metadata for a given assessment or set of assessments. In some cases, the user might want to configure their own mappings, which can be done by providing custom YAML mappings for one or more assessments. From c3a0e709a9ac6b4f56a936f67dfe7a4d453e3e5d Mon Sep 17 00:00:00 2001 From: Matt Roumaya Date: Tue, 14 Jun 2022 14:25:13 +0000 Subject: [PATCH 68/87] add code fencing, udpate formatting --- vignettes/Cookbook.Rmd | 311 ++++++++++++++++++++----------------- vignettes/DataPipeline.Rmd | 2 +- 2 files changed, 170 insertions(+), 143 deletions(-) diff --git a/vignettes/Cookbook.Rmd b/vignettes/Cookbook.Rmd index 38078172a..208c5e995 100644 --- a/vignettes/Cookbook.Rmd +++ b/vignettes/Cookbook.Rmd @@ -27,24 +27,29 @@ For more information on the {gsm} package see the [package homepage](https://sil Run the following: - ## Install devtools - install.packages('devtools') +```{r eval = FALSE, include = TRUE} +## Install devtools +install.packages('devtools') - ## Install and load sample raw data - devtools::install_github("Gilead-BioStats/clindata", ref = "main") - library(clindata) +## Install and load sample raw data +devtools::install_github("Gilead-BioStats/clindata", ref = "main") +library(clindata) - ## Install and load sample SDTM and AdAM data - install.packages('safetyData') - library(safetyData) +## Install and load sample SDTM and AdAM data +install.packages('safetyData') +library(safetyData) - ## Install and load gsm - devtools::install_github("Gilead-BioStats/gsm", ref = "main") - library(gsm) +## Install and load gsm +devtools::install_github("Gilead-BioStats/gsm", ref = "main") +library(gsm) To use the most recent development version from GitHub, run: +``` + +```{r eval = FALSE, include = TRUE} +devtools::install_github("Gilead-BioStats/gsm", ref = "dev") +``` - devtools::install_github("Gilead-BioStats/gsm", ref = "dev") ## Example 1 - Running a Single Assessment @@ -57,18 +62,20 @@ Running a single assessment is a 2-step process: Putting this all together for the AE Assessment looks like this: - library(clindata) - library(safetyData) - library(gsm) +```{r eval = FALSE, include = TRUE} +library(clindata) +library(safetyData) +library(gsm) - # Map Domain-level data to the input data standard for the selected assessment - dfInput <- AE_Map_Raw() +# Map Domain-level data to the input data standard for the selected assessment +dfInput <- AE_Map_Raw() - # Run the assessment - ae_assess <- AE_Assess(dfInput) +# Run the assessment +ae_assess <- AE_Assess(dfInput) - # Run the assessment using the Wilcoxon statistical model - ae_assess_wilcoxon <- AE_Assess(dfInput, strMethod = "wilcoxon") +# Run the assessment using the Wilcoxon statistical model +ae_assess_wilcoxon <- AE_Assess(dfInput, strMethod = "wilcoxon") +``` Each assessment has representative examples in the help files - the example above was adapted from the example in `?AE_Assess`. @@ -76,46 +83,48 @@ Each assessment has representative examples in the help files - the example abov Next, let's run the same assessment above, but this time using non-standard data. {gsm} is configured to accept Raw+ data by default, so for non-standard data, the user must perform some data transformations to pass to a mapping function. - library(gsm) - library(clindata) - library(dplyr) - - # Configure raw AE data for correct input for dfAE - dfAE <- clindata::raw_ae %>% - select( - SubjectID = SUBJID, - AE_SERIOUS = AESER - ) %>% - mutate( - AE_TE_FLAG = sample(c(TRUE, FALSE), n(), replace = TRUE), - AE_GRADE = sample(1:4, n(), replace = TRUE) - ) %>% - filter( - !is.na(SubjectID) & SubjectID != "" - ) - - # Configure raw subject-level data for correct input for dfSUBJ - dfSUBJ <- clindata::CreateSUBJ( - dfDm = clindata::raw_dm, - dfIXRSrand = clindata::raw_iwrsrand, - dfEx = clindata::raw_ex, - dfVisit = clindata::raw_visdt, - dfStud = clindata::raw_studcomp, - dfSdrg = clindata::raw_sdrgcomp - ) %>% - filter( - !is.na(TimeOnTreatment), - !is.na(SubjectID) & SubjectID != "" - ) - - # Map Domain-level data to the input data standard for the selected assessment - dfInput <- AE_Map_Raw( - dfs = list(dfAE = dfAE, dfSUBJ = dfSUBJ), - bQuiet = FALSE - ) - - # Run the assessment - ae_assess <- AE_Assess(dfInput) +```{r eval = FALSE, include = TRUE} +library(gsm) +library(clindata) +library(dplyr) + +# Configure raw AE data for correct input for dfAE +dfAE <- clindata::raw_ae %>% + select( + SubjectID = SUBJID, + AE_SERIOUS = AESER + ) %>% + mutate( + AE_TE_FLAG = sample(c(TRUE, FALSE), n(), replace = TRUE), + AE_GRADE = sample(1:4, n(), replace = TRUE) + ) %>% + filter( + !is.na(SubjectID) & SubjectID != "" + ) + +# Configure raw subject-level data for correct input for dfSUBJ +dfSUBJ <- clindata::CreateSUBJ( + dfDm = clindata::raw_dm, + dfIXRSrand = clindata::raw_iwrsrand, + dfEx = clindata::raw_ex, + dfVisit = clindata::raw_visdt, + dfStud = clindata::raw_studcomp, + dfSdrg = clindata::raw_sdrgcomp +) %>% + filter( + !is.na(TimeOnTreatment), + !is.na(SubjectID) & SubjectID != "" + ) + +# Map Domain-level data to the input data standard for the selected assessment +dfInput <- AE_Map_Raw( + dfs = list(dfAE = dfAE, dfSUBJ = dfSUBJ), + bQuiet = FALSE +) + +# Run the assessment +ae_assess <- AE_Assess(dfInput) +``` ### Troubleshooting Tips @@ -133,48 +142,52 @@ Running multiple assessments in {gsm} is made possible by the `Study_Assess()` f To run multiple assessments using sample data from {clindata}, simply run the following: - library(gsm) - library(clindata) - library(safetyData) +```{r eval = FALSE, include = TRUE} +library(gsm) +library(clindata) +library(safetyData) - # Run multiple assessments - multiple_assessments <- Study_Assess() +# Run multiple assessments +multiple_assessments <- Study_Assess() +``` ### Using user-provided Raw+ data For the scope of this example, the data found in {clindata} will pose as user-provided Raw+ data, but this will likely come from Raw+ case report data. -The example below illustrates that a user can pass a \_named\*\_ list of Raw+ data to the `lData` parameter. - -*\*`lData` expects a named list. To see a list of default data frame names, run* `names(clindata::mapping_rawplus)` +The example below illustrates that a user can pass a named list of Raw+ data to the `lData` parameter. - library(gsm) - library(clindata) - library(dplyr) +As mentioned above, note that `lData` expects a _named_ list. To see a list of default data frame names, run `names(clindata::mapping_rawplus)` - # Include AE data where AE_GRADE is greater than 1 - dfAE <- clindata::rawplus_ae %>% - filter( - AE_GRADE > 1 - ) - - # Specify Raw+ data domains - dfSUBJ <- clindata::rawplus_subj - dfIE <- clindata::rawplus_ie - dfPD <- clindata::rawplus_pd - dfCONSENT <- clindata::rawplus_consent - - # Create named list of assessment data - assessment_data <- list( - dfAE = dfAE, - dfIE = dfIE, - dfPD = dfPD, - dfCONSENT = dfCONSENT, - dfSUBJ = dfSUBJ - ) +```{r eval = FALSE, include = TRUE} +library(gsm) +library(clindata) +library(dplyr) + +# Include AE data where AE_GRADE is greater than 1 +dfAE <- clindata::rawplus_ae %>% + filter( + AE_GRADE > 1 + ) + +# Specify Raw+ data domains +dfSUBJ <- clindata::rawplus_subj +dfIE <- clindata::rawplus_ie +dfPD <- clindata::rawplus_pd +dfCONSENT <- clindata::rawplus_consent + +# Create named list of assessment data +assessment_data <- list( + dfAE = dfAE, + dfIE = dfIE, + dfPD = dfPD, + dfCONSENT = dfCONSENT, + dfSUBJ = dfSUBJ +) - # Run multiple assessments - multiple_assessments <- Study_Assess(lData = assessment_data) +# Run multiple assessments +multiple_assessments <- Study_Assess(lData = assessment_data) +``` Note that `Study_Assess()` provides verbose console output alerting the user to success, warnings, or errors with the workflow. @@ -186,23 +199,27 @@ This can be done by performing some preliminary data wrangling before passing th For this example, we will only keep subjects who have `SiteID == "X010X"`: - library(gsm) - library(clindata) - library(dplyr) +```{r eval = FALSE, include = TRUE} +library(gsm) +library(clindata) +library(dplyr) + +# Start with the default lMapping +custom_mapping <- yaml::read_yaml(system.file("mappings", "mapping_rawplus.yaml", package = "gsm")) - # Start with the default lMapping - custom_mapping <- yaml::read_yaml(system.file("mappings", "mapping_rawplus.yaml", package = "gsm")) +# Add the value to filter on to the custom mapping for dfSUBJ +custom_mapping$dfSUBJ$strSiteVal <- "X010X" - # Add the value to filter on to the custom mapping for dfSUBJ - custom_mapping$dfSUBJ$strSiteVal <- "X010X" +# Create a list to pass to lSubjFilters +custom_filter <- list( + strSiteCol = "strSiteVal" +) + +# Run the assessments +multiple_assessments <- Study_Assess(lMapping = custom_mapping, lSubjFilters = custom_filter) +``` - # Create a list to pass to lSubjFilters - custom_filter <- list( - strSiteCol = "strSiteVal" - ) - # Run the assessments - multiple_assessments <- Study_Assess(lMapping = custom_mapping, lSubjFilters = custom_filter) Note that `Study_Assess()` provides detailed information about `FilterDomain()`, which shows the number of rows dropped when filtering subject-level data: @@ -220,12 +237,14 @@ The `Study_Report()` function creates the **Assessment Overview Report**, which Let's create a report using sample data from {clindata}: - library(gsm) - library(clindata) +```{r eval = FALSE, include = TRUE} +library(gsm) +library(clindata) - multiple_assessments <- Study_Assess() +multiple_assessments <- Study_Assess() - Study_Report(lAssessments = multiple_assessments, lMeta = list(label = "My Study")) +Study_Report(lAssessments = multiple_assessments, lMeta = list(label = "My Study")) +``` The report will render and be saved to your current working directory. You can optionally set an output directory using the `strOutpath` parameter. @@ -235,16 +254,18 @@ The **Assessment Overview Report** contains a Data Check Summary table in the ap To view the report directly as an object in your IDE, run: - library(gsm) - library(clindata) +```{r eval = FALSE, include = TRUE} +library(gsm) +library(clindata) - multiple_assessments <- Study_Assess() +multiple_assessments <- Study_Assess() - Study_AssessmentReport(lAssessments = multiple_assessments, bViewReport = TRUE) +Study_AssessmentReport(lAssessments = multiple_assessments, bViewReport = TRUE) +``` # Visualizations -By default, all `*_Assess()` functions return a visualization whether run individually or in the `Study_Assess()` workflow. +By default, all `*_Assess()` functions return a visualization whether run individually or in the `Study_Assess()` workflow. For example, the scatter plot for the AE assessment can be viewed by calling `AE_Assess(dfInput)$chart`. ## Example 7 - Creating a Scatter Plot @@ -254,40 +275,46 @@ In some cases, a user may want to produce a visualization separately to make add Below is an example using the default Poisson statistical model for `AE_Assess()`: - library(gsm) - library(clindata) +```{r eval = FALSE, include = TRUE} +library(gsm) +library(clindata) + +# Map Domain-level data to the input data standard for the selected assessment +dfInput <- AE_Map_Raw() - # Map Domain-level data to the input data standard for the selected assessment - dfInput <- AE_Map_Raw() +# Run the assessment +ae_assessment <- AE_Assess(dfInput) - # Run the assessment - ae_assessment <- AE_Assess(dfInput) +# Create threshold boundaries +dfBounds <- Analyze_Poisson_PredictBounds( + dfTransformed = ae_assessment$dfTransformed, + vThreshold = c(-5, 5) + ) + +# Create the visualization +Visualize_Scatter( + dfFlagged = ae_assessment$dfFlagged, + dfBounds = dfBounds + ) +``` - # Create threshold boundaries - dfBounds <- Analyze_Poisson_PredictBounds( - dfTransformed = ae_assessment$dfTransformed, - vThreshold = c(-5, 5) - ) - # Create the visualization - Visualize_Scatter( - dfFlagged = ae_assessment$dfFlagged, - dfBounds = dfBounds - ) Creating a scatter plot for a Wilcoxon model is similar to the example above, but there are no threshold boundaries. - library(gsm) - library(clindata) +```{r eval = FALSE, include = TRUE} +library(gsm) +library(clindata) - # Map Domain-level data to the input data standard for the selected assessment - dfInput <- AE_Map_Raw() +# Map Domain-level data to the input data standard for the selected assessment +dfInput <- AE_Map_Raw() - # Run the assessment - ae_assessment <- AE_Assess(dfInput, strMethod = "wilcoxon") +# Run the assessment +ae_assessment <- AE_Assess(dfInput, strMethod = "wilcoxon") - # Create the visualization - Visualize_Scatter(dfFlagged = ae_assessment$dfFlagged) +# Create the visualization +Visualize_Scatter(dfFlagged = ae_assessment$dfFlagged) +``` # Custom Mapping/YAML Specs @@ -356,8 +383,8 @@ After setting up a custom YAML mapping, there are a few more steps in setting up 6. Add the value to sort `strTypeCol` on. 7. Run the `Study_Assess()` workflow. -``` r - library(gsm) +```{r eval = FALSE, include = TRUE} +library(gsm) library(clindata) library(yaml) diff --git a/vignettes/DataPipeline.Rmd b/vignettes/DataPipeline.Rmd index 25783ad2a..8edc366d4 100644 --- a/vignettes/DataPipeline.Rmd +++ b/vignettes/DataPipeline.Rmd @@ -102,7 +102,7 @@ Each mapping object lists the required parameters for all required data domains For example, the following could be passed to the `mapping` parameter for the `AE_Map_Raw()` function to be used with the default data from `clindata::rawplus_AE` and `clindata::rawplus_SUBJ`: -``` +```{r eval = FALSE, include = TRUE} list( dfAE = list(strIDCol = 'SubjectID'), dfSUBJ = list( From 180781ac5298f4fcac67238dd897995078daabc2 Mon Sep 17 00:00:00 2001 From: Matt Roumaya Date: Tue, 14 Jun 2022 14:37:18 +0000 Subject: [PATCH 69/87] change inst/assessments to inst/workflow --- R/Study_Assess.R | 6 ++--- R/util-MakeAssessmentList.R | 4 ++-- inst/assessments/ae.yaml | 23 ------------------ inst/assessments/consent.yaml | 14 ----------- inst/assessments/ie.yaml | 14 ----------- inst/assessments/importantpd.yaml | 22 ----------------- inst/assessments/pd.yaml | 15 ------------ inst/assessments/sae.yaml | 30 ------------------------ tests/testthat/test_util-runAssessment.R | 2 +- 9 files changed, 6 insertions(+), 124 deletions(-) delete mode 100644 inst/assessments/ae.yaml delete mode 100644 inst/assessments/consent.yaml delete mode 100644 inst/assessments/ie.yaml delete mode 100644 inst/assessments/importantpd.yaml delete mode 100644 inst/assessments/pd.yaml delete mode 100644 inst/assessments/sae.yaml diff --git a/R/Study_Assess.R b/R/Study_Assess.R index 8b422b41b..3146baf7f 100644 --- a/R/Study_Assess.R +++ b/R/Study_Assess.R @@ -1,10 +1,10 @@ #' Run Multiple Assessments on a Study #' -#' Attempts to run one or more assessments (`lAssessments`) using shared data (`lData`) and metadata (`lMapping`). By default, the sample `rawplus` data from the {clindata} package is used, and all assessments defined in `inst/assessments` are evaluated. Individual assessments are run using `gsm::RunAssessment()` +#' Attempts to run one or more assessments (`lAssessments`) using shared data (`lData`) and metadata (`lMapping`). By default, the sample `rawplus` data from the {clindata} package is used, and all assessments defined in `inst/workflow` are evaluated. Individual assessments are run using `gsm::RunAssessment()` #' #' @param lData a named list of domain level data frames. Names should match the values specified in `lMapping` and `lAssessments`, which are generally based on the expected inputs from `X_Map_Raw`. #' @param lMapping a named list identifying the columns needed in each data domain. -#' @param lAssessments a named list of metadata defining how each assessment should be run. By default, `MakeAssessmentList()` imports YAML specifications from `inst/assessments`. +#' @param lAssessments a named list of metadata defining how each assessment should be run. By default, `MakeAssessmentList()` imports YAML specifications from `inst/workflow`. #' @param lSubjFilters a named list of parameters to filter subject-level data on. #' @param lTags a named list of Tags to be passed to each assessment. Default is `list(Study="myStudy")` could be expanded to include other important metadata such as analysis population or study phase. #' @param bQuiet Default is TRUE, which means warning messages are suppressed. Set to FALSE to see warning messages. @@ -58,7 +58,7 @@ Study_Assess <- function( lMapping <- clindata::mapping_rawplus } - # lAssessments from gsm inst/assessments + # lAssessments from gsm inst/workflow if (is.null(lAssessments)) { lAssessments <- MakeAssessmentList() } diff --git a/R/util-MakeAssessmentList.R b/R/util-MakeAssessmentList.R index c7c14786a..dfa02f816 100644 --- a/R/util-MakeAssessmentList.R +++ b/R/util-MakeAssessmentList.R @@ -8,7 +8,7 @@ #' @param package `character` package with assessments #' #' @examples -#' MakeAssessmentList(path = "assessments", package = "gsm") +#' MakeAssessmentList(path = "workflow", package = "gsm") #' #' @return `list` A list of assessments with workflow and parameter metadata. #' @@ -18,7 +18,7 @@ #' #' @export -MakeAssessmentList <- function(path = "assessments", package = "gsm") { +MakeAssessmentList <- function(path = "workflow", package = "gsm") { if (!is.null(package)) { path <- system.file(path, package = "gsm") } diff --git a/inst/assessments/ae.yaml b/inst/assessments/ae.yaml deleted file mode 100644 index 77bfe7e69..000000000 --- a/inst/assessments/ae.yaml +++ /dev/null @@ -1,23 +0,0 @@ -tags: - Assessment: Safety - Label: AEs -workflow: - - name: FilterDomain - inputs: dfAE - output: dfAE - params: - strDomain: dfAE - strColParam: strTreatmentEmergentCol - strValParam: strTreatmentEmergentVal - - name: AE_Map_Raw - inputs: - - dfAE - - dfSUBJ - output: dfInput - - name: AE_Assess - inputs: dfInput - output: lResults - params: - vThreshold: null - strMethod: "poisson" - strKRILabel: "Treatment-Emergent AEs/Week" diff --git a/inst/assessments/consent.yaml b/inst/assessments/consent.yaml deleted file mode 100644 index d79ac5cc9..000000000 --- a/inst/assessments/consent.yaml +++ /dev/null @@ -1,14 +0,0 @@ -tags: - Assessment: Consent - Label: Consent -workflow: - - name: Consent_Map_Raw - inputs: - - dfCONSENT - - dfSUBJ - output: dfInput - - name: Consent_Assess - inputs: dfInput - output: lResults - params: - nThreshold: 0.5 diff --git a/inst/assessments/ie.yaml b/inst/assessments/ie.yaml deleted file mode 100644 index 78b41d55b..000000000 --- a/inst/assessments/ie.yaml +++ /dev/null @@ -1,14 +0,0 @@ -tags: - Assessment: IE - Label: IE -workflow: - - name: IE_Map_Raw - inputs: - - dfIE - - dfSUBJ - output: dfInput - - name: IE_Assess - inputs: dfInput - output: lResults - params: - nThreshold: 0.5 diff --git a/inst/assessments/importantpd.yaml b/inst/assessments/importantpd.yaml deleted file mode 100644 index 8145be1de..000000000 --- a/inst/assessments/importantpd.yaml +++ /dev/null @@ -1,22 +0,0 @@ -tags: - Assessment: PD - Label: Important PD -workflow: - - name: FilterDomain - inputs: dfPD - output: dfPD - params: - strDomain: dfPD - strColParam: strImportantCol - strValParam: strImportantVal - - name: PD_Map_Raw - inputs: - - dfPD - - dfSUBJ - output: dfInput - - name: PD_Assess - inputs: dfInput - output: lResults - params: - vThreshold: null - strMethod: "poisson" diff --git a/inst/assessments/pd.yaml b/inst/assessments/pd.yaml deleted file mode 100644 index b0a9907f1..000000000 --- a/inst/assessments/pd.yaml +++ /dev/null @@ -1,15 +0,0 @@ -tags: - Assessment: PD - Label: PD -workflow: - - name: PD_Map_Raw - inputs: - - dfPD - - dfSUBJ - output: dfInput - - name: PD_Assess - inputs: dfInput - output: lResults - params: - vThreshold: null - strMethod: "poisson" diff --git a/inst/assessments/sae.yaml b/inst/assessments/sae.yaml deleted file mode 100644 index ebf118535..000000000 --- a/inst/assessments/sae.yaml +++ /dev/null @@ -1,30 +0,0 @@ -tags: - Assessment: Safety - Label: AEs Serious -workflow: - - name: FilterDomain - inputs: dfAE - output: dfAE - params: - strDomain: dfAE - strColParam: strTreatmentEmergentCol - strValParam: strTreatmentEmergentVal - - name: FilterDomain - inputs: dfAE - output: dfAE - params: - strDomain: dfAE - strColParam: strSeriousCol - strValParam: strSeriousVal - - name: AE_Map_Raw - inputs: - - dfAE - - dfSUBJ - output: dfInput - - name: AE_Assess - inputs: dfInput - output: lResults - params: - vThreshold: null - strMethod: "poisson" - strKRILabel: "Serious Treatment-Emergent AEs/Week" diff --git a/tests/testthat/test_util-runAssessment.R b/tests/testthat/test_util-runAssessment.R index 36f66a940..7aca7d7ac 100644 --- a/tests/testthat/test_util-runAssessment.R +++ b/tests/testthat/test_util-runAssessment.R @@ -1,5 +1,5 @@ source(testthat::test_path("testdata/data.R")) -sae_meta <- yaml::read_yaml(system.file("assessments/sae.yaml", package = "gsm")) +sae_meta <- yaml::read_yaml(system.file("workflow/sae.yaml", package = "gsm")) rawDataMap <- clindata::mapping_rawplus dfAE <- dfAE %>% From a6af29bff40e5c77cb940fe969b1d681047b139b Mon Sep 17 00:00:00 2001 From: Matt Roumaya Date: Tue, 14 Jun 2022 14:37:46 +0000 Subject: [PATCH 70/87] add yaml --- inst/workflow/ae.yaml | 23 +++++++++++++++++++++++ inst/workflow/consent.yaml | 14 ++++++++++++++ inst/workflow/ie.yaml | 14 ++++++++++++++ inst/workflow/importantpd.yaml | 22 ++++++++++++++++++++++ inst/workflow/pd.yaml | 15 +++++++++++++++ inst/workflow/sae.yaml | 30 ++++++++++++++++++++++++++++++ 6 files changed, 118 insertions(+) create mode 100644 inst/workflow/ae.yaml create mode 100644 inst/workflow/consent.yaml create mode 100644 inst/workflow/ie.yaml create mode 100644 inst/workflow/importantpd.yaml create mode 100644 inst/workflow/pd.yaml create mode 100644 inst/workflow/sae.yaml diff --git a/inst/workflow/ae.yaml b/inst/workflow/ae.yaml new file mode 100644 index 000000000..77bfe7e69 --- /dev/null +++ b/inst/workflow/ae.yaml @@ -0,0 +1,23 @@ +tags: + Assessment: Safety + Label: AEs +workflow: + - name: FilterDomain + inputs: dfAE + output: dfAE + params: + strDomain: dfAE + strColParam: strTreatmentEmergentCol + strValParam: strTreatmentEmergentVal + - name: AE_Map_Raw + inputs: + - dfAE + - dfSUBJ + output: dfInput + - name: AE_Assess + inputs: dfInput + output: lResults + params: + vThreshold: null + strMethod: "poisson" + strKRILabel: "Treatment-Emergent AEs/Week" diff --git a/inst/workflow/consent.yaml b/inst/workflow/consent.yaml new file mode 100644 index 000000000..d79ac5cc9 --- /dev/null +++ b/inst/workflow/consent.yaml @@ -0,0 +1,14 @@ +tags: + Assessment: Consent + Label: Consent +workflow: + - name: Consent_Map_Raw + inputs: + - dfCONSENT + - dfSUBJ + output: dfInput + - name: Consent_Assess + inputs: dfInput + output: lResults + params: + nThreshold: 0.5 diff --git a/inst/workflow/ie.yaml b/inst/workflow/ie.yaml new file mode 100644 index 000000000..78b41d55b --- /dev/null +++ b/inst/workflow/ie.yaml @@ -0,0 +1,14 @@ +tags: + Assessment: IE + Label: IE +workflow: + - name: IE_Map_Raw + inputs: + - dfIE + - dfSUBJ + output: dfInput + - name: IE_Assess + inputs: dfInput + output: lResults + params: + nThreshold: 0.5 diff --git a/inst/workflow/importantpd.yaml b/inst/workflow/importantpd.yaml new file mode 100644 index 000000000..8145be1de --- /dev/null +++ b/inst/workflow/importantpd.yaml @@ -0,0 +1,22 @@ +tags: + Assessment: PD + Label: Important PD +workflow: + - name: FilterDomain + inputs: dfPD + output: dfPD + params: + strDomain: dfPD + strColParam: strImportantCol + strValParam: strImportantVal + - name: PD_Map_Raw + inputs: + - dfPD + - dfSUBJ + output: dfInput + - name: PD_Assess + inputs: dfInput + output: lResults + params: + vThreshold: null + strMethod: "poisson" diff --git a/inst/workflow/pd.yaml b/inst/workflow/pd.yaml new file mode 100644 index 000000000..b0a9907f1 --- /dev/null +++ b/inst/workflow/pd.yaml @@ -0,0 +1,15 @@ +tags: + Assessment: PD + Label: PD +workflow: + - name: PD_Map_Raw + inputs: + - dfPD + - dfSUBJ + output: dfInput + - name: PD_Assess + inputs: dfInput + output: lResults + params: + vThreshold: null + strMethod: "poisson" diff --git a/inst/workflow/sae.yaml b/inst/workflow/sae.yaml new file mode 100644 index 000000000..ebf118535 --- /dev/null +++ b/inst/workflow/sae.yaml @@ -0,0 +1,30 @@ +tags: + Assessment: Safety + Label: AEs Serious +workflow: + - name: FilterDomain + inputs: dfAE + output: dfAE + params: + strDomain: dfAE + strColParam: strTreatmentEmergentCol + strValParam: strTreatmentEmergentVal + - name: FilterDomain + inputs: dfAE + output: dfAE + params: + strDomain: dfAE + strColParam: strSeriousCol + strValParam: strSeriousVal + - name: AE_Map_Raw + inputs: + - dfAE + - dfSUBJ + output: dfInput + - name: AE_Assess + inputs: dfInput + output: lResults + params: + vThreshold: null + strMethod: "poisson" + strKRILabel: "Serious Treatment-Emergent AEs/Week" From 5a1cead56f5612f80e6c39883493a0b5bd66310a Mon Sep 17 00:00:00 2001 From: Matt Roumaya Date: Tue, 14 Jun 2022 14:51:28 +0000 Subject: [PATCH 71/87] update documentation --- man/Analyze_Fisher.Rd | 2 +- man/MakeAssessmentList.Rd | 4 ++-- man/Study_Assess.Rd | 4 ++-- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/man/Analyze_Fisher.Rd b/man/Analyze_Fisher.Rd index a9da234c7..72b359a32 100644 --- a/man/Analyze_Fisher.Rd +++ b/man/Analyze_Fisher.Rd @@ -41,7 +41,7 @@ The input data (\code{dfTransformed}) for Analyze_Fisher is typically created us \examples{ dfInput <- Disp_Map(dfDisp = safetyData::adam_adsl, strCol = "DCREASCD", strReason = "Adverse Event") -dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strKRILabel = "Discontinuations due to AE/Month") +dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strKRILabel = "Discontinuations due to AE") dfAnalyzed <- Analyze_Fisher(dfTransformed) } diff --git a/man/MakeAssessmentList.Rd b/man/MakeAssessmentList.Rd index acbc5e0df..5ab95b24b 100644 --- a/man/MakeAssessmentList.Rd +++ b/man/MakeAssessmentList.Rd @@ -4,7 +4,7 @@ \alias{MakeAssessmentList} \title{Load assessments from a package/directory} \usage{ -MakeAssessmentList(path = "assessments", package = "gsm") +MakeAssessmentList(path = "workflow", package = "gsm") } \arguments{ \item{path}{\code{character} The location of assessment YAML files. If package is specified, function will look in \verb{/inst} folder.} @@ -21,6 +21,6 @@ Load assessments from a package/directory \code{MakeAssessmentList()} is a utility function that creates a workflow mapping for assessments used in \code{Study_Assess()}. } \examples{ -MakeAssessmentList(path = "assessments", package = "gsm") +MakeAssessmentList(path = "workflow", package = "gsm") } diff --git a/man/Study_Assess.Rd b/man/Study_Assess.Rd index 751b4ca20..f5bd3351b 100644 --- a/man/Study_Assess.Rd +++ b/man/Study_Assess.Rd @@ -18,7 +18,7 @@ Study_Assess( \item{lMapping}{a named list identifying the columns needed in each data domain.} -\item{lAssessments}{a named list of metadata defining how each assessment should be run. By default, \code{MakeAssessmentList()} imports YAML specifications from \code{inst/assessments}.} +\item{lAssessments}{a named list of metadata defining how each assessment should be run. By default, \code{MakeAssessmentList()} imports YAML specifications from \code{inst/workflow}.} \item{lSubjFilters}{a named list of parameters to filter subject-level data on.} @@ -30,7 +30,7 @@ Study_Assess( A list of assessments containing status information and results. } \description{ -Attempts to run one or more assessments (\code{lAssessments}) using shared data (\code{lData}) and metadata (\code{lMapping}). By default, the sample \code{rawplus} data from the {clindata} package is used, and all assessments defined in \code{inst/assessments} are evaluated. Individual assessments are run using \code{gsm::RunAssessment()} +Attempts to run one or more assessments (\code{lAssessments}) using shared data (\code{lData}) and metadata (\code{lMapping}). By default, the sample \code{rawplus} data from the {clindata} package is used, and all assessments defined in \code{inst/workflow} are evaluated. Individual assessments are run using \code{gsm::RunAssessment()} } \examples{ results <- Study_Assess() # run using defaults From 7a5b7459cc9a266bde7f928cfc354f23363563d8 Mon Sep 17 00:00:00 2001 From: Spencer Childress Date: Tue, 14 Jun 2022 11:58:47 -0400 Subject: [PATCH 72/87] modularize input and output tests for map_raw functions --- R/tests-map_raw_helpers.R | 94 +++++----- inst/mappings/IE_Assess.yaml | 2 - tests/testthat/_snaps/AE_Map_Raw.md | 144 ++++++++++----- tests/testthat/_snaps/Consent_Map_Raw.md | 213 ++++++++++++++--------- tests/testthat/_snaps/IE_Map_Raw.md | 176 +++++++++++-------- tests/testthat/_snaps/PD_Map_Raw.md | 163 ++++++++--------- tests/testthat/test_AE_Map_Raw.R | 45 +++-- tests/testthat/test_Consent_Map_Raw.R | 47 ++--- tests/testthat/test_IE_Map_Raw.R | 48 +++-- tests/testthat/test_PD_Map_Raw.R | 45 +++-- 10 files changed, 532 insertions(+), 445 deletions(-) diff --git a/R/tests-map_raw_helpers.R b/R/tests-map_raw_helpers.R index 7477370a8..22d686003 100644 --- a/R/tests-map_raw_helpers.R +++ b/R/tests-map_raw_helpers.R @@ -1,4 +1,24 @@ -# TODO: finish modularizing map_raw unit tests +test_correct_output <- function( + map_function, + df_domain, + df_name, + dfSUBJ, + output_mapping +) { + dfs <- list( + dfSUBJ = dfSUBJ + ) + dfs[[ df_name ]] <- df_domain + + output <- map_function(dfs = dfs) + + expect_true(is.data.frame(output)) + expect_equal(names(output), as.character(output_mapping$dfInput)) + expect_type(output$SubjectID, "character") + expect_type(output$SiteID, "character") + expect_true(class(output$Count) %in% c("double", "integer", "numeric")) +} + test_incorrect_inputs <- function( map_function, df_domain, @@ -6,45 +26,41 @@ test_incorrect_inputs <- function( dfSUBJ, spec ) { - # incorrect inputs throw errors ------------------------------------------- - test_that("incorrect inputs throw errors", { - dfs <- list( - dfSUBJ = dfSUBJ - ) - dfs[[ df_name ]] <- df_domain - - # empty data frames - expect_snapshot(map_function(dfs = imap(dfs, ~ list()), bQuiet = F)) - expect_snapshot(map_function(dfs = imap(dfs, ~ if (.y == 'dfSUBJ') list() else .x), bQuiet = F)) - expect_snapshot(map_function(dfs = imap(dfs, ~ if (.y == df_name) list() else .x), bQuiet = F)) - - # mistyped data frames - expect_snapshot(map_function(dfs = imap(dfs, ~ 'Hi Mom'), bQuiet = F)) - expect_snapshot(map_function(dfs = imap(dfs, ~ 9999), bQuiet = F)) - expect_snapshot(map_function(dfs = imap(dfs, ~ TRUE), bQuiet = F)) - - # empty mapping - expect_snapshot(map_function(dfs = imap(dfs, ~ .x), lMapping = list(), bQuiet = F)) - - # missing variables - for (domain in names(spec)) { - required_columns <- spec[[ domain ]]$vRequired - for (column in required_columns) { - dfs_edited <- dfs - dfs_edited[[ domain ]][[ column ]] <- NULL - print(names(dfs_edited[[ domain ]])) - expect_snapshot( - map_function( - dfs = dfs_edited, - bQuiet = F - ) + dfs <- list( + dfSUBJ = dfSUBJ + ) + dfs[[ df_name ]] <- df_domain + + # empty data frames + expect_snapshot(map_function(dfs = purrr::imap(dfs, ~ list()), bQuiet = F)) + expect_snapshot(map_function(dfs = purrr::imap(dfs, ~ if (.y == 'dfSUBJ') list() else .x), bQuiet = F)) + expect_snapshot(map_function(dfs = purrr::imap(dfs, ~ if (.y == df_name) list() else .x), bQuiet = F)) + + # mistyped data frames + expect_snapshot(map_function(dfs = purrr::imap(dfs, ~ 'Hi Mom'), bQuiet = F)) + expect_snapshot(map_function(dfs = purrr::imap(dfs, ~ 9999), bQuiet = F)) + expect_snapshot(map_function(dfs = purrr::imap(dfs, ~ TRUE), bQuiet = F)) + + # empty mapping + expect_snapshot(map_function(dfs = purrr::imap(dfs, ~ .x), lMapping = list(), bQuiet = F)) + + # missing variables + for (domain in names(spec)) { + required_columns <- spec[[ domain ]]$vRequired + for (column in required_columns) { + dfs_edited <- dfs + dfs_edited[[ domain ]][[ column ]] <- NULL + expect_snapshot( + map_function( + dfs = dfs_edited, + bQuiet = F ) - } + ) } + } - # duplicate subject IDs in subject-level data frame - dfs_edited <- dfs - dfs$dfSUBJ <- dfs$dfSUBJ %>% bind_rows(head(., 1)) - expect_snapshot(map_function(dfs = dfs_edited, bQuiet = F)) - }) + # duplicate subject IDs in subject-level data frame + dfs_edited <- dfs + dfs_edited$dfSUBJ <- dfs_edited$dfSUBJ %>% bind_rows(head(., 1)) + expect_snapshot(map_function(dfs = dfs_edited, bQuiet = F)) } diff --git a/inst/mappings/IE_Assess.yaml b/inst/mappings/IE_Assess.yaml index 66e7f31e6..9c7a9cad6 100644 --- a/inst/mappings/IE_Assess.yaml +++ b/inst/mappings/IE_Assess.yaml @@ -2,5 +2,3 @@ dfInput: strIDCol: "SubjectID" strSiteCol: "SiteID" strCountCol: "Count" - strExposureCol: "Exposure" - strRateCol: "Rate" diff --git a/tests/testthat/_snaps/AE_Map_Raw.md b/tests/testthat/_snaps/AE_Map_Raw.md index ee872130f..48dc4dccb 100644 --- a/tests/testthat/_snaps/AE_Map_Raw.md +++ b/tests/testthat/_snaps/AE_Map_Raw.md @@ -1,7 +1,7 @@ # incorrect inputs throw errors Code - AE_Map_Raw(dfs = list(dfAE = list(), dfSUBJ = list()), bQuiet = F) + map_function(dfs = purrr::imap(dfs, ~ list()), bQuiet = F) Message -- Checking Input Data for `AE_Map_Raw()` -- @@ -24,7 +24,8 @@ --- Code - AE_Map_Raw(dfs = list(dfAE = dfAE, dfSUBJ = list()), bQuiet = F) + map_function(dfs = purrr::imap(dfs, ~ if (.y == "dfSUBJ") list() else .x), + bQuiet = F) Message -- Checking Input Data for `AE_Map_Raw()` -- @@ -42,7 +43,8 @@ --- Code - AE_Map_Raw(dfs = list(dfAE = list(), dfSUBJ = dfSUBJ), bQuiet = F) + map_function(dfs = purrr::imap(dfs, ~ if (.y == df_name) list() else .x), + bQuiet = F) Message -- Checking Input Data for `AE_Map_Raw()` -- @@ -60,7 +62,7 @@ --- Code - AE_Map_Raw(dfs = list(dfAE = "Hi", dfSUBJ = "Mom"), bQuiet = F) + map_function(dfs = purrr::imap(dfs, ~"Hi Mom"), bQuiet = F) Message -- Checking Input Data for `AE_Map_Raw()` -- @@ -83,16 +85,21 @@ --- Code - AE_Map_Raw(dfs = list(dfAE = dfAE %>% select(-SubjectID), dfSUBJ = dfSUBJ), - bQuiet = F) + map_function(dfs = purrr::imap(dfs, ~9999), bQuiet = F) Message -- Checking Input Data for `AE_Map_Raw()` -- + x df is not a data.frame() x the following columns not found in df: SubjectID x NA check not run x Empty Value check not run x Unique Column Check not run + x df is not a data.frame() + x the following columns not found in df: SubjectID, SiteID, TimeOnTreatment + x NA check not run + x Empty Value check not run + x Unique Column Check not run ! Issues found for `AE_Map_Raw()` ! `AE_Map_Raw()` did not run because of failed check. Output @@ -101,13 +108,18 @@ --- Code - AE_Map_Raw(dfs = list(dfAE = dfAE, dfSUBJ = dfSUBJ %>% select(-SiteID)), - bQuiet = F) + map_function(dfs = purrr::imap(dfs, ~TRUE), bQuiet = F) Message -- Checking Input Data for `AE_Map_Raw()` -- - x the following columns not found in df: SiteID + x df is not a data.frame() + x the following columns not found in df: SubjectID + x NA check not run + x Empty Value check not run + x Unique Column Check not run + x df is not a data.frame() + x the following columns not found in df: SubjectID, SiteID, TimeOnTreatment x NA check not run x Empty Value check not run x Unique Column Check not run @@ -119,16 +131,17 @@ --- Code - AE_Map_Raw(dfs = list(dfAE = dfAE, dfSUBJ = dfSUBJ %>% select(-SubjectID)), - bQuiet = F) + map_function(dfs = purrr::imap(dfs, ~.x), lMapping = list(), bQuiet = F) Message -- Checking Input Data for `AE_Map_Raw()` -- - x the following columns not found in df: SubjectID - x NA check not run - x Empty Value check not run - x Unique Column Check not run + x "mapping" does not contain required parameters: strIDCol + x mapping is not a list() + x Non-character column names found in mapping: + x "mapping" does not contain required parameters: strIDCol, strSiteCol, strTimeOnTreatmentCol + x mapping is not a list() + x Non-character column names found in mapping: ! Issues found for `AE_Map_Raw()` ! `AE_Map_Raw()` did not run because of failed check. Output @@ -137,69 +150,104 @@ --- Code - AE_Map_Raw(dfs = list(dfAE = dfAE, dfSUBJ = dfSUBJ %>% select(-TimeOnTreatment)), - bQuiet = F) + map_function(dfs = dfs_edited, bQuiet = F) Message -- Checking Input Data for `AE_Map_Raw()` -- - x the following columns not found in df: TimeOnTreatment - x NA check not run - x Empty Value check not run - x Unique Column Check not run - ! Issues found for `AE_Map_Raw()` - ! `AE_Map_Raw()` did not run because of failed check. + v No issues found for `AE_Map_Raw()` + + -- Initializing `AE_Map_Raw()` -- + + i Intializing merge of domain and subject data + i 1 ID(s) in subject data not found in domain data. + These participants will have 0s imputed for the following domain data columns: Count. + NA's will be imputed for all other columns. + v `AE_Map_Raw()` returned output with 3 rows. Output - NULL + SubjectID SiteID Count Exposure Rate + 1 1234 X010X 2 3455 0.0005788712 + 2 5678 X102X 2 1745 0.0011461318 + 3 9876 X999X 0 1233 0.0000000000 --- Code - AE_Map_Raw(dfs = list(dfAE = dfAE, dfSUBJ = bind_rows(dfSUBJ, head(dfSUBJ, 1))), - bQuiet = F) + map_function(dfs = dfs_edited, bQuiet = F) Message -- Checking Input Data for `AE_Map_Raw()` -- - x Unexpected duplicates found in column: SubjectID - ! Issues found for `AE_Map_Raw()` - ! `AE_Map_Raw()` did not run because of failed check. + v No issues found for `AE_Map_Raw()` + + -- Initializing `AE_Map_Raw()` -- + + i Intializing merge of domain and subject data + i 1 ID(s) in subject data not found in domain data. + These participants will have 0s imputed for the following domain data columns: Count. + NA's will be imputed for all other columns. + v `AE_Map_Raw()` returned output with 3 rows. Output - NULL + SubjectID SiteID Count Exposure Rate + 1 1234 X010X 2 3455 0.0005788712 + 2 5678 X102X 2 1745 0.0011461318 + 3 9876 X999X 0 1233 0.0000000000 -# incorrect mappings throw errors +--- Code - AE_Map_Raw(dfs = list(dfAE = dfAE, dfSUBJ = dfSUBJ), lMapping = list(dfAE = list( - strIDCol = "not an id"), dfSUBJ = list(strIDCol = "SubjectID", strSiteCol = "SiteID", - strTimeOnTreatmentCol = "TimeOnTreatment")), bQuiet = F) + map_function(dfs = dfs_edited, bQuiet = F) Message -- Checking Input Data for `AE_Map_Raw()` -- - x the following columns not found in df: not an id - x NA check not run - x Empty Value check not run - x Unique Column Check not run - ! Issues found for `AE_Map_Raw()` - ! `AE_Map_Raw()` did not run because of failed check. + v No issues found for `AE_Map_Raw()` + + -- Initializing `AE_Map_Raw()` -- + + i Intializing merge of domain and subject data + i 1 ID(s) in subject data not found in domain data. + These participants will have 0s imputed for the following domain data columns: Count. + NA's will be imputed for all other columns. + v `AE_Map_Raw()` returned output with 3 rows. Output - NULL + SubjectID SiteID Count Exposure Rate + 1 1234 X010X 2 3455 0.0005788712 + 2 5678 X102X 2 1745 0.0011461318 + 3 9876 X999X 0 1233 0.0000000000 --- Code - AE_Map_Raw(dfs = list(dfAE = dfAE, dfSUBJ = dfSUBJ), lMapping = list(dfAE = list( - strIDCol = "SubjectID"), dfSUBJ = list(strIDCol = "not an id", strSiteCol = "SiteID", - strTimeOnTreatmentCol = "TimeOnTreatment")), bQuiet = F) + map_function(dfs = dfs_edited, bQuiet = F) Message -- Checking Input Data for `AE_Map_Raw()` -- - x the following columns not found in df: not an id - x NA check not run - x Empty Value check not run - x Unique Column Check not run + v No issues found for `AE_Map_Raw()` + + -- Initializing `AE_Map_Raw()` -- + + i Intializing merge of domain and subject data + i 1 ID(s) in subject data not found in domain data. + These participants will have 0s imputed for the following domain data columns: Count. + NA's will be imputed for all other columns. + v `AE_Map_Raw()` returned output with 3 rows. + Output + SubjectID SiteID Count Exposure Rate + 1 1234 X010X 2 3455 0.0005788712 + 2 5678 X102X 2 1745 0.0011461318 + 3 9876 X999X 0 1233 0.0000000000 + +--- + + Code + map_function(dfs = dfs_edited, bQuiet = F) + Message + + -- Checking Input Data for `AE_Map_Raw()` -- + + x Unexpected duplicates found in column: SubjectID ! Issues found for `AE_Map_Raw()` ! `AE_Map_Raw()` did not run because of failed check. Output diff --git a/tests/testthat/_snaps/Consent_Map_Raw.md b/tests/testthat/_snaps/Consent_Map_Raw.md index 761aafe05..a4feb2a5d 100644 --- a/tests/testthat/_snaps/Consent_Map_Raw.md +++ b/tests/testthat/_snaps/Consent_Map_Raw.md @@ -1,7 +1,7 @@ # incorrect inputs throw errors Code - Consent_Map_Raw(dfs = list(dfCONSENT = list(), dfSUBJ = list()), bQuiet = F) + map_function(dfs = purrr::imap(dfs, ~ list()), bQuiet = F) Message -- Checking Input Data for `Consent_Map_Raw()` -- @@ -24,7 +24,8 @@ --- Code - Consent_Map_Raw(dfs = list(dfCONSENT = dfCONSENT, dfSUBJ = list()), bQuiet = F) + map_function(dfs = purrr::imap(dfs, ~ if (.y == "dfSUBJ") list() else .x), + bQuiet = F) Message -- Checking Input Data for `Consent_Map_Raw()` -- @@ -42,7 +43,8 @@ --- Code - Consent_Map_Raw(dfs = list(dfCONSENT = list(), dfSUBJ = dfSUBJ), bQuiet = F) + map_function(dfs = purrr::imap(dfs, ~ if (.y == df_name) list() else .x), + bQuiet = F) Message -- Checking Input Data for `Consent_Map_Raw()` -- @@ -60,7 +62,7 @@ --- Code - Consent_Map_Raw(dfs = list(dfCONSENT = "Hi", dfSUBJ = "Mom"), bQuiet = F) + map_function(dfs = purrr::imap(dfs, ~"Hi Mom"), bQuiet = F) Message -- Checking Input Data for `Consent_Map_Raw()` -- @@ -83,18 +85,21 @@ --- Code - Consent_Map_Raw(dfs = list(dfCONSENT = dfCONSENT, dfSUBJ = dfSUBJ), lMapping = list(), - bQuiet = F) + map_function(dfs = purrr::imap(dfs, ~9999), bQuiet = F) Message -- Checking Input Data for `Consent_Map_Raw()` -- - x "mapping" does not contain required parameters: strIDCol, strTypeCol, strValueCol, strDateCol - x mapping is not a list() - x Non-character column names found in mapping: - x "mapping" does not contain required parameters: strIDCol, strSiteCol, strRandDateCol - x mapping is not a list() - x Non-character column names found in mapping: + x df is not a data.frame() + x the following columns not found in df: SubjectID, CONSENT_TYPE, CONSENT_VALUE, CONSENT_DATE + x NA check not run + x Empty Value check not run + x Unique Column Check not run + x df is not a data.frame() + x the following columns not found in df: SubjectID, SiteID, RandDate + x NA check not run + x Empty Value check not run + x Unique Column Check not run ! Issues found for `Consent_Map_Raw()` ! `Consent_Map_Raw()` did not run because of failed check. Output @@ -103,13 +108,18 @@ --- Code - Consent_Map_Raw(dfs = list(dfCONSENT = dfCONSENT %>% select(-CONSENT_DATE), - dfSUBJ = dfSUBJ), bQuiet = F) + map_function(dfs = purrr::imap(dfs, ~TRUE), bQuiet = F) Message -- Checking Input Data for `Consent_Map_Raw()` -- - x the following columns not found in df: CONSENT_DATE + x df is not a data.frame() + x the following columns not found in df: SubjectID, CONSENT_TYPE, CONSENT_VALUE, CONSENT_DATE + x NA check not run + x Empty Value check not run + x Unique Column Check not run + x df is not a data.frame() + x the following columns not found in df: SubjectID, SiteID, RandDate x NA check not run x Empty Value check not run x Unique Column Check not run @@ -121,16 +131,17 @@ --- Code - Consent_Map_Raw(dfs = list(dfCONSENT = dfCONSENT %>% select(-CONSENT_TYPE), - dfSUBJ = dfSUBJ), bQuiet = F) + map_function(dfs = purrr::imap(dfs, ~.x), lMapping = list(), bQuiet = F) Message -- Checking Input Data for `Consent_Map_Raw()` -- - x the following columns not found in df: CONSENT_TYPE - x NA check not run - x Empty Value check not run - x Unique Column Check not run + x "mapping" does not contain required parameters: strIDCol, strTypeCol, strValueCol, strDateCol + x mapping is not a list() + x Non-character column names found in mapping: + x "mapping" does not contain required parameters: strIDCol, strSiteCol, strRandDateCol + x mapping is not a list() + x Non-character column names found in mapping: ! Issues found for `Consent_Map_Raw()` ! `Consent_Map_Raw()` did not run because of failed check. Output @@ -139,127 +150,159 @@ --- Code - Consent_Map_Raw(dfs = list(dfCONSENT = dfCONSENT %>% select(-CONSENT_VALUE), - dfSUBJ = dfSUBJ), bQuiet = F) + map_function(dfs = dfs_edited, bQuiet = F) Message -- Checking Input Data for `Consent_Map_Raw()` -- - x the following columns not found in df: CONSENT_VALUE - x NA check not run - x Empty Value check not run - x Unique Column Check not run - ! Issues found for `Consent_Map_Raw()` - ! `Consent_Map_Raw()` did not run because of failed check. + v No issues found for `Consent_Map_Raw()` + + -- Initializing `Consent_Map_Raw()` -- + + i Intializing merge of domain and subject data + i 1 ID(s) in subject data not found in domain data.These participants will have NA values imputed for all domain data columns: + v `Consent_Map_Raw()` returned output with 3 rows. Output - NULL + SubjectID SiteID Count + 1 1234 X010X 1 + 2 5678 X102X 1 + 3 9876 X999X 1 --- Code - Consent_Map_Raw(dfs = list(dfCONSENT = dfCONSENT, dfSUBJ = dfSUBJ %>% select( - -SubjectID)), bQuiet = F) + map_function(dfs = dfs_edited, bQuiet = F) Message -- Checking Input Data for `Consent_Map_Raw()` -- - x the following columns not found in df: SubjectID - x NA check not run - x Empty Value check not run - x Unique Column Check not run - ! Issues found for `Consent_Map_Raw()` - ! `Consent_Map_Raw()` did not run because of failed check. + v No issues found for `Consent_Map_Raw()` + + -- Initializing `Consent_Map_Raw()` -- + + i Intializing merge of domain and subject data + i 1 ID(s) in subject data not found in domain data.These participants will have NA values imputed for all domain data columns: + v `Consent_Map_Raw()` returned output with 3 rows. Output - NULL + SubjectID SiteID Count + 1 1234 X010X 1 + 2 5678 X102X 1 + 3 9876 X999X 1 --- Code - Consent_Map_Raw(dfs = list(dfCONSENT = dfCONSENT, dfSUBJ = dfSUBJ %>% select( - -SiteID)), bQuiet = F) + map_function(dfs = dfs_edited, bQuiet = F) Message -- Checking Input Data for `Consent_Map_Raw()` -- - x the following columns not found in df: SiteID - x NA check not run - x Empty Value check not run - x Unique Column Check not run - ! Issues found for `Consent_Map_Raw()` - ! `Consent_Map_Raw()` did not run because of failed check. + v No issues found for `Consent_Map_Raw()` + + -- Initializing `Consent_Map_Raw()` -- + + i Intializing merge of domain and subject data + i 1 ID(s) in subject data not found in domain data.These participants will have NA values imputed for all domain data columns: + v `Consent_Map_Raw()` returned output with 3 rows. Output - NULL + SubjectID SiteID Count + 1 1234 X010X 1 + 2 5678 X102X 1 + 3 9876 X999X 1 --- Code - Consent_Map_Raw(dfs = list(dfCONSENT = dfCONSENT, dfSUBJ = dfSUBJ %>% select( - -RandDate)), bQuiet = F) + map_function(dfs = dfs_edited, bQuiet = F) Message -- Checking Input Data for `Consent_Map_Raw()` -- - x the following columns not found in df: RandDate - x NA check not run - x Empty Value check not run - x Unique Column Check not run - ! Issues found for `Consent_Map_Raw()` - ! `Consent_Map_Raw()` did not run because of failed check. + v No issues found for `Consent_Map_Raw()` + + -- Initializing `Consent_Map_Raw()` -- + + i Intializing merge of domain and subject data + i 1 ID(s) in subject data not found in domain data.These participants will have NA values imputed for all domain data columns: + v `Consent_Map_Raw()` returned output with 3 rows. Output - NULL + SubjectID SiteID Count + 1 1234 X010X 1 + 2 5678 X102X 1 + 3 9876 X999X 1 --- Code - Consent_Map_Raw(dfs = list(dfCONSENT = dfCONSENT, dfSUBJ = bind_rows(dfSUBJ, - head(dfSUBJ, 1))), bQuiet = F) + map_function(dfs = dfs_edited, bQuiet = F) Message -- Checking Input Data for `Consent_Map_Raw()` -- - x Unexpected duplicates found in column: SubjectID - ! Issues found for `Consent_Map_Raw()` - ! `Consent_Map_Raw()` did not run because of failed check. + v No issues found for `Consent_Map_Raw()` + + -- Initializing `Consent_Map_Raw()` -- + + i Intializing merge of domain and subject data + i 1 ID(s) in subject data not found in domain data.These participants will have NA values imputed for all domain data columns: + v `Consent_Map_Raw()` returned output with 3 rows. Output - NULL + SubjectID SiteID Count + 1 1234 X010X 1 + 2 5678 X102X 1 + 3 9876 X999X 1 -# incorrect mappings throw errors +--- Code - Consent_Map_Raw(dfs = list(dfCONSENT = dfCONSENT, dfSUBJ = dfSUBJ), lMapping = list( - dfCONSENT = list(strIDCol = "not an id", strTypeCol = "CONSENT_TYPE", - strValueCol = "CONSENT_VALUE", strDateCol = "CONSENT_DATE"), dfSUBJ = list( - strIDCol = "SubjectID", strSiteCol = "SiteID", strRandDateCol = "RandDate")), - bQuiet = F) + map_function(dfs = dfs_edited, bQuiet = F) Message -- Checking Input Data for `Consent_Map_Raw()` -- - x the following columns not found in df: not an id - x NA check not run - x Empty Value check not run - x Unique Column Check not run - ! Issues found for `Consent_Map_Raw()` - ! `Consent_Map_Raw()` did not run because of failed check. + v No issues found for `Consent_Map_Raw()` + + -- Initializing `Consent_Map_Raw()` -- + + i Intializing merge of domain and subject data + i 1 ID(s) in subject data not found in domain data.These participants will have NA values imputed for all domain data columns: + v `Consent_Map_Raw()` returned output with 3 rows. Output - NULL + SubjectID SiteID Count + 1 1234 X010X 1 + 2 5678 X102X 1 + 3 9876 X999X 1 --- Code - Consent_Map_Raw(dfs = list(dfCONSENT = dfCONSENT, dfSUBJ = dfSUBJ), lMapping = list( - dfCONSENT = list(strIDCol = "SubjectID", strTypeCol = "CONSENT_TYPE", - strValueCol = "CONSENT_VALUE", strDateCol = "CONSENT_DATE"), dfSUBJ = list( - strIDCol = "not an id", strSiteCol = "SiteID", strRandDateCol = "RandDate")), - bQuiet = F) + map_function(dfs = dfs_edited, bQuiet = F) Message -- Checking Input Data for `Consent_Map_Raw()` -- - x the following columns not found in df: not an id - x NA check not run - x Empty Value check not run - x Unique Column Check not run + v No issues found for `Consent_Map_Raw()` + + -- Initializing `Consent_Map_Raw()` -- + + i Intializing merge of domain and subject data + i 1 ID(s) in subject data not found in domain data.These participants will have NA values imputed for all domain data columns: + v `Consent_Map_Raw()` returned output with 3 rows. + Output + SubjectID SiteID Count + 1 1234 X010X 1 + 2 5678 X102X 1 + 3 9876 X999X 1 + +--- + + Code + map_function(dfs = dfs_edited, bQuiet = F) + Message + + -- Checking Input Data for `Consent_Map_Raw()` -- + + x Unexpected duplicates found in column: SubjectID ! Issues found for `Consent_Map_Raw()` ! `Consent_Map_Raw()` did not run because of failed check. Output diff --git a/tests/testthat/_snaps/IE_Map_Raw.md b/tests/testthat/_snaps/IE_Map_Raw.md index a1060ce84..d39271a0d 100644 --- a/tests/testthat/_snaps/IE_Map_Raw.md +++ b/tests/testthat/_snaps/IE_Map_Raw.md @@ -1,7 +1,7 @@ # incorrect inputs throw errors Code - IE_Map_Raw(dfs = list(dfIE = list(), dfSUBJ = list()), bQuiet = F) + map_function(dfs = purrr::imap(dfs, ~ list()), bQuiet = F) Message -- Checking Input Data for `IE_Map_Raw()` -- @@ -24,7 +24,8 @@ --- Code - IE_Map_Raw(dfs = list(dfIE = dfIE, dfSUBJ = list()), bQuiet = F) + map_function(dfs = purrr::imap(dfs, ~ if (.y == "dfSUBJ") list() else .x), + bQuiet = F) Message -- Checking Input Data for `IE_Map_Raw()` -- @@ -42,7 +43,8 @@ --- Code - IE_Map_Raw(dfs = list(dfIE = list(), dfSUBJ = dfSUBJ), bQuiet = F) + map_function(dfs = purrr::imap(dfs, ~ if (.y == df_name) list() else .x), + bQuiet = F) Message -- Checking Input Data for `IE_Map_Raw()` -- @@ -60,7 +62,7 @@ --- Code - IE_Map_Raw(dfs = list(dfIE = "Hi", dfSUBJ = "Mom"), bQuiet = F) + map_function(dfs = purrr::imap(dfs, ~"Hi Mom"), bQuiet = F) Message -- Checking Input Data for `IE_Map_Raw()` -- @@ -83,17 +85,21 @@ --- Code - IE_Map_Raw(dfs = list(dfIE = dfIE, dfSUBJ = dfSUBJ), lMapping = list(), bQuiet = F) + map_function(dfs = purrr::imap(dfs, ~9999), bQuiet = F) Message -- Checking Input Data for `IE_Map_Raw()` -- - x "mapping" does not contain required parameters: strIDCol, strCategoryCol, strValueCol - x mapping is not a list() - x Non-character column names found in mapping: - x "mapping" does not contain required parameters: strIDCol, strSiteCol - x mapping is not a list() - x Non-character column names found in mapping: + x df is not a data.frame() + x the following columns not found in df: SubjectID, IE_CATEGORY, IE_VALUE + x NA check not run + x Empty Value check not run + x Unique Column Check not run + x df is not a data.frame() + x the following columns not found in df: SubjectID, SiteID + x NA check not run + x Empty Value check not run + x Unique Column Check not run ! Issues found for `IE_Map_Raw()` ! `IE_Map_Raw()` did not run because of failed check. Output @@ -102,13 +108,18 @@ --- Code - IE_Map_Raw(dfs = list(dfIE = dfIE %>% select(-SubjectID), dfSUBJ = dfSUBJ), - bQuiet = F) + map_function(dfs = purrr::imap(dfs, ~TRUE), bQuiet = F) Message -- Checking Input Data for `IE_Map_Raw()` -- - x the following columns not found in df: SubjectID + x df is not a data.frame() + x the following columns not found in df: SubjectID, IE_CATEGORY, IE_VALUE + x NA check not run + x Empty Value check not run + x Unique Column Check not run + x df is not a data.frame() + x the following columns not found in df: SubjectID, SiteID x NA check not run x Empty Value check not run x Unique Column Check not run @@ -120,16 +131,17 @@ --- Code - IE_Map_Raw(dfs = list(dfIE = dfIE %>% select(-IE_CATEGORY), dfSUBJ = dfSUBJ), - bQuiet = F) + map_function(dfs = purrr::imap(dfs, ~.x), lMapping = list(), bQuiet = F) Message -- Checking Input Data for `IE_Map_Raw()` -- - x the following columns not found in df: IE_CATEGORY - x NA check not run - x Empty Value check not run - x Unique Column Check not run + x "mapping" does not contain required parameters: strIDCol, strCategoryCol, strValueCol + x mapping is not a list() + x Non-character column names found in mapping: + x "mapping" does not contain required parameters: strIDCol, strSiteCol + x mapping is not a list() + x Non-character column names found in mapping: ! Issues found for `IE_Map_Raw()` ! `IE_Map_Raw()` did not run because of failed check. Output @@ -138,105 +150,127 @@ --- Code - IE_Map_Raw(dfs = list(dfIE = dfIE %>% select(-IE_VALUE), dfSUBJ = dfSUBJ), - bQuiet = F) + map_function(dfs = dfs_edited, bQuiet = F) Message -- Checking Input Data for `IE_Map_Raw()` -- - x the following columns not found in df: IE_VALUE - x NA check not run - x Empty Value check not run - x Unique Column Check not run - ! Issues found for `IE_Map_Raw()` - ! `IE_Map_Raw()` did not run because of failed check. + v No issues found for `IE_Map_Raw()` + + -- Initializing `IE_Map_Raw()` -- + + i Intializing merge of domain and subject data + i 1 ID(s) in subject data not found in domain data. + These participants will have 0s imputed for the following domain data columns: Count. + NA's will be imputed for all other columns. + v `IE_Map_Raw()` returned output with 3 rows. Output - NULL + SubjectID SiteID Count + 1 1234 X010X 0 + 2 5678 X102X 0 + 3 9876 X999X 0 --- Code - IE_Map_Raw(dfs = list(dfIE = dfIE, dfSUBJ = dfSUBJ %>% select(-SubjectID)), - bQuiet = F) + map_function(dfs = dfs_edited, bQuiet = F) Message -- Checking Input Data for `IE_Map_Raw()` -- - x the following columns not found in df: SubjectID - x NA check not run - x Empty Value check not run - x Unique Column Check not run - ! Issues found for `IE_Map_Raw()` - ! `IE_Map_Raw()` did not run because of failed check. + v No issues found for `IE_Map_Raw()` + + -- Initializing `IE_Map_Raw()` -- + + i Intializing merge of domain and subject data + i 1 ID(s) in subject data not found in domain data. + These participants will have 0s imputed for the following domain data columns: Count. + NA's will be imputed for all other columns. + v `IE_Map_Raw()` returned output with 3 rows. Output - NULL + SubjectID SiteID Count + 1 1234 X010X 0 + 2 5678 X102X 0 + 3 9876 X999X 0 --- Code - IE_Map_Raw(dfs = list(dfIE = dfIE, dfSUBJ = dfSUBJ %>% select(-SiteID)), - bQuiet = F) + map_function(dfs = dfs_edited, bQuiet = F) Message -- Checking Input Data for `IE_Map_Raw()` -- - x the following columns not found in df: SiteID - x NA check not run - x Empty Value check not run - x Unique Column Check not run - ! Issues found for `IE_Map_Raw()` - ! `IE_Map_Raw()` did not run because of failed check. + v No issues found for `IE_Map_Raw()` + + -- Initializing `IE_Map_Raw()` -- + + i Intializing merge of domain and subject data + i 1 ID(s) in subject data not found in domain data. + These participants will have 0s imputed for the following domain data columns: Count. + NA's will be imputed for all other columns. + v `IE_Map_Raw()` returned output with 3 rows. Output - NULL + SubjectID SiteID Count + 1 1234 X010X 0 + 2 5678 X102X 0 + 3 9876 X999X 0 --- Code - IE_Map_Raw(dfs = list(dfIE = dfIE, dfSUBJ = bind_rows(dfSUBJ, head(dfSUBJ, 1))), - bQuiet = F) + map_function(dfs = dfs_edited, bQuiet = F) Message -- Checking Input Data for `IE_Map_Raw()` -- - x Unexpected duplicates found in column: SubjectID - ! Issues found for `IE_Map_Raw()` - ! `IE_Map_Raw()` did not run because of failed check. + v No issues found for `IE_Map_Raw()` + + -- Initializing `IE_Map_Raw()` -- + + i Intializing merge of domain and subject data + i 1 ID(s) in subject data not found in domain data. + These participants will have 0s imputed for the following domain data columns: Count. + NA's will be imputed for all other columns. + v `IE_Map_Raw()` returned output with 3 rows. Output - NULL + SubjectID SiteID Count + 1 1234 X010X 0 + 2 5678 X102X 0 + 3 9876 X999X 0 -# incorrect mappings throw errors +--- Code - IE_Map_Raw(dfs = list(dfIE = dfIE, dfSUBJ = dfSUBJ), lMapping = list(dfIE = list( - strIDCol = "not an id", strCategoryCol = "IE_CATEGORY", strValueCol = "IE_VALUE"), - dfSUBJ = list(strIDCol = "SubjectID", strSiteCol = "SiteID")), bQuiet = F) + map_function(dfs = dfs_edited, bQuiet = F) Message -- Checking Input Data for `IE_Map_Raw()` -- - x the following columns not found in df: not an id - x NA check not run - x Empty Value check not run - x Unique Column Check not run - ! Issues found for `IE_Map_Raw()` - ! `IE_Map_Raw()` did not run because of failed check. + v No issues found for `IE_Map_Raw()` + + -- Initializing `IE_Map_Raw()` -- + + i Intializing merge of domain and subject data + i 1 ID(s) in subject data not found in domain data. + These participants will have 0s imputed for the following domain data columns: Count. + NA's will be imputed for all other columns. + v `IE_Map_Raw()` returned output with 3 rows. Output - NULL + SubjectID SiteID Count + 1 1234 X010X 0 + 2 5678 X102X 0 + 3 9876 X999X 0 --- Code - IE_Map_Raw(dfs = list(dfIE = dfIE, dfSUBJ = dfSUBJ), lMapping = list(dfIE = list( - strIDCol = "SubjectID", strCategoryCol = "IE_CATEGORY", strValueCol = "IE_VALUE"), - dfSUBJ = list(strIDCol = "not an id", strSiteCol = "SiteID")), bQuiet = F) + map_function(dfs = dfs_edited, bQuiet = F) Message -- Checking Input Data for `IE_Map_Raw()` -- - x the following columns not found in df: not an id - x NA check not run - x Empty Value check not run - x Unique Column Check not run + x Unexpected duplicates found in column: SubjectID ! Issues found for `IE_Map_Raw()` ! `IE_Map_Raw()` did not run because of failed check. Output diff --git a/tests/testthat/_snaps/PD_Map_Raw.md b/tests/testthat/_snaps/PD_Map_Raw.md index 8ff26975f..fabbabeed 100644 --- a/tests/testthat/_snaps/PD_Map_Raw.md +++ b/tests/testthat/_snaps/PD_Map_Raw.md @@ -1,7 +1,7 @@ # incorrect inputs throw errors Code - PD_Map_Raw(dfs = list(dfPD = list(), dfSUBJ = list()), bQuiet = F) + map_function(dfs = purrr::imap(dfs, ~ list()), bQuiet = F) Message -- Checking Input Data for `PD_Map_Raw()` -- @@ -24,7 +24,8 @@ --- Code - PD_Map_Raw(dfs = list(dfPD = dfPD, dfSUBJ = list()), bQuiet = F) + map_function(dfs = purrr::imap(dfs, ~ if (.y == "dfSUBJ") list() else .x), + bQuiet = F) Message -- Checking Input Data for `PD_Map_Raw()` -- @@ -42,7 +43,8 @@ --- Code - PD_Map_Raw(dfs = list(dfPD = list(), dfSUBJ = dfSUBJ), bQuiet = F) + map_function(dfs = purrr::imap(dfs, ~ if (.y == df_name) list() else .x), + bQuiet = F) Message -- Checking Input Data for `PD_Map_Raw()` -- @@ -60,7 +62,7 @@ --- Code - PD_Map_Raw(dfs = list(dfPD = "Hi", dfSUBJ = "Mom"), bQuiet = F) + map_function(dfs = purrr::imap(dfs, ~"Hi Mom"), bQuiet = F) Message -- Checking Input Data for `PD_Map_Raw()` -- @@ -83,35 +85,21 @@ --- Code - PD_Map_Raw(dfs = list(dfPD = dfPD, dfSUBJ = dfSUBJ), lMapping = list(), bQuiet = F) - Message - - -- Checking Input Data for `PD_Map_Raw()` -- - - x "mapping" does not contain required parameters: strIDCol - x mapping is not a list() - x Non-character column names found in mapping: - x "mapping" does not contain required parameters: strIDCol, strSiteCol, strTimeOnStudyCol - x mapping is not a list() - x Non-character column names found in mapping: - ! Issues found for `PD_Map_Raw()` - ! `PD_Map_Raw()` did not run because of failed check. - Output - NULL - ---- - - Code - PD_Map_Raw(dfs = list(dfPD = dfPD %>% select(-SubjectID), dfSUBJ = dfSUBJ), - bQuiet = F) + map_function(dfs = purrr::imap(dfs, ~9999), bQuiet = F) Message -- Checking Input Data for `PD_Map_Raw()` -- + x df is not a data.frame() x the following columns not found in df: SubjectID x NA check not run x Empty Value check not run x Unique Column Check not run + x df is not a data.frame() + x the following columns not found in df: SubjectID, SiteID, TimeOnStudy + x NA check not run + x Empty Value check not run + x Unique Column Check not run ! Issues found for `PD_Map_Raw()` ! `PD_Map_Raw()` did not run because of failed check. Output @@ -120,31 +108,18 @@ --- Code - PD_Map_Raw(dfs = list(dfPD = dfPD, dfSUBJ = dfSUBJ %>% select(-SubjectID)), - bQuiet = F) + map_function(dfs = purrr::imap(dfs, ~TRUE), bQuiet = F) Message -- Checking Input Data for `PD_Map_Raw()` -- + x df is not a data.frame() x the following columns not found in df: SubjectID x NA check not run x Empty Value check not run x Unique Column Check not run - ! Issues found for `PD_Map_Raw()` - ! `PD_Map_Raw()` did not run because of failed check. - Output - NULL - ---- - - Code - PD_Map_Raw(dfs = list(dfPD = dfPD, dfSUBJ = dfSUBJ %>% select(-SiteID)), - bQuiet = F) - Message - - -- Checking Input Data for `PD_Map_Raw()` -- - - x the following columns not found in df: SiteID + x df is not a data.frame() + x the following columns not found in df: SubjectID, SiteID, TimeOnStudy x NA check not run x Empty Value check not run x Unique Column Check not run @@ -156,16 +131,17 @@ --- Code - PD_Map_Raw(dfs = list(dfPD = dfPD, dfSUBJ = dfSUBJ %>% select(-TimeOnStudy)), - bQuiet = F) + map_function(dfs = purrr::imap(dfs, ~.x), lMapping = list(), bQuiet = F) Message -- Checking Input Data for `PD_Map_Raw()` -- - x the following columns not found in df: TimeOnStudy - x NA check not run - x Empty Value check not run - x Unique Column Check not run + x "mapping" does not contain required parameters: strIDCol + x mapping is not a list() + x Non-character column names found in mapping: + x "mapping" does not contain required parameters: strIDCol, strSiteCol, strTimeOnStudyCol + x mapping is not a list() + x Non-character column names found in mapping: ! Issues found for `PD_Map_Raw()` ! `PD_Map_Raw()` did not run because of failed check. Output @@ -174,88 +150,87 @@ --- Code - PD_Map_Raw(dfs = list(dfPD = dfPD, dfSUBJ = bind_rows(dfSUBJ, head(dfSUBJ, 1))), - bQuiet = F) + map_function(dfs = dfs_edited, bQuiet = F) Message -- Checking Input Data for `PD_Map_Raw()` -- - x Unexpected duplicates found in column: SubjectID - ! Issues found for `PD_Map_Raw()` - ! `PD_Map_Raw()` did not run because of failed check. - Output - NULL - -# incorrect mappings throw errors - - Code - PD_Map_Raw(dfs = list(dfPD = dfPD, dfSUBJ = dfSUBJ), lMapping = list(dfPD = list( - strIDCol = "not an id"), dfSUBJ = list(strIDCol = "SubjectID", strSiteCol = "SiteID", - strTimeOnStudyCol = "TimeOnStudy")), bQuiet = F) - Message + v No issues found for `PD_Map_Raw()` - -- Checking Input Data for `PD_Map_Raw()` -- + -- Initializing `PD_Map_Raw()` -- - x the following columns not found in df: not an id - x NA check not run - x Empty Value check not run - x Unique Column Check not run - ! Issues found for `PD_Map_Raw()` - ! `PD_Map_Raw()` did not run because of failed check. + i Intializing merge of domain and subject data + v `PD_Map_Raw()` returned output with 3 rows. Output - NULL + SubjectID SiteID Count Exposure Rate + 1 1234 X010X 2 1234 0.0016207455 + 2 5678 X102X 3 2345 0.0012793177 + 3 9876 X999X 2 4567 0.0004379242 --- Code - PD_Map_Raw(dfs = list(dfPD = dfPD, dfSUBJ = dfSUBJ), lMapping = list(dfPD = list( - strIDCol = "SubjectID"), dfSUBJ = list(strIDCol = "not an id", strSiteCol = "SiteID", - strTimeOnStudyCol = "TimeOnStudy")), bQuiet = F) + map_function(dfs = dfs_edited, bQuiet = F) Message -- Checking Input Data for `PD_Map_Raw()` -- - x the following columns not found in df: not an id - x NA check not run - x Empty Value check not run - x Unique Column Check not run - ! Issues found for `PD_Map_Raw()` - ! `PD_Map_Raw()` did not run because of failed check. + v No issues found for `PD_Map_Raw()` + + -- Initializing `PD_Map_Raw()` -- + + i Intializing merge of domain and subject data + v `PD_Map_Raw()` returned output with 3 rows. Output - NULL + SubjectID SiteID Count Exposure Rate + 1 1234 X010X 2 1234 0.0016207455 + 2 5678 X102X 3 2345 0.0012793177 + 3 9876 X999X 2 4567 0.0004379242 -# NA values are caught +--- Code - PD_Map_Raw(dfs = list(dfPD = dfPD, dfSUBJ = dfTos), bQuiet = F) + map_function(dfs = dfs_edited, bQuiet = F) Message -- Checking Input Data for `PD_Map_Raw()` -- - x 1 NA values found in column: TimeOnStudy - ! Issues found for `PD_Map_Raw()` - ! `PD_Map_Raw()` did not run because of failed check. + v No issues found for `PD_Map_Raw()` + + -- Initializing `PD_Map_Raw()` -- + + i Intializing merge of domain and subject data + v `PD_Map_Raw()` returned output with 3 rows. Output - NULL + SubjectID SiteID Count Exposure Rate + 1 1234 X010X 2 1234 0.0016207455 + 2 5678 X102X 3 2345 0.0012793177 + 3 9876 X999X 2 4567 0.0004379242 --- Code - PD_Map_Raw(dfs = list(dfPD = dfPD2, dfSUBJ = dfTos2), bQuiet = F) + map_function(dfs = dfs_edited, bQuiet = F) Message -- Checking Input Data for `PD_Map_Raw()` -- - x 1 NA values found in column: TimeOnStudy - ! Issues found for `PD_Map_Raw()` - ! `PD_Map_Raw()` did not run because of failed check. + v No issues found for `PD_Map_Raw()` + + -- Initializing `PD_Map_Raw()` -- + + i Intializing merge of domain and subject data + v `PD_Map_Raw()` returned output with 3 rows. Output - NULL + SubjectID SiteID Count Exposure Rate + 1 1234 X010X 2 1234 0.0016207455 + 2 5678 X102X 3 2345 0.0012793177 + 3 9876 X999X 2 4567 0.0004379242 -# duplicate SubjectID values are caught in RDSL +--- Code - PD_Map_Raw(dfs = list(dfPD = dfPD, dfSUBJ = dfSUBJ), bQuiet = F) + map_function(dfs = dfs_edited, bQuiet = F) Message -- Checking Input Data for `PD_Map_Raw()` -- diff --git a/tests/testthat/test_AE_Map_Raw.R b/tests/testthat/test_AE_Map_Raw.R index d73711eef..6fc506a77 100644 --- a/tests/testthat/test_AE_Map_Raw.R +++ b/tests/testthat/test_AE_Map_Raw.R @@ -1,32 +1,27 @@ source(testthat::test_path("testdata/data.R")) - -# output is created as expected ------------------------------------------- -test_that("output is created as expected", { - data <- AE_Map_Raw(dfs = list(dfAE = dfAE, dfSUBJ = dfSUBJ)) - expect_true(is.data.frame(data)) - expect_equal(names(data), c("SubjectID", "SiteID", "Count", "Exposure", "Rate")) - expect_type(data$SubjectID, "character") - expect_type(data$SiteID, "character") - expect_true(class(data$Count) %in% c("double", "integer", "numeric")) -}) +input_spec <- yaml::read_yaml(paste0(here::here(), '/inst/specs/AE_Map_Raw.yaml')) +output_mapping <- yaml::read_yaml(paste0(here::here(), '/inst/mappings/AE_Assess.yaml')) # incorrect inputs throw errors ------------------------------------------- test_that("incorrect inputs throw errors", { - # empty data frames - expect_snapshot(AE_Map_Raw(dfs = list(dfAE = list(), dfSUBJ = list()), bQuiet = F)) - expect_snapshot(AE_Map_Raw(dfs = list(dfAE = dfAE, dfSUBJ = list()), bQuiet = F)) - expect_snapshot(AE_Map_Raw(dfs = list(dfAE = list(), dfSUBJ = dfSUBJ), bQuiet = F)) - # mistyped data frames - expect_snapshot(AE_Map_Raw(dfs = list(dfAE = "Hi", dfSUBJ = "Mom"), bQuiet = F)) - # empty mapping - expect_snapshot(AE_Map_Raw(dfs = list(dfAE = dfAE, dfSUBJ = dfSUBJ), lMapping = list(), bQuiet = F)) - # missing variables - expect_snapshot(AE_Map_Raw(dfs = list(dfAE = dfAE %>% select(-SubjectID), dfSUBJ = dfSUBJ), bQuiet = F)) - expect_snapshot(AE_Map_Raw(dfs = list(dfAE = dfAE, dfSUBJ = dfSUBJ %>% select(-SiteID)), bQuiet = F)) - expect_snapshot(AE_Map_Raw(dfs = list(dfAE = dfAE, dfSUBJ = dfSUBJ %>% select(-SubjectID)), bQuiet = F)) - expect_snapshot(AE_Map_Raw(dfs = list(dfAE = dfAE, dfSUBJ = dfSUBJ %>% select(-TimeOnTreatment)), bQuiet = F)) - # duplicate subject IDs - expect_snapshot(AE_Map_Raw(dfs = list(dfAE = dfAE, dfSUBJ = bind_rows(dfSUBJ, head(dfSUBJ, 1))), bQuiet = F)) + test_incorrect_inputs( + AE_Map_Raw, + dfAE, + 'dfAE', + dfSUBJ, + input_spec + ) +}) + +# output is created as expected ------------------------------------------- +test_that("output is created as expected", { + test_correct_output( + AE_Map_Raw, + dfAE, + 'dfAE', + dfSUBJ, + output_mapping + ) }) # incorrect mappings throw errors ----------------------------------------- diff --git a/tests/testthat/test_Consent_Map_Raw.R b/tests/testthat/test_Consent_Map_Raw.R index 3426c131a..6f649eed6 100644 --- a/tests/testthat/test_Consent_Map_Raw.R +++ b/tests/testthat/test_Consent_Map_Raw.R @@ -1,37 +1,28 @@ source(testthat::test_path("testdata/data.R")) - -# output is created as expected ------------------------------------------- -test_that("output created as expected ", { - data <- Consent_Map_Raw(dfs = list(dfCONSENT = dfCONSENT, dfSUBJ = dfSUBJ)) - expect_true(is.data.frame(data)) - expect_equal(names(data), c("SubjectID", "SiteID", "Count")) - expect_type(data$SubjectID, "character") - expect_type(data$SiteID, "character") - expect_true(class(data$Count) %in% c("double", "integer", "numeric")) -}) +input_spec <- yaml::read_yaml(paste0(here::here(), '/inst/specs/Consent_Map_Raw.yaml')) +output_mapping <- yaml::read_yaml(paste0(here::here(), '/inst/mappings/Consent_Assess.yaml')) # incorrect inputs throw errors ------------------------------------------- test_that("incorrect inputs throw errors", { - # empty data frames - expect_snapshot(Consent_Map_Raw(dfs = list(dfCONSENT = list(), dfSUBJ = list()), bQuiet = F)) - expect_snapshot(Consent_Map_Raw(dfs = list(dfCONSENT = dfCONSENT, dfSUBJ = list()), bQuiet = F)) - expect_snapshot(Consent_Map_Raw(dfs = list(dfCONSENT = list(), dfSUBJ = dfSUBJ), bQuiet = F)) - # mistyped data frames - expect_snapshot(Consent_Map_Raw(dfs = list(dfCONSENT = "Hi", dfSUBJ = "Mom"), bQuiet = F)) - # empty mapping - expect_snapshot(Consent_Map_Raw(dfs = list(dfCONSENT = dfCONSENT, dfSUBJ = dfSUBJ), lMapping = list(), bQuiet = F)) - # missing variables - expect_snapshot(Consent_Map_Raw(dfs = list(dfCONSENT = dfCONSENT %>% select(-CONSENT_DATE), dfSUBJ = dfSUBJ), bQuiet = F)) - expect_snapshot(Consent_Map_Raw(dfs = list(dfCONSENT = dfCONSENT %>% select(-CONSENT_TYPE), dfSUBJ = dfSUBJ), bQuiet = F)) - expect_snapshot(Consent_Map_Raw(dfs = list(dfCONSENT = dfCONSENT %>% select(-CONSENT_VALUE), dfSUBJ = dfSUBJ), bQuiet = F)) - expect_snapshot(Consent_Map_Raw(dfs = list(dfCONSENT = dfCONSENT, dfSUBJ = dfSUBJ %>% select(-SubjectID)), bQuiet = F)) - expect_snapshot(Consent_Map_Raw(dfs = list(dfCONSENT = dfCONSENT, dfSUBJ = dfSUBJ %>% select(-SiteID)), bQuiet = F)) - expect_snapshot(Consent_Map_Raw(dfs = list(dfCONSENT = dfCONSENT, dfSUBJ = dfSUBJ %>% select(-RandDate)), bQuiet = F)) - # duplicate subject IDs - expect_snapshot(Consent_Map_Raw(dfs = list(dfCONSENT = dfCONSENT, dfSUBJ = bind_rows(dfSUBJ, head(dfSUBJ, 1))), bQuiet = F)) + test_incorrect_inputs( + Consent_Map_Raw, + dfCONSENT, + 'dfCONSENT', + dfSUBJ, + input_spec + ) }) - +# output is created as expected ------------------------------------------- +test_that("output created as expected ", { + test_correct_output( + Consent_Map_Raw, + dfCONSENT, + 'dfCONSENT', + dfSUBJ, + output_mapping + ) +}) # incorrect mappings throw errors ----------------------------------------- test_that("incorrect mappings throw errors", { diff --git a/tests/testthat/test_IE_Map_Raw.R b/tests/testthat/test_IE_Map_Raw.R index 19a104194..1bd031688 100644 --- a/tests/testthat/test_IE_Map_Raw.R +++ b/tests/testthat/test_IE_Map_Raw.R @@ -1,35 +1,27 @@ source(testthat::test_path("testdata/data.R")) -spec <- yaml::read_yaml(paste0(here::here(), '/inst/specs/IE_Map_Raw.yaml')) -print(spec) - -# output is created as expected ------------------------------------------- -test_that("output created as expected", { - data <- IE_Map_Raw(dfs = list(dfIE = dfIE, dfSUBJ = dfSUBJ)) - expect_true(is.data.frame(data)) - expect_equal(names(data), c("SubjectID", "SiteID", "Count")) - expect_type(data$SubjectID, "character") - expect_type(data$SiteID, "character") - expect_true(class(data$Count) %in% c("double", "integer", "numeric")) -}) +input_spec <- yaml::read_yaml(paste0(here::here(), '/inst/specs/IE_Map_Raw.yaml')) +output_mapping <- yaml::read_yaml(paste0(here::here(), '/inst/mappings/IE_Assess.yaml')) # incorrect inputs throw errors ------------------------------------------- test_that("incorrect inputs throw errors", { - # empty data frames - expect_snapshot(IE_Map_Raw(dfs = list(dfIE = list(), dfSUBJ = list()), bQuiet = F)) - expect_snapshot(IE_Map_Raw(dfs = list(dfIE = dfIE, dfSUBJ = list()), bQuiet = F)) - expect_snapshot(IE_Map_Raw(dfs = list(dfIE = list(), dfSUBJ = dfSUBJ), bQuiet = F)) - # mistyped data frames - expect_snapshot(IE_Map_Raw(dfs = list(dfIE = "Hi", dfSUBJ = "Mom"), bQuiet = F)) - # empty mapping - expect_snapshot(IE_Map_Raw(dfs = list(dfIE = dfIE, dfSUBJ = dfSUBJ), lMapping = list(), bQuiet = F)) - # missing variables - expect_snapshot(IE_Map_Raw(dfs = list(dfIE = dfIE %>% select(-SubjectID), dfSUBJ = dfSUBJ), bQuiet = F)) - expect_snapshot(IE_Map_Raw(dfs = list(dfIE = dfIE %>% select(-IE_CATEGORY), dfSUBJ = dfSUBJ), bQuiet = F)) - expect_snapshot(IE_Map_Raw(dfs = list(dfIE = dfIE %>% select(-IE_VALUE), dfSUBJ = dfSUBJ), bQuiet = F)) - expect_snapshot(IE_Map_Raw(dfs = list(dfIE = dfIE, dfSUBJ = dfSUBJ %>% select(-SubjectID)), bQuiet = F)) - expect_snapshot(IE_Map_Raw(dfs = list(dfIE = dfIE, dfSUBJ = dfSUBJ %>% select(-SiteID)), bQuiet = F)) - # duplicate subject IDs - expect_snapshot(IE_Map_Raw(dfs = list(dfIE = dfIE, dfSUBJ = bind_rows(dfSUBJ, head(dfSUBJ, 1))), bQuiet = F)) + test_incorrect_inputs( + IE_Map_Raw, + dfIE, + 'dfIE', + dfSUBJ, + input_spec + ) +}) + +# output is created as expected ------------------------------------------- +test_that("output created as expected ", { + test_correct_output( + IE_Map_Raw, + dfIE, + 'dfIE', + dfSUBJ, + output_mapping + ) }) # incorrect mappings throw errors ----------------------------------------- diff --git a/tests/testthat/test_PD_Map_Raw.R b/tests/testthat/test_PD_Map_Raw.R index dc08afbdc..865c342c8 100644 --- a/tests/testthat/test_PD_Map_Raw.R +++ b/tests/testthat/test_PD_Map_Raw.R @@ -1,32 +1,27 @@ source(testthat::test_path("testdata/data.R")) - -# output is created as expected ------------------------------------------- -test_that("output is created as expected", { - data <- PD_Map_Raw(dfs = list(dfPD = dfPD, dfSUBJ = dfSUBJ)) - expect_true(is.data.frame(data)) - expect_equal(names(data), c("SubjectID", "SiteID", "Count", "Exposure", "Rate")) - expect_type(data$SubjectID, "character") - expect_type(data$SiteID, "character") - expect_true(class(data$Count) %in% c("double", "integer", "numeric")) -}) +input_spec <- yaml::read_yaml(paste0(here::here(), '/inst/specs/PD_Map_Raw.yaml')) +output_mapping <- yaml::read_yaml(paste0(here::here(), '/inst/mappings/PD_Assess.yaml')) # incorrect inputs throw errors ------------------------------------------- test_that("incorrect inputs throw errors", { - # empty data frames - expect_snapshot(PD_Map_Raw(dfs = list(dfPD = list(), dfSUBJ = list()), bQuiet = F)) - expect_snapshot(PD_Map_Raw(dfs = list(dfPD = dfPD, dfSUBJ = list()), bQuiet = F)) - expect_snapshot(PD_Map_Raw(dfs = list(dfPD = list(), dfSUBJ = dfSUBJ), bQuiet = F)) - # mistyped data frames - expect_snapshot(PD_Map_Raw(dfs = list(dfPD = "Hi", dfSUBJ = "Mom"), bQuiet = F)) - # empty mapping - expect_snapshot(PD_Map_Raw(dfs = list(dfPD = dfPD, dfSUBJ = dfSUBJ), lMapping = list(), bQuiet = F)) - # missing variables - expect_snapshot(PD_Map_Raw(dfs = list(dfPD = dfPD %>% select(-SubjectID), dfSUBJ = dfSUBJ), bQuiet = F)) - expect_snapshot(PD_Map_Raw(dfs = list(dfPD = dfPD, dfSUBJ = dfSUBJ %>% select(-SubjectID)), bQuiet = F)) - expect_snapshot(PD_Map_Raw(dfs = list(dfPD = dfPD, dfSUBJ = dfSUBJ %>% select(-SiteID)), bQuiet = F)) - expect_snapshot(PD_Map_Raw(dfs = list(dfPD = dfPD, dfSUBJ = dfSUBJ %>% select(-TimeOnStudy)), bQuiet = F)) - # duplicate subject IDs - expect_snapshot(PD_Map_Raw(dfs = list(dfPD = dfPD, dfSUBJ = bind_rows(dfSUBJ, head(dfSUBJ, 1))), bQuiet = F)) + test_incorrect_inputs( + PD_Map_Raw, + dfPD, + 'dfPD', + dfSUBJ, + input_spec + ) +}) + +# output is created as expected ------------------------------------------- +test_that("output created as expected ", { + test_correct_output( + PD_Map_Raw, + dfPD, + 'dfPD', + dfSUBJ, + output_mapping + ) }) # incorrect mappings throw errors ----------------------------------------- From 3dbeea9f991d5b988231a89e982e0ec8852d9f09 Mon Sep 17 00:00:00 2001 From: Spencer Childress Date: Tue, 14 Jun 2022 13:20:17 -0400 Subject: [PATCH 73/87] asdf --- tests/testthat/test_IE_Map_Raw.R | 2 +- tests/testthat/test_PD_Map_Raw.R | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test_IE_Map_Raw.R b/tests/testthat/test_IE_Map_Raw.R index 1bd031688..7984f3b98 100644 --- a/tests/testthat/test_IE_Map_Raw.R +++ b/tests/testthat/test_IE_Map_Raw.R @@ -14,7 +14,7 @@ test_that("incorrect inputs throw errors", { }) # output is created as expected ------------------------------------------- -test_that("output created as expected ", { +test_that("output created as expected", { test_correct_output( IE_Map_Raw, dfIE, diff --git a/tests/testthat/test_PD_Map_Raw.R b/tests/testthat/test_PD_Map_Raw.R index 865c342c8..7e363deb5 100644 --- a/tests/testthat/test_PD_Map_Raw.R +++ b/tests/testthat/test_PD_Map_Raw.R @@ -14,7 +14,7 @@ test_that("incorrect inputs throw errors", { }) # output is created as expected ------------------------------------------- -test_that("output created as expected ", { +test_that("output created as expected", { test_correct_output( PD_Map_Raw, dfPD, From fb16e48287c6d23292b25fc5e9b5a486d9171c0c Mon Sep 17 00:00:00 2001 From: Spencer Childress Date: Wed, 15 Jun 2022 09:14:19 -0400 Subject: [PATCH 74/87] modularize test__Map_Raw tests --- R/tests-map_raw_helpers.R | 130 +++++++--- tests/testthat/_snaps/AE_Map_Raw.md | 176 ++++++++----- tests/testthat/_snaps/Consent_Map_Raw.md | 299 +++++++++++++---------- tests/testthat/_snaps/IE_Map_Raw.md | 213 ++++++++++------ tests/testthat/_snaps/PD_Map_Raw.md | 164 +++++++++---- tests/testthat/test_AE_Map_Raw.R | 160 ++++-------- tests/testthat/test_Consent_Map_Raw.R | 222 ++++------------- tests/testthat/test_IE_Map_Raw.R | 154 ++++-------- tests/testthat/test_PD_Map_Raw.R | 160 ++++-------- 9 files changed, 834 insertions(+), 844 deletions(-) diff --git a/R/tests-map_raw_helpers.R b/R/tests-map_raw_helpers.R index 22d686003..99d33a23e 100644 --- a/R/tests-map_raw_helpers.R +++ b/R/tests-map_raw_helpers.R @@ -1,66 +1,130 @@ -test_correct_output <- function( +test_valid_output <- function( map_function, - df_domain, - df_name, - dfSUBJ, - output_mapping + dfs, + spec, + mapping ) { - dfs <- list( - dfSUBJ = dfSUBJ - ) - dfs[[ df_name ]] <- df_domain - output <- map_function(dfs = dfs) expect_true(is.data.frame(output)) - expect_equal(names(output), as.character(output_mapping$dfInput)) + expect_equal(names(output), as.character(mapping$dfInput)) expect_type(output$SubjectID, "character") expect_type(output$SiteID, "character") expect_true(class(output$Count) %in% c("double", "integer", "numeric")) } -test_incorrect_inputs <- function( +test_invalid_data <- function( map_function, - df_domain, - df_name, - dfSUBJ, - spec + dfs, + spec, + mapping ) { - dfs <- list( - dfSUBJ = dfSUBJ - ) - dfs[[ df_name ]] <- df_domain + map_domain <- names(dfs)[ + names(dfs) != 'dfSUBJ' + ] # empty data frames - expect_snapshot(map_function(dfs = purrr::imap(dfs, ~ list()), bQuiet = F)) - expect_snapshot(map_function(dfs = purrr::imap(dfs, ~ if (.y == 'dfSUBJ') list() else .x), bQuiet = F)) - expect_snapshot(map_function(dfs = purrr::imap(dfs, ~ if (.y == df_name) list() else .x), bQuiet = F)) + expect_snapshot(map_function(dfs = purrr::imap(dfs, ~ list()), bQuiet = FALSE)) + expect_snapshot(map_function(dfs = purrr::imap(dfs, ~ if (.y == 'dfSUBJ') list() else .x), bQuiet = FALSE)) + expect_snapshot(map_function(dfs = purrr::imap(dfs, ~ if (.y == map_domain) list() else .x), bQuiet = FALSE)) # mistyped data frames - expect_snapshot(map_function(dfs = purrr::imap(dfs, ~ 'Hi Mom'), bQuiet = F)) - expect_snapshot(map_function(dfs = purrr::imap(dfs, ~ 9999), bQuiet = F)) - expect_snapshot(map_function(dfs = purrr::imap(dfs, ~ TRUE), bQuiet = F)) + expect_snapshot(map_function(dfs = purrr::imap(dfs, ~ 'Hi Mom'), bQuiet = FALSE)) + expect_snapshot(map_function(dfs = purrr::imap(dfs, ~ 9999), bQuiet = FALSE)) + expect_snapshot(map_function(dfs = purrr::imap(dfs, ~ TRUE), bQuiet = FALSE)) # empty mapping - expect_snapshot(map_function(dfs = purrr::imap(dfs, ~ .x), lMapping = list(), bQuiet = F)) + expect_snapshot(map_function(dfs = purrr::imap(dfs, ~ .x), lMapping = list(), bQuiet = FALSE)) + + # duplicate subject IDs in subject-level data frame + dfs_edited <- dfs + dfs_edited$dfSUBJ <- dfs_edited$dfSUBJ %>% bind_rows(head(., 1)) + expect_snapshot(map_function(dfs = dfs_edited, bQuiet = FALSE)) +} +test_missing_column <- function(map_function, dfs, spec, mapping) { # missing variables for (domain in names(spec)) { - required_columns <- spec[[ domain ]]$vRequired - for (column in required_columns) { + column_keys <- spec[[ domain ]]$vRequired + + for (column_key in column_keys) { + column <- mapping[[ domain ]][[ column_key ]] dfs_edited <- dfs dfs_edited[[ domain ]][[ column ]] <- NULL + expect_snapshot( map_function( dfs = dfs_edited, - bQuiet = F + bQuiet = FALSE ) ) } } +} - # duplicate subject IDs in subject-level data frame +test_missing_value <- function(map_function, dfs, spec, mapping) { + for (domain in names(spec)) { + message(domain) + df <- dfs[[ domain ]] + column_keys <- spec[[ domain ]]$vRequired + for (column_key in column_keys) { + message(column_key) + column <- mapping[[ domain ]][[ column_key ]] + message(column) + dfs_edited <- dfs + dfs_edited[[ domain ]][ sample(1:nrow(df), 1), column ] <- NA + expect_null( + map_function( + dfs = dfs_edited, + bQuiet = FALSE + ) + ) + } + } +} + +test_duplicate_subject_id <- function(map_function, dfs) { dfs_edited <- dfs - dfs_edited$dfSUBJ <- dfs_edited$dfSUBJ %>% bind_rows(head(., 1)) - expect_snapshot(map_function(dfs = dfs_edited, bQuiet = F)) + dfs_edited$dfSUBJ$SubjectID <- 1 + + expect_snapshot(map_function(dfs = dfs_edited, bQuiet = FALSE)) +} + +test_invalid_mapping <- function(map_function, dfs, spec, mapping) { + # Subset mapping on columns required in spec. + mapping_required <- mapping %>% + imap(function(columns, domain_key) { + domain_spec <- spec[[ domain_key ]]$vRequired + + columns[ + names(columns) %in% domain_spec + ] + }) + + # Run assertion for each domain-column combination in mapping. + mapping_required %>% + iwalk(function(columns, domain_key) { + iwalk(columns, function(column_value, column_key) { + mapping_edited <- mapping_required + mapping_edited[[ domain_key ]][[ column_key ]] <- 'asdf' + + expect_snapshot( + map_function( + dfs = dfs, + lMapping = mapping_edited, + bQuiet = FALSE + ) + ) + }) + }) +} + +test_logical_parameters <- function(map_function, dfs) { + expect_message( + map_function(dfs = dfs, bQuiet = FALSE) + ) + + expect_true( + all(names(map_function(dfs = dfs, bReturnChecks = TRUE)) == c("df", "lChecks")) + ) } diff --git a/tests/testthat/_snaps/AE_Map_Raw.md b/tests/testthat/_snaps/AE_Map_Raw.md index 48dc4dccb..acf7a41a3 100644 --- a/tests/testthat/_snaps/AE_Map_Raw.md +++ b/tests/testthat/_snaps/AE_Map_Raw.md @@ -1,7 +1,7 @@ -# incorrect inputs throw errors +# invalid data throw errors Code - map_function(dfs = purrr::imap(dfs, ~ list()), bQuiet = F) + map_function(dfs = purrr::imap(dfs, ~ list()), bQuiet = FALSE) Message -- Checking Input Data for `AE_Map_Raw()` -- @@ -25,7 +25,7 @@ Code map_function(dfs = purrr::imap(dfs, ~ if (.y == "dfSUBJ") list() else .x), - bQuiet = F) + bQuiet = FALSE) Message -- Checking Input Data for `AE_Map_Raw()` -- @@ -43,8 +43,8 @@ --- Code - map_function(dfs = purrr::imap(dfs, ~ if (.y == df_name) list() else .x), - bQuiet = F) + map_function(dfs = purrr::imap(dfs, ~ if (.y == map_domain) list() else .x), + bQuiet = FALSE) Message -- Checking Input Data for `AE_Map_Raw()` -- @@ -62,7 +62,7 @@ --- Code - map_function(dfs = purrr::imap(dfs, ~"Hi Mom"), bQuiet = F) + map_function(dfs = purrr::imap(dfs, ~"Hi Mom"), bQuiet = FALSE) Message -- Checking Input Data for `AE_Map_Raw()` -- @@ -85,7 +85,7 @@ --- Code - map_function(dfs = purrr::imap(dfs, ~9999), bQuiet = F) + map_function(dfs = purrr::imap(dfs, ~9999), bQuiet = FALSE) Message -- Checking Input Data for `AE_Map_Raw()` -- @@ -108,7 +108,7 @@ --- Code - map_function(dfs = purrr::imap(dfs, ~TRUE), bQuiet = F) + map_function(dfs = purrr::imap(dfs, ~TRUE), bQuiet = FALSE) Message -- Checking Input Data for `AE_Map_Raw()` -- @@ -131,7 +131,7 @@ --- Code - map_function(dfs = purrr::imap(dfs, ~.x), lMapping = list(), bQuiet = F) + map_function(dfs = purrr::imap(dfs, ~.x), lMapping = list(), bQuiet = FALSE) Message -- Checking Input Data for `AE_Map_Raw()` -- @@ -150,104 +150,162 @@ --- Code - map_function(dfs = dfs_edited, bQuiet = F) + map_function(dfs = dfs_edited, bQuiet = FALSE) Message -- Checking Input Data for `AE_Map_Raw()` -- - v No issues found for `AE_Map_Raw()` + x Unexpected duplicates found in column: SubjectID + ! Issues found for `AE_Map_Raw()` + ! `AE_Map_Raw()` did not run because of failed check. + Output + NULL + +# missing column throws errors + + Code + map_function(dfs = dfs_edited, bQuiet = FALSE) + Message - -- Initializing `AE_Map_Raw()` -- + -- Checking Input Data for `AE_Map_Raw()` -- - i Intializing merge of domain and subject data - i 1 ID(s) in subject data not found in domain data. - These participants will have 0s imputed for the following domain data columns: Count. - NA's will be imputed for all other columns. - v `AE_Map_Raw()` returned output with 3 rows. + x the following columns not found in df: SubjectID + x NA check not run + x Empty Value check not run + x Unique Column Check not run + ! Issues found for `AE_Map_Raw()` + ! `AE_Map_Raw()` did not run because of failed check. Output - SubjectID SiteID Count Exposure Rate - 1 1234 X010X 2 3455 0.0005788712 - 2 5678 X102X 2 1745 0.0011461318 - 3 9876 X999X 0 1233 0.0000000000 + NULL --- Code - map_function(dfs = dfs_edited, bQuiet = F) + map_function(dfs = dfs_edited, bQuiet = FALSE) Message -- Checking Input Data for `AE_Map_Raw()` -- - v No issues found for `AE_Map_Raw()` + x the following columns not found in df: SubjectID + x NA check not run + x Empty Value check not run + x Unique Column Check not run + ! Issues found for `AE_Map_Raw()` + ! `AE_Map_Raw()` did not run because of failed check. + Output + NULL + +--- + + Code + map_function(dfs = dfs_edited, bQuiet = FALSE) + Message - -- Initializing `AE_Map_Raw()` -- + -- Checking Input Data for `AE_Map_Raw()` -- - i Intializing merge of domain and subject data - i 1 ID(s) in subject data not found in domain data. - These participants will have 0s imputed for the following domain data columns: Count. - NA's will be imputed for all other columns. - v `AE_Map_Raw()` returned output with 3 rows. + x the following columns not found in df: SiteID + x NA check not run + x Empty Value check not run + x Unique Column Check not run + ! Issues found for `AE_Map_Raw()` + ! `AE_Map_Raw()` did not run because of failed check. Output - SubjectID SiteID Count Exposure Rate - 1 1234 X010X 2 3455 0.0005788712 - 2 5678 X102X 2 1745 0.0011461318 - 3 9876 X999X 0 1233 0.0000000000 + NULL --- Code - map_function(dfs = dfs_edited, bQuiet = F) + map_function(dfs = dfs_edited, bQuiet = FALSE) + Message + + -- Checking Input Data for `AE_Map_Raw()` -- + + x the following columns not found in df: TimeOnTreatment + x NA check not run + x Empty Value check not run + x Unique Column Check not run + ! Issues found for `AE_Map_Raw()` + ! `AE_Map_Raw()` did not run because of failed check. + Output + NULL + +# duplicate subject ID is detected + + Code + map_function(dfs = dfs_edited, bQuiet = FALSE) Message -- Checking Input Data for `AE_Map_Raw()` -- - v No issues found for `AE_Map_Raw()` + x Unexpected duplicates found in column: SubjectID + ! Issues found for `AE_Map_Raw()` + ! `AE_Map_Raw()` did not run because of failed check. + Output + NULL + +# invalid mapping throws errors + + Code + map_function(dfs = dfs, lMapping = mapping_edited, bQuiet = FALSE) + Message - -- Initializing `AE_Map_Raw()` -- + -- Checking Input Data for `AE_Map_Raw()` -- - i Intializing merge of domain and subject data - i 1 ID(s) in subject data not found in domain data. - These participants will have 0s imputed for the following domain data columns: Count. - NA's will be imputed for all other columns. - v `AE_Map_Raw()` returned output with 3 rows. + x the following columns not found in df: asdf + x NA check not run + x Empty Value check not run + x Unique Column Check not run + ! Issues found for `AE_Map_Raw()` + ! `AE_Map_Raw()` did not run because of failed check. Output - SubjectID SiteID Count Exposure Rate - 1 1234 X010X 2 3455 0.0005788712 - 2 5678 X102X 2 1745 0.0011461318 - 3 9876 X999X 0 1233 0.0000000000 + NULL --- Code - map_function(dfs = dfs_edited, bQuiet = F) + map_function(dfs = dfs, lMapping = mapping_edited, bQuiet = FALSE) Message -- Checking Input Data for `AE_Map_Raw()` -- - v No issues found for `AE_Map_Raw()` + x the following columns not found in df: asdf + x NA check not run + x Empty Value check not run + x Unique Column Check not run + ! Issues found for `AE_Map_Raw()` + ! `AE_Map_Raw()` did not run because of failed check. + Output + NULL + +--- + + Code + map_function(dfs = dfs, lMapping = mapping_edited, bQuiet = FALSE) + Message - -- Initializing `AE_Map_Raw()` -- + -- Checking Input Data for `AE_Map_Raw()` -- - i Intializing merge of domain and subject data - i 1 ID(s) in subject data not found in domain data. - These participants will have 0s imputed for the following domain data columns: Count. - NA's will be imputed for all other columns. - v `AE_Map_Raw()` returned output with 3 rows. + x the following columns not found in df: asdf + x NA check not run + x Empty Value check not run + x Unique Column Check not run + ! Issues found for `AE_Map_Raw()` + ! `AE_Map_Raw()` did not run because of failed check. Output - SubjectID SiteID Count Exposure Rate - 1 1234 X010X 2 3455 0.0005788712 - 2 5678 X102X 2 1745 0.0011461318 - 3 9876 X999X 0 1233 0.0000000000 + NULL --- Code - map_function(dfs = dfs_edited, bQuiet = F) + map_function(dfs = dfs, lMapping = mapping_edited, bQuiet = FALSE) Message -- Checking Input Data for `AE_Map_Raw()` -- - x Unexpected duplicates found in column: SubjectID + x the following columns not found in df: asdf + x NA check not run + x Empty Value check not run + x Unique Column Check not run ! Issues found for `AE_Map_Raw()` ! `AE_Map_Raw()` did not run because of failed check. Output diff --git a/tests/testthat/_snaps/Consent_Map_Raw.md b/tests/testthat/_snaps/Consent_Map_Raw.md index a4feb2a5d..3fac631a4 100644 --- a/tests/testthat/_snaps/Consent_Map_Raw.md +++ b/tests/testthat/_snaps/Consent_Map_Raw.md @@ -1,23 +1,23 @@ -# incorrect inputs throw errors +# invalid data throw errors Code - map_function(dfs = purrr::imap(dfs, ~ list()), bQuiet = F) + map_function(dfs = purrr::imap(dfs, ~ list()), bQuiet = FALSE) Message - -- Checking Input Data for `Consent_Map_Raw()` -- + -- Checking Input Data for `IE_Map_Raw()` -- x df is not a data.frame() - x the following columns not found in df: SubjectID, CONSENT_TYPE, CONSENT_VALUE, CONSENT_DATE + x the following columns not found in df: SubjectID, IE_CATEGORY, IE_VALUE x NA check not run x Empty Value check not run x Unique Column Check not run x df is not a data.frame() - x the following columns not found in df: SubjectID, SiteID, RandDate + x the following columns not found in df: SubjectID, SiteID x NA check not run x Empty Value check not run x Unique Column Check not run - ! Issues found for `Consent_Map_Raw()` - ! `Consent_Map_Raw()` did not run because of failed check. + ! Issues found for `IE_Map_Raw()` + ! `IE_Map_Raw()` did not run because of failed check. Output NULL @@ -25,286 +25,323 @@ Code map_function(dfs = purrr::imap(dfs, ~ if (.y == "dfSUBJ") list() else .x), - bQuiet = F) + bQuiet = FALSE) Message - -- Checking Input Data for `Consent_Map_Raw()` -- + -- Checking Input Data for `IE_Map_Raw()` -- x df is not a data.frame() - x the following columns not found in df: SubjectID, SiteID, RandDate + x the following columns not found in df: SubjectID, SiteID x NA check not run x Empty Value check not run x Unique Column Check not run - ! Issues found for `Consent_Map_Raw()` - ! `Consent_Map_Raw()` did not run because of failed check. + ! Issues found for `IE_Map_Raw()` + ! `IE_Map_Raw()` did not run because of failed check. Output NULL --- Code - map_function(dfs = purrr::imap(dfs, ~ if (.y == df_name) list() else .x), - bQuiet = F) + map_function(dfs = purrr::imap(dfs, ~ if (.y == map_domain) list() else .x), + bQuiet = FALSE) Message - -- Checking Input Data for `Consent_Map_Raw()` -- + -- Checking Input Data for `IE_Map_Raw()` -- x df is not a data.frame() - x the following columns not found in df: SubjectID, CONSENT_TYPE, CONSENT_VALUE, CONSENT_DATE + x the following columns not found in df: SubjectID, IE_CATEGORY, IE_VALUE x NA check not run x Empty Value check not run x Unique Column Check not run - ! Issues found for `Consent_Map_Raw()` - ! `Consent_Map_Raw()` did not run because of failed check. + ! Issues found for `IE_Map_Raw()` + ! `IE_Map_Raw()` did not run because of failed check. Output NULL --- Code - map_function(dfs = purrr::imap(dfs, ~"Hi Mom"), bQuiet = F) + map_function(dfs = purrr::imap(dfs, ~"Hi Mom"), bQuiet = FALSE) Message - -- Checking Input Data for `Consent_Map_Raw()` -- + -- Checking Input Data for `IE_Map_Raw()` -- x df is not a data.frame() - x the following columns not found in df: SubjectID, CONSENT_TYPE, CONSENT_VALUE, CONSENT_DATE + x the following columns not found in df: SubjectID, IE_CATEGORY, IE_VALUE x NA check not run x Empty Value check not run x Unique Column Check not run x df is not a data.frame() - x the following columns not found in df: SubjectID, SiteID, RandDate + x the following columns not found in df: SubjectID, SiteID x NA check not run x Empty Value check not run x Unique Column Check not run - ! Issues found for `Consent_Map_Raw()` - ! `Consent_Map_Raw()` did not run because of failed check. + ! Issues found for `IE_Map_Raw()` + ! `IE_Map_Raw()` did not run because of failed check. Output NULL --- Code - map_function(dfs = purrr::imap(dfs, ~9999), bQuiet = F) + map_function(dfs = purrr::imap(dfs, ~9999), bQuiet = FALSE) Message - -- Checking Input Data for `Consent_Map_Raw()` -- + -- Checking Input Data for `IE_Map_Raw()` -- x df is not a data.frame() - x the following columns not found in df: SubjectID, CONSENT_TYPE, CONSENT_VALUE, CONSENT_DATE + x the following columns not found in df: SubjectID, IE_CATEGORY, IE_VALUE x NA check not run x Empty Value check not run x Unique Column Check not run x df is not a data.frame() - x the following columns not found in df: SubjectID, SiteID, RandDate + x the following columns not found in df: SubjectID, SiteID x NA check not run x Empty Value check not run x Unique Column Check not run - ! Issues found for `Consent_Map_Raw()` - ! `Consent_Map_Raw()` did not run because of failed check. + ! Issues found for `IE_Map_Raw()` + ! `IE_Map_Raw()` did not run because of failed check. Output NULL --- Code - map_function(dfs = purrr::imap(dfs, ~TRUE), bQuiet = F) + map_function(dfs = purrr::imap(dfs, ~TRUE), bQuiet = FALSE) Message - -- Checking Input Data for `Consent_Map_Raw()` -- + -- Checking Input Data for `IE_Map_Raw()` -- x df is not a data.frame() - x the following columns not found in df: SubjectID, CONSENT_TYPE, CONSENT_VALUE, CONSENT_DATE + x the following columns not found in df: SubjectID, IE_CATEGORY, IE_VALUE x NA check not run x Empty Value check not run x Unique Column Check not run x df is not a data.frame() - x the following columns not found in df: SubjectID, SiteID, RandDate + x the following columns not found in df: SubjectID, SiteID x NA check not run x Empty Value check not run x Unique Column Check not run - ! Issues found for `Consent_Map_Raw()` - ! `Consent_Map_Raw()` did not run because of failed check. + ! Issues found for `IE_Map_Raw()` + ! `IE_Map_Raw()` did not run because of failed check. Output NULL --- Code - map_function(dfs = purrr::imap(dfs, ~.x), lMapping = list(), bQuiet = F) + map_function(dfs = purrr::imap(dfs, ~.x), lMapping = list(), bQuiet = FALSE) Message - -- Checking Input Data for `Consent_Map_Raw()` -- + -- Checking Input Data for `IE_Map_Raw()` -- - x "mapping" does not contain required parameters: strIDCol, strTypeCol, strValueCol, strDateCol + x "mapping" does not contain required parameters: strIDCol, strCategoryCol, strValueCol x mapping is not a list() x Non-character column names found in mapping: - x "mapping" does not contain required parameters: strIDCol, strSiteCol, strRandDateCol + x "mapping" does not contain required parameters: strIDCol, strSiteCol x mapping is not a list() x Non-character column names found in mapping: - ! Issues found for `Consent_Map_Raw()` - ! `Consent_Map_Raw()` did not run because of failed check. + ! Issues found for `IE_Map_Raw()` + ! `IE_Map_Raw()` did not run because of failed check. Output NULL --- Code - map_function(dfs = dfs_edited, bQuiet = F) + map_function(dfs = dfs_edited, bQuiet = FALSE) Message - -- Checking Input Data for `Consent_Map_Raw()` -- + -- Checking Input Data for `IE_Map_Raw()` -- - v No issues found for `Consent_Map_Raw()` + x Unexpected duplicates found in column: SubjectID + ! Issues found for `IE_Map_Raw()` + ! `IE_Map_Raw()` did not run because of failed check. + Output + NULL + +# missing column throws errors + + Code + map_function(dfs = dfs_edited, bQuiet = FALSE) + Message - -- Initializing `Consent_Map_Raw()` -- + -- Checking Input Data for `IE_Map_Raw()` -- - i Intializing merge of domain and subject data - i 1 ID(s) in subject data not found in domain data.These participants will have NA values imputed for all domain data columns: - v `Consent_Map_Raw()` returned output with 3 rows. + x the following columns not found in df: SubjectID + x NA check not run + x Empty Value check not run + x Unique Column Check not run + ! Issues found for `IE_Map_Raw()` + ! `IE_Map_Raw()` did not run because of failed check. Output - SubjectID SiteID Count - 1 1234 X010X 1 - 2 5678 X102X 1 - 3 9876 X999X 1 + NULL --- Code - map_function(dfs = dfs_edited, bQuiet = F) + map_function(dfs = dfs_edited, bQuiet = FALSE) Message - -- Checking Input Data for `Consent_Map_Raw()` -- - - v No issues found for `Consent_Map_Raw()` - - -- Initializing `Consent_Map_Raw()` -- + -- Checking Input Data for `IE_Map_Raw()` -- - i Intializing merge of domain and subject data - i 1 ID(s) in subject data not found in domain data.These participants will have NA values imputed for all domain data columns: - v `Consent_Map_Raw()` returned output with 3 rows. + x the following columns not found in df: IE_CATEGORY + x NA check not run + x Empty Value check not run + x Unique Column Check not run + ! Issues found for `IE_Map_Raw()` + ! `IE_Map_Raw()` did not run because of failed check. Output - SubjectID SiteID Count - 1 1234 X010X 1 - 2 5678 X102X 1 - 3 9876 X999X 1 + NULL --- Code - map_function(dfs = dfs_edited, bQuiet = F) + map_function(dfs = dfs_edited, bQuiet = FALSE) Message - -- Checking Input Data for `Consent_Map_Raw()` -- - - v No issues found for `Consent_Map_Raw()` - - -- Initializing `Consent_Map_Raw()` -- + -- Checking Input Data for `IE_Map_Raw()` -- - i Intializing merge of domain and subject data - i 1 ID(s) in subject data not found in domain data.These participants will have NA values imputed for all domain data columns: - v `Consent_Map_Raw()` returned output with 3 rows. + x the following columns not found in df: IE_VALUE + x NA check not run + x Empty Value check not run + x Unique Column Check not run + ! Issues found for `IE_Map_Raw()` + ! `IE_Map_Raw()` did not run because of failed check. Output - SubjectID SiteID Count - 1 1234 X010X 1 - 2 5678 X102X 1 - 3 9876 X999X 1 + NULL --- Code - map_function(dfs = dfs_edited, bQuiet = F) + map_function(dfs = dfs_edited, bQuiet = FALSE) Message - -- Checking Input Data for `Consent_Map_Raw()` -- - - v No issues found for `Consent_Map_Raw()` + -- Checking Input Data for `IE_Map_Raw()` -- - -- Initializing `Consent_Map_Raw()` -- - - i Intializing merge of domain and subject data - i 1 ID(s) in subject data not found in domain data.These participants will have NA values imputed for all domain data columns: - v `Consent_Map_Raw()` returned output with 3 rows. + x the following columns not found in df: SubjectID + x NA check not run + x Empty Value check not run + x Unique Column Check not run + ! Issues found for `IE_Map_Raw()` + ! `IE_Map_Raw()` did not run because of failed check. Output - SubjectID SiteID Count - 1 1234 X010X 1 - 2 5678 X102X 1 - 3 9876 X999X 1 + NULL --- Code - map_function(dfs = dfs_edited, bQuiet = F) + map_function(dfs = dfs_edited, bQuiet = FALSE) Message - -- Checking Input Data for `Consent_Map_Raw()` -- + -- Checking Input Data for `IE_Map_Raw()` -- - v No issues found for `Consent_Map_Raw()` + x the following columns not found in df: SiteID + x NA check not run + x Empty Value check not run + x Unique Column Check not run + ! Issues found for `IE_Map_Raw()` + ! `IE_Map_Raw()` did not run because of failed check. + Output + NULL + +# duplicate subject ID is detected + + Code + map_function(dfs = dfs_edited, bQuiet = FALSE) + Message - -- Initializing `Consent_Map_Raw()` -- + -- Checking Input Data for `IE_Map_Raw()` -- - i Intializing merge of domain and subject data - i 1 ID(s) in subject data not found in domain data.These participants will have NA values imputed for all domain data columns: - v `Consent_Map_Raw()` returned output with 3 rows. + x Unexpected duplicates found in column: SubjectID + ! Issues found for `IE_Map_Raw()` + ! `IE_Map_Raw()` did not run because of failed check. Output - SubjectID SiteID Count - 1 1234 X010X 1 - 2 5678 X102X 1 - 3 9876 X999X 1 + NULL ---- +# invalid mapping throws errors Code - map_function(dfs = dfs_edited, bQuiet = F) + map_function(dfs = dfs, lMapping = mapping_edited, bQuiet = FALSE) Message - -- Checking Input Data for `Consent_Map_Raw()` -- + -- Checking Input Data for `IE_Map_Raw()` -- - v No issues found for `Consent_Map_Raw()` + x the following columns not found in df: asdf + x NA check not run + x Empty Value check not run + x Unique Column Check not run + ! Issues found for `IE_Map_Raw()` + ! `IE_Map_Raw()` did not run because of failed check. + Output + NULL + +--- + + Code + map_function(dfs = dfs, lMapping = mapping_edited, bQuiet = FALSE) + Message - -- Initializing `Consent_Map_Raw()` -- + -- Checking Input Data for `IE_Map_Raw()` -- - i Intializing merge of domain and subject data - i 1 ID(s) in subject data not found in domain data.These participants will have NA values imputed for all domain data columns: - v `Consent_Map_Raw()` returned output with 3 rows. + x the following columns not found in df: asdf + x NA check not run + x Empty Value check not run + x Unique Column Check not run + ! Issues found for `IE_Map_Raw()` + ! `IE_Map_Raw()` did not run because of failed check. Output - SubjectID SiteID Count - 1 1234 X010X 1 - 2 5678 X102X 1 - 3 9876 X999X 1 + NULL --- Code - map_function(dfs = dfs_edited, bQuiet = F) + map_function(dfs = dfs, lMapping = mapping_edited, bQuiet = FALSE) Message - -- Checking Input Data for `Consent_Map_Raw()` -- + -- Checking Input Data for `IE_Map_Raw()` -- - v No issues found for `Consent_Map_Raw()` + x the following columns not found in df: asdf + x NA check not run + x Empty Value check not run + x Unique Column Check not run + ! Issues found for `IE_Map_Raw()` + ! `IE_Map_Raw()` did not run because of failed check. + Output + NULL + +--- + + Code + map_function(dfs = dfs, lMapping = mapping_edited, bQuiet = FALSE) + Message - -- Initializing `Consent_Map_Raw()` -- + -- Checking Input Data for `IE_Map_Raw()` -- - i Intializing merge of domain and subject data - i 1 ID(s) in subject data not found in domain data.These participants will have NA values imputed for all domain data columns: - v `Consent_Map_Raw()` returned output with 3 rows. + x the following columns not found in df: asdf + x NA check not run + x Empty Value check not run + x Unique Column Check not run + ! Issues found for `IE_Map_Raw()` + ! `IE_Map_Raw()` did not run because of failed check. Output - SubjectID SiteID Count - 1 1234 X010X 1 - 2 5678 X102X 1 - 3 9876 X999X 1 + NULL --- Code - map_function(dfs = dfs_edited, bQuiet = F) + map_function(dfs = dfs, lMapping = mapping_edited, bQuiet = FALSE) Message - -- Checking Input Data for `Consent_Map_Raw()` -- + -- Checking Input Data for `IE_Map_Raw()` -- - x Unexpected duplicates found in column: SubjectID - ! Issues found for `Consent_Map_Raw()` - ! `Consent_Map_Raw()` did not run because of failed check. + x the following columns not found in df: asdf + x NA check not run + x Empty Value check not run + x Unique Column Check not run + ! Issues found for `IE_Map_Raw()` + ! `IE_Map_Raw()` did not run because of failed check. Output NULL diff --git a/tests/testthat/_snaps/IE_Map_Raw.md b/tests/testthat/_snaps/IE_Map_Raw.md index d39271a0d..3fac631a4 100644 --- a/tests/testthat/_snaps/IE_Map_Raw.md +++ b/tests/testthat/_snaps/IE_Map_Raw.md @@ -1,7 +1,7 @@ -# incorrect inputs throw errors +# invalid data throw errors Code - map_function(dfs = purrr::imap(dfs, ~ list()), bQuiet = F) + map_function(dfs = purrr::imap(dfs, ~ list()), bQuiet = FALSE) Message -- Checking Input Data for `IE_Map_Raw()` -- @@ -25,7 +25,7 @@ Code map_function(dfs = purrr::imap(dfs, ~ if (.y == "dfSUBJ") list() else .x), - bQuiet = F) + bQuiet = FALSE) Message -- Checking Input Data for `IE_Map_Raw()` -- @@ -43,8 +43,8 @@ --- Code - map_function(dfs = purrr::imap(dfs, ~ if (.y == df_name) list() else .x), - bQuiet = F) + map_function(dfs = purrr::imap(dfs, ~ if (.y == map_domain) list() else .x), + bQuiet = FALSE) Message -- Checking Input Data for `IE_Map_Raw()` -- @@ -62,7 +62,7 @@ --- Code - map_function(dfs = purrr::imap(dfs, ~"Hi Mom"), bQuiet = F) + map_function(dfs = purrr::imap(dfs, ~"Hi Mom"), bQuiet = FALSE) Message -- Checking Input Data for `IE_Map_Raw()` -- @@ -85,7 +85,7 @@ --- Code - map_function(dfs = purrr::imap(dfs, ~9999), bQuiet = F) + map_function(dfs = purrr::imap(dfs, ~9999), bQuiet = FALSE) Message -- Checking Input Data for `IE_Map_Raw()` -- @@ -108,7 +108,7 @@ --- Code - map_function(dfs = purrr::imap(dfs, ~TRUE), bQuiet = F) + map_function(dfs = purrr::imap(dfs, ~TRUE), bQuiet = FALSE) Message -- Checking Input Data for `IE_Map_Raw()` -- @@ -131,7 +131,7 @@ --- Code - map_function(dfs = purrr::imap(dfs, ~.x), lMapping = list(), bQuiet = F) + map_function(dfs = purrr::imap(dfs, ~.x), lMapping = list(), bQuiet = FALSE) Message -- Checking Input Data for `IE_Map_Raw()` -- @@ -150,127 +150,196 @@ --- Code - map_function(dfs = dfs_edited, bQuiet = F) + map_function(dfs = dfs_edited, bQuiet = FALSE) Message -- Checking Input Data for `IE_Map_Raw()` -- - v No issues found for `IE_Map_Raw()` + x Unexpected duplicates found in column: SubjectID + ! Issues found for `IE_Map_Raw()` + ! `IE_Map_Raw()` did not run because of failed check. + Output + NULL + +# missing column throws errors + + Code + map_function(dfs = dfs_edited, bQuiet = FALSE) + Message - -- Initializing `IE_Map_Raw()` -- + -- Checking Input Data for `IE_Map_Raw()` -- - i Intializing merge of domain and subject data - i 1 ID(s) in subject data not found in domain data. - These participants will have 0s imputed for the following domain data columns: Count. - NA's will be imputed for all other columns. - v `IE_Map_Raw()` returned output with 3 rows. + x the following columns not found in df: SubjectID + x NA check not run + x Empty Value check not run + x Unique Column Check not run + ! Issues found for `IE_Map_Raw()` + ! `IE_Map_Raw()` did not run because of failed check. Output - SubjectID SiteID Count - 1 1234 X010X 0 - 2 5678 X102X 0 - 3 9876 X999X 0 + NULL --- Code - map_function(dfs = dfs_edited, bQuiet = F) + map_function(dfs = dfs_edited, bQuiet = FALSE) Message -- Checking Input Data for `IE_Map_Raw()` -- - v No issues found for `IE_Map_Raw()` + x the following columns not found in df: IE_CATEGORY + x NA check not run + x Empty Value check not run + x Unique Column Check not run + ! Issues found for `IE_Map_Raw()` + ! `IE_Map_Raw()` did not run because of failed check. + Output + NULL + +--- + + Code + map_function(dfs = dfs_edited, bQuiet = FALSE) + Message - -- Initializing `IE_Map_Raw()` -- + -- Checking Input Data for `IE_Map_Raw()` -- - i Intializing merge of domain and subject data - i 1 ID(s) in subject data not found in domain data. - These participants will have 0s imputed for the following domain data columns: Count. - NA's will be imputed for all other columns. - v `IE_Map_Raw()` returned output with 3 rows. + x the following columns not found in df: IE_VALUE + x NA check not run + x Empty Value check not run + x Unique Column Check not run + ! Issues found for `IE_Map_Raw()` + ! `IE_Map_Raw()` did not run because of failed check. Output - SubjectID SiteID Count - 1 1234 X010X 0 - 2 5678 X102X 0 - 3 9876 X999X 0 + NULL --- Code - map_function(dfs = dfs_edited, bQuiet = F) + map_function(dfs = dfs_edited, bQuiet = FALSE) Message -- Checking Input Data for `IE_Map_Raw()` -- - v No issues found for `IE_Map_Raw()` + x the following columns not found in df: SubjectID + x NA check not run + x Empty Value check not run + x Unique Column Check not run + ! Issues found for `IE_Map_Raw()` + ! `IE_Map_Raw()` did not run because of failed check. + Output + NULL + +--- + + Code + map_function(dfs = dfs_edited, bQuiet = FALSE) + Message - -- Initializing `IE_Map_Raw()` -- + -- Checking Input Data for `IE_Map_Raw()` -- - i Intializing merge of domain and subject data - i 1 ID(s) in subject data not found in domain data. - These participants will have 0s imputed for the following domain data columns: Count. - NA's will be imputed for all other columns. - v `IE_Map_Raw()` returned output with 3 rows. + x the following columns not found in df: SiteID + x NA check not run + x Empty Value check not run + x Unique Column Check not run + ! Issues found for `IE_Map_Raw()` + ! `IE_Map_Raw()` did not run because of failed check. Output - SubjectID SiteID Count - 1 1234 X010X 0 - 2 5678 X102X 0 - 3 9876 X999X 0 + NULL ---- +# duplicate subject ID is detected Code - map_function(dfs = dfs_edited, bQuiet = F) + map_function(dfs = dfs_edited, bQuiet = FALSE) Message -- Checking Input Data for `IE_Map_Raw()` -- - v No issues found for `IE_Map_Raw()` + x Unexpected duplicates found in column: SubjectID + ! Issues found for `IE_Map_Raw()` + ! `IE_Map_Raw()` did not run because of failed check. + Output + NULL + +# invalid mapping throws errors + + Code + map_function(dfs = dfs, lMapping = mapping_edited, bQuiet = FALSE) + Message - -- Initializing `IE_Map_Raw()` -- + -- Checking Input Data for `IE_Map_Raw()` -- - i Intializing merge of domain and subject data - i 1 ID(s) in subject data not found in domain data. - These participants will have 0s imputed for the following domain data columns: Count. - NA's will be imputed for all other columns. - v `IE_Map_Raw()` returned output with 3 rows. + x the following columns not found in df: asdf + x NA check not run + x Empty Value check not run + x Unique Column Check not run + ! Issues found for `IE_Map_Raw()` + ! `IE_Map_Raw()` did not run because of failed check. + Output + NULL + +--- + + Code + map_function(dfs = dfs, lMapping = mapping_edited, bQuiet = FALSE) + Message + + -- Checking Input Data for `IE_Map_Raw()` -- + + x the following columns not found in df: asdf + x NA check not run + x Empty Value check not run + x Unique Column Check not run + ! Issues found for `IE_Map_Raw()` + ! `IE_Map_Raw()` did not run because of failed check. Output - SubjectID SiteID Count - 1 1234 X010X 0 - 2 5678 X102X 0 - 3 9876 X999X 0 + NULL --- Code - map_function(dfs = dfs_edited, bQuiet = F) + map_function(dfs = dfs, lMapping = mapping_edited, bQuiet = FALSE) Message -- Checking Input Data for `IE_Map_Raw()` -- - v No issues found for `IE_Map_Raw()` + x the following columns not found in df: asdf + x NA check not run + x Empty Value check not run + x Unique Column Check not run + ! Issues found for `IE_Map_Raw()` + ! `IE_Map_Raw()` did not run because of failed check. + Output + NULL + +--- + + Code + map_function(dfs = dfs, lMapping = mapping_edited, bQuiet = FALSE) + Message - -- Initializing `IE_Map_Raw()` -- + -- Checking Input Data for `IE_Map_Raw()` -- - i Intializing merge of domain and subject data - i 1 ID(s) in subject data not found in domain data. - These participants will have 0s imputed for the following domain data columns: Count. - NA's will be imputed for all other columns. - v `IE_Map_Raw()` returned output with 3 rows. + x the following columns not found in df: asdf + x NA check not run + x Empty Value check not run + x Unique Column Check not run + ! Issues found for `IE_Map_Raw()` + ! `IE_Map_Raw()` did not run because of failed check. Output - SubjectID SiteID Count - 1 1234 X010X 0 - 2 5678 X102X 0 - 3 9876 X999X 0 + NULL --- Code - map_function(dfs = dfs_edited, bQuiet = F) + map_function(dfs = dfs, lMapping = mapping_edited, bQuiet = FALSE) Message -- Checking Input Data for `IE_Map_Raw()` -- - x Unexpected duplicates found in column: SubjectID + x the following columns not found in df: asdf + x NA check not run + x Empty Value check not run + x Unique Column Check not run ! Issues found for `IE_Map_Raw()` ! `IE_Map_Raw()` did not run because of failed check. Output diff --git a/tests/testthat/_snaps/PD_Map_Raw.md b/tests/testthat/_snaps/PD_Map_Raw.md index fabbabeed..fde7f7918 100644 --- a/tests/testthat/_snaps/PD_Map_Raw.md +++ b/tests/testthat/_snaps/PD_Map_Raw.md @@ -1,7 +1,7 @@ -# incorrect inputs throw errors +# invalid data throw errors Code - map_function(dfs = purrr::imap(dfs, ~ list()), bQuiet = F) + map_function(dfs = purrr::imap(dfs, ~ list()), bQuiet = FALSE) Message -- Checking Input Data for `PD_Map_Raw()` -- @@ -25,7 +25,7 @@ Code map_function(dfs = purrr::imap(dfs, ~ if (.y == "dfSUBJ") list() else .x), - bQuiet = F) + bQuiet = FALSE) Message -- Checking Input Data for `PD_Map_Raw()` -- @@ -43,8 +43,8 @@ --- Code - map_function(dfs = purrr::imap(dfs, ~ if (.y == df_name) list() else .x), - bQuiet = F) + map_function(dfs = purrr::imap(dfs, ~ if (.y == map_domain) list() else .x), + bQuiet = FALSE) Message -- Checking Input Data for `PD_Map_Raw()` -- @@ -62,7 +62,7 @@ --- Code - map_function(dfs = purrr::imap(dfs, ~"Hi Mom"), bQuiet = F) + map_function(dfs = purrr::imap(dfs, ~"Hi Mom"), bQuiet = FALSE) Message -- Checking Input Data for `PD_Map_Raw()` -- @@ -85,7 +85,7 @@ --- Code - map_function(dfs = purrr::imap(dfs, ~9999), bQuiet = F) + map_function(dfs = purrr::imap(dfs, ~9999), bQuiet = FALSE) Message -- Checking Input Data for `PD_Map_Raw()` -- @@ -108,7 +108,7 @@ --- Code - map_function(dfs = purrr::imap(dfs, ~TRUE), bQuiet = F) + map_function(dfs = purrr::imap(dfs, ~TRUE), bQuiet = FALSE) Message -- Checking Input Data for `PD_Map_Raw()` -- @@ -131,7 +131,7 @@ --- Code - map_function(dfs = purrr::imap(dfs, ~.x), lMapping = list(), bQuiet = F) + map_function(dfs = purrr::imap(dfs, ~.x), lMapping = list(), bQuiet = FALSE) Message -- Checking Input Data for `PD_Map_Raw()` -- @@ -150,92 +150,162 @@ --- Code - map_function(dfs = dfs_edited, bQuiet = F) + map_function(dfs = dfs_edited, bQuiet = FALSE) Message -- Checking Input Data for `PD_Map_Raw()` -- - v No issues found for `PD_Map_Raw()` + x Unexpected duplicates found in column: SubjectID + ! Issues found for `PD_Map_Raw()` + ! `PD_Map_Raw()` did not run because of failed check. + Output + NULL + +# missing column throws errors + + Code + map_function(dfs = dfs_edited, bQuiet = FALSE) + Message - -- Initializing `PD_Map_Raw()` -- + -- Checking Input Data for `PD_Map_Raw()` -- - i Intializing merge of domain and subject data - v `PD_Map_Raw()` returned output with 3 rows. + x the following columns not found in df: SubjectID + x NA check not run + x Empty Value check not run + x Unique Column Check not run + ! Issues found for `PD_Map_Raw()` + ! `PD_Map_Raw()` did not run because of failed check. Output - SubjectID SiteID Count Exposure Rate - 1 1234 X010X 2 1234 0.0016207455 - 2 5678 X102X 3 2345 0.0012793177 - 3 9876 X999X 2 4567 0.0004379242 + NULL --- Code - map_function(dfs = dfs_edited, bQuiet = F) + map_function(dfs = dfs_edited, bQuiet = FALSE) Message -- Checking Input Data for `PD_Map_Raw()` -- - v No issues found for `PD_Map_Raw()` + x the following columns not found in df: SubjectID + x NA check not run + x Empty Value check not run + x Unique Column Check not run + ! Issues found for `PD_Map_Raw()` + ! `PD_Map_Raw()` did not run because of failed check. + Output + NULL + +--- + + Code + map_function(dfs = dfs_edited, bQuiet = FALSE) + Message - -- Initializing `PD_Map_Raw()` -- + -- Checking Input Data for `PD_Map_Raw()` -- - i Intializing merge of domain and subject data - v `PD_Map_Raw()` returned output with 3 rows. + x the following columns not found in df: SiteID + x NA check not run + x Empty Value check not run + x Unique Column Check not run + ! Issues found for `PD_Map_Raw()` + ! `PD_Map_Raw()` did not run because of failed check. Output - SubjectID SiteID Count Exposure Rate - 1 1234 X010X 2 1234 0.0016207455 - 2 5678 X102X 3 2345 0.0012793177 - 3 9876 X999X 2 4567 0.0004379242 + NULL --- Code - map_function(dfs = dfs_edited, bQuiet = F) + map_function(dfs = dfs_edited, bQuiet = FALSE) + Message + + -- Checking Input Data for `PD_Map_Raw()` -- + + x the following columns not found in df: TimeOnStudy + x NA check not run + x Empty Value check not run + x Unique Column Check not run + ! Issues found for `PD_Map_Raw()` + ! `PD_Map_Raw()` did not run because of failed check. + Output + NULL + +# duplicate subject ID is detected + + Code + map_function(dfs = dfs_edited, bQuiet = FALSE) Message -- Checking Input Data for `PD_Map_Raw()` -- - v No issues found for `PD_Map_Raw()` + x Unexpected duplicates found in column: SubjectID + ! Issues found for `PD_Map_Raw()` + ! `PD_Map_Raw()` did not run because of failed check. + Output + NULL + +# invalid mapping throws errors + + Code + map_function(dfs = dfs, lMapping = mapping_edited, bQuiet = FALSE) + Message - -- Initializing `PD_Map_Raw()` -- + -- Checking Input Data for `PD_Map_Raw()` -- - i Intializing merge of domain and subject data - v `PD_Map_Raw()` returned output with 3 rows. + x the following columns not found in df: asdf + x NA check not run + x Empty Value check not run + x Unique Column Check not run + ! Issues found for `PD_Map_Raw()` + ! `PD_Map_Raw()` did not run because of failed check. Output - SubjectID SiteID Count Exposure Rate - 1 1234 X010X 2 1234 0.0016207455 - 2 5678 X102X 3 2345 0.0012793177 - 3 9876 X999X 2 4567 0.0004379242 + NULL --- Code - map_function(dfs = dfs_edited, bQuiet = F) + map_function(dfs = dfs, lMapping = mapping_edited, bQuiet = FALSE) Message -- Checking Input Data for `PD_Map_Raw()` -- - v No issues found for `PD_Map_Raw()` + x the following columns not found in df: asdf + x NA check not run + x Empty Value check not run + x Unique Column Check not run + ! Issues found for `PD_Map_Raw()` + ! `PD_Map_Raw()` did not run because of failed check. + Output + NULL + +--- + + Code + map_function(dfs = dfs, lMapping = mapping_edited, bQuiet = FALSE) + Message - -- Initializing `PD_Map_Raw()` -- + -- Checking Input Data for `PD_Map_Raw()` -- - i Intializing merge of domain and subject data - v `PD_Map_Raw()` returned output with 3 rows. + x the following columns not found in df: asdf + x NA check not run + x Empty Value check not run + x Unique Column Check not run + ! Issues found for `PD_Map_Raw()` + ! `PD_Map_Raw()` did not run because of failed check. Output - SubjectID SiteID Count Exposure Rate - 1 1234 X010X 2 1234 0.0016207455 - 2 5678 X102X 3 2345 0.0012793177 - 3 9876 X999X 2 4567 0.0004379242 + NULL --- Code - map_function(dfs = dfs_edited, bQuiet = F) + map_function(dfs = dfs, lMapping = mapping_edited, bQuiet = FALSE) Message -- Checking Input Data for `PD_Map_Raw()` -- - x Unexpected duplicates found in column: SubjectID + x the following columns not found in df: asdf + x NA check not run + x Empty Value check not run + x Unique Column Check not run ! Issues found for `PD_Map_Raw()` ! `PD_Map_Raw()` did not run because of failed check. Output diff --git a/tests/testthat/test_AE_Map_Raw.R b/tests/testthat/test_AE_Map_Raw.R index 6fc506a77..d3ce4507a 100644 --- a/tests/testthat/test_AE_Map_Raw.R +++ b/tests/testthat/test_AE_Map_Raw.R @@ -1,133 +1,67 @@ source(testthat::test_path("testdata/data.R")) + +map_function <- gsm::AE_Map_Raw + +dfs <- list( + dfAE = dfAE, + dfSUBJ = dfSUBJ +) + input_spec <- yaml::read_yaml(paste0(here::here(), '/inst/specs/AE_Map_Raw.yaml')) -output_mapping <- yaml::read_yaml(paste0(here::here(), '/inst/mappings/AE_Assess.yaml')) +input_mapping <- yaml::read_yaml(paste0(here::here(), '/inst/mappings/AE_Map_Raw.yaml')) -# incorrect inputs throw errors ------------------------------------------- -test_that("incorrect inputs throw errors", { - test_incorrect_inputs( - AE_Map_Raw, - dfAE, - 'dfAE', - dfSUBJ, - input_spec - ) -}) +output_spec <- yaml::read_yaml(paste0(here::here(), '/inst/specs/AE_Assess.yaml')) +output_mapping <- yaml::read_yaml(paste0(here::here(), '/inst/mappings/AE_Assess.yaml')) -# output is created as expected ------------------------------------------- -test_that("output is created as expected", { - test_correct_output( - AE_Map_Raw, - dfAE, - 'dfAE', - dfSUBJ, +test_that("valid output is returned", { + test_valid_output( + map_function, + dfs, + output_spec, output_mapping ) }) -# incorrect mappings throw errors ----------------------------------------- -test_that("incorrect mappings throw errors", { - expect_snapshot( - AE_Map_Raw( - dfs = list(dfAE = dfAE, dfSUBJ = dfSUBJ), - lMapping = list( - dfAE = list(strIDCol = "not an id"), - dfSUBJ = list( - strIDCol = "SubjectID", - strSiteCol = "SiteID", - strTimeOnTreatmentCol = "TimeOnTreatment" - ) - ), - bQuiet = F +test_that("invalid data throw errors", { + test_invalid_data( + map_function, + dfs, + input_spec, + input_mapping ) - ) +}) - expect_snapshot( - AE_Map_Raw( - dfs = list(dfAE = dfAE, dfSUBJ = dfSUBJ), - lMapping = list( - dfAE = list(strIDCol = "SubjectID"), - dfSUBJ = list( - strIDCol = "not an id", - strSiteCol = "SiteID", - strTimeOnTreatmentCol = "TimeOnTreatment" - ) - ), - bQuiet = F +test_that("missing column throws errors", { + test_missing_column( + map_function, + dfs, + input_spec, + input_mapping ) - ) }) -# custom tests ------------------------------------------------------------ -test_that("NA values in input data are handled", { - # NA SiteID and TimeOnTreatment. - dfAE1 <- tibble::tribble( - ~SubjectID, 1, 1, 1, 1, 2, 2, 4, 4 - ) - dfSUBJ1 <- tibble::tribble( - ~SubjectID, ~SiteID, ~TimeOnTreatment, - 1, 1, 10, - 2, 1, NA, - 3, NA, 30, - 4, 2, 50 - ) - mapped1 <- AE_Map_Raw( - list(dfAE = dfAE1, dfSUBJ = dfSUBJ1) - ) - expect_null(mapped1) - - # NA SubjectID in AE domain. - dfAE2 <- tibble::tribble( - ~SubjectID, 1, NA, 1, 1, 2, 2, 4, 4 - ) - dfSUBJ2 <- tibble::tribble( - ~SubjectID, ~SiteID, ~TimeOnTreatment, - 1, 1, 10, - 2, 1, 20, - 3, 3, 30, - 4, 2, 50 - ) - mapped2 <- AE_Map_Raw( - list(dfAE = dfAE2, dfSUBJ = dfSUBJ2) - ) - expect_null(mapped2) - - # NA SubjectID in SUBJ domain. - dfAE3 <- tibble::tribble( - ~SubjectID, 1, 1, 1, 1, 2, 2, 4, 4 - ) - dfSUBJ3 <- tibble::tribble( - ~SubjectID, ~SiteID, ~TimeOnTreatment, - NA, 1, 10, - 2, 1, 20, - 3, 2, 30, - 4, 2, 50 - ) - mapped3 <- AE_Map_Raw( - list(dfAE = dfAE3, dfSUBJ = dfSUBJ3) - ) - expect_null(mapped3) +test_that("missing value throws errors", { + test_missing_value( + map_function, + dfs, + input_spec, + input_mapping + ) }) -test_that("duplicate SubjectID values are caught in dfSUBJ", { - dfAE <- tribble(~SubjectID, 1, 2) - - dfSUBJ <- tribble( - ~SubjectID, ~SiteID, ~TimeOnTreatment, - 1, 1, 10, - 1, 1, 30 - ) - - expect_snapshot(AE_Map_Raw(dfs = list(dfAE = dfAE, dfSUBJ = dfSUBJ), bQuiet = F)) +test_that('duplicate subject ID is detected', { + test_duplicate_subject_id(map_function, dfs) }) -test_that("bQuiet works as intended", { - expect_message( - AE_Map_Raw(dfs = list(dfAE = dfAE, dfSUBJ = dfSUBJ), bQuiet = FALSE) - ) +test_that("invalid mapping throws errors", { + test_invalid_mapping( + map_function, + dfs, + input_spec, + input_mapping + ) }) -test_that("bReturnChecks works as intended", { - expect_true( - all(names(AE_Map_Raw(dfs = list(dfAE = dfAE, dfSUBJ = dfSUBJ), bReturnChecks = TRUE)) == c("df", "lChecks")) - ) +test_that("bQuiet and bReturnChecks work as intended", { + test_logical_parameters(map_function, dfs) }) diff --git a/tests/testthat/test_Consent_Map_Raw.R b/tests/testthat/test_Consent_Map_Raw.R index 6f649eed6..5fae4073c 100644 --- a/tests/testthat/test_Consent_Map_Raw.R +++ b/tests/testthat/test_Consent_Map_Raw.R @@ -1,187 +1,67 @@ source(testthat::test_path("testdata/data.R")) -input_spec <- yaml::read_yaml(paste0(here::here(), '/inst/specs/Consent_Map_Raw.yaml')) -output_mapping <- yaml::read_yaml(paste0(here::here(), '/inst/mappings/Consent_Assess.yaml')) -# incorrect inputs throw errors ------------------------------------------- -test_that("incorrect inputs throw errors", { - test_incorrect_inputs( - Consent_Map_Raw, - dfCONSENT, - 'dfCONSENT', - dfSUBJ, - input_spec - ) -}) +map_function <- gsm::IE_Map_Raw + +dfs <- list( + dfIE = dfIE, + dfSUBJ = dfSUBJ +) -# output is created as expected ------------------------------------------- -test_that("output created as expected ", { - test_correct_output( - Consent_Map_Raw, - dfCONSENT, - 'dfCONSENT', - dfSUBJ, +input_spec <- yaml::read_yaml(paste0(here::here(), '/inst/specs/IE_Map_Raw.yaml')) +input_mapping <- yaml::read_yaml(paste0(here::here(), '/inst/mappings/IE_Map_Raw.yaml')) + +output_spec <- yaml::read_yaml(paste0(here::here(), '/inst/specs/IE_Assess.yaml')) +output_mapping <- yaml::read_yaml(paste0(here::here(), '/inst/mappings/IE_Assess.yaml')) + +test_that("valid output is returned", { + test_valid_output( + map_function, + dfs, + output_spec, output_mapping ) }) -# incorrect mappings throw errors ----------------------------------------- -test_that("incorrect mappings throw errors", { - expect_snapshot(Consent_Map_Raw( - dfs = list(dfCONSENT = dfCONSENT, dfSUBJ = dfSUBJ), - lMapping = list( - dfCONSENT = list( - strIDCol = "not an id", - strTypeCol = "CONSENT_TYPE", - strValueCol = "CONSENT_VALUE", - strDateCol = "CONSENT_DATE" - ), - dfSUBJ = list( - strIDCol = "SubjectID", - strSiteCol = "SiteID", - strRandDateCol = "RandDate" - ) - ), - bQuiet = F - )) - - expect_snapshot(Consent_Map_Raw( - dfs = list(dfCONSENT = dfCONSENT, dfSUBJ = dfSUBJ), - lMapping = list( - dfCONSENT = list( - strIDCol = "SubjectID", - strTypeCol = "CONSENT_TYPE", - strValueCol = "CONSENT_VALUE", - strDateCol = "CONSENT_DATE" - ), - dfSUBJ = list( - strIDCol = "not an id", - strSiteCol = "SiteID", - strRandDateCol = "RandDate" - ) - ), - bQuiet = F - )) +test_that("invalid data throw errors", { + test_invalid_data( + map_function, + dfs, + input_spec, + input_mapping + ) }) -# custom tests ------------------------------------------------------------ -test_that("NA values in input data are handled", { - # NA SiteID and TimeOnTreatment. - dfCONSENT1 <- tibble::tribble( - ~SubjectID, 1, 1, 1, 1, 2, 2, 4, 4 - ) - dfExposure1 <- tibble::tribble( - ~SubjectID, ~SiteID, ~TimeOnTreatment, - 1, 1, 10, - 2, 1, NA, - 3, NA, 30, - 4, 2, 50 - ) - mapped1 <- Consent_Map_Raw( - list(dfCONSENT = dfCONSENT1, dfSUBJ = dfExposure1) - ) - expect_null(mapped1) +test_that("missing column throws errors", { + test_missing_column( + map_function, + dfs, + input_spec, + input_mapping + ) +}) - # NA SubjectID in Consent domain. - dfCONSENT2 <- tibble::tribble( - ~SubjectID, 1, NA, 1, 1, 2, 2, 4, 4 - ) - dfExposure2 <- tibble::tribble( - ~SubjectID, ~SiteID, ~TimeOnTreatment, - 1, 1, 10, - 2, 1, 20, - 3, 3, 30, - 4, 2, 50 - ) - mapped2 <- Consent_Map_Raw( - list(dfCONSENT = dfCONSENT2, dfSUBJ = dfExposure2) - ) - expect_null(mapped2) +test_that("missing value throws errors", { + test_missing_value( + map_function, + dfs, + input_spec, + input_mapping + ) +}) - # NA SubjectID in SUBJ domain. - dfCONSENT3 <- tibble::tribble( - ~SubjectID, 1, 1, 1, 1, 2, 2, 4, 4 - ) - dfExposure3 <- tibble::tribble( - ~SubjectID, ~SiteID, ~TimeOnTreatment, - NA, 1, 10, - 2, 1, 20, - 3, 2, 30, - 4, 2, 50 - ) - mapped3 <- Consent_Map_Raw( - list(dfCONSENT = dfCONSENT3, dfSUBJ = dfExposure3) - ) - expect_null(mapped3) +test_that('duplicate subject ID is detected', { + test_duplicate_subject_id(map_function, dfs) }) -test_that("bQuiet works as intended", { - expect_message( - Consent_Map_Raw(dfs = list(dfCONSENT = dfCONSENT, dfSUBJ = dfSUBJ), bQuiet = FALSE) - ) +test_that("invalid mapping throws errors", { + test_invalid_mapping( + map_function, + dfs, + input_spec, + input_mapping + ) }) -test_that("bReturnChecks works as intended", { - expect_true( - all(names(Consent_Map_Raw(dfs = list(dfCONSENT = dfCONSENT, dfSUBJ = dfSUBJ), bReturnChecks = TRUE)) == c("df", "lChecks")) - ) +test_that("bQuiet and bReturnChecks work as intended", { + test_logical_parameters(map_function, dfs) }) -# dfCONSENT_test_NA1 <- tibble::tribble(~SubjectID, ~CONSENT_TYPE , ~CONSENT_VALUE, ~CONSENT_DATE, -# NA, "MAINCONSENT", "Yes", "2014-12-25", -# 1, "MAINCONSENT", "No", "2014-12-25" ) -# -# dfSUBJ_test_NA1<- tibble::tribble(~SubjectID, ~SiteID, ~RandDate, -# 1, 1, "2013-12-25", -# 2, 2, "2015-12-25") -# -# dfCONSENT_test_NA2 <- tibble::tribble(~SubjectID, ~CONSENT_TYPE , ~CONSENT_VALUE, ~CONSENT_DATE, -# 1, "MAINCONSENT", "Yes", "2014-12-25", -# 1, "MAINCONSENT", "No", "2014-12-25" ) -# -# dfSUBJ_test_NA2<- tibble::tribble(~SubjectID, ~SiteID, ~RandDate, -# NA, 1, "2013-12-25", -# 2, 2, "2015-12-25") -# -# -# -# -# -# test_that("NA's in SubjectID and SUBJID are handled correctly",{ -# suppressMessages(expect_error(Consent_Map_Raw(dfCONSENT = dfCONSENT_test_NA1, dfSUBJ = dfSUBJ_test_NA1))) -# suppressMessages(expect_error(Consent_Map_Raw(dfCONSENT = dfCONSENT_test_NA2, dfSUBJ = dfSUBJ_test_NA2))) -# }) -# -# test_that("Incorrect strConsentTypeValue throws errors",{ -# suppressMessages(expect_error(Consent_Map_Raw(dfCONSENT = dfCONSENT_test, dfSUBJ = dfSUBJ_test, strConsentTypeValue = c("A","B")))) -# suppressMessages(expect_error(Consent_Map_Raw(dfCONSENT = dfCONSENT_test, dfSUBJ = dfSUBJ_test, strConsentTypeValue = 1.23))) -# suppressMessages(expect_error(Consent_Map_Raw(dfCONSENT = dfCONSENT_test, dfSUBJ = dfSUBJ_test, strConsentTypeValue = "Name_Not_in_data"))) -# }) -# -# dfCONSENT_test2 <- tibble::tribble(~SUBJID, ~CONSENT_TYPE , ~CONSENT_VALUE , ~CONSENT_DATE , -# 1, "MAINCONSENT", "Yes", "2014-12-25", -# 1, "MAINCONSENT", "No", "2014-12-25") -# -# dfSUBJ_test2 <- tibble::tribble(~SubjectID, ~SiteID, ~RandDate, -# 1, 1, "2013-12-25", -# 2, 2, "2015-12-25") -# -# -# dfInput_test2 <- tibble::tribble( -# ~SubjectID, ~SiteID, ~Count, -# 1, 1, 1, -# 1, 1, 1) -# -# -# test_that("NA's in data are caught and error thrown",{ -# -# dfCONSENT_test_in <- dfCONSENT_test2; dfCONSENT_test_in[1,2] = NA -# suppressMessages(expect_error(Consent_Map_Raw(dfCONSENT = dfCONSENT_test_in, dfSUBJ = dfSUBJ_test2))) -# -# dfCONSENT_test_in <- dfCONSENT_test2; dfCONSENT_test_in[1,3] = NA -# suppressMessages(expect_error(Consent_Map_Raw(dfCONSENT = dfCONSENT_test_in, dfSUBJ = dfSUBJ_test2))) -# -# dfSUBJ_in <- dfSUBJ_test2; dfSUBJ_in[2,2] = NA -# suppressMessages(expect_error(suppressWarnings(Consent_Map_Raw(dfCONSENT = dfCONSENT_test2, dfSUBJ = dfSUBJ_in)))) -# -# dfSUBJ_in <- dfSUBJ_test2; dfSUBJ_in[2,2] = NA -# suppressMessages(expect_error(Consent_Map_Raw( dfCONSENT = dfCONSENT_test2, dfSUBJ = dfSUBJ_in ))) -# }) diff --git a/tests/testthat/test_IE_Map_Raw.R b/tests/testthat/test_IE_Map_Raw.R index 7984f3b98..5fae4073c 100644 --- a/tests/testthat/test_IE_Map_Raw.R +++ b/tests/testthat/test_IE_Map_Raw.R @@ -1,123 +1,67 @@ source(testthat::test_path("testdata/data.R")) + +map_function <- gsm::IE_Map_Raw + +dfs <- list( + dfIE = dfIE, + dfSUBJ = dfSUBJ +) + input_spec <- yaml::read_yaml(paste0(here::here(), '/inst/specs/IE_Map_Raw.yaml')) +input_mapping <- yaml::read_yaml(paste0(here::here(), '/inst/mappings/IE_Map_Raw.yaml')) + +output_spec <- yaml::read_yaml(paste0(here::here(), '/inst/specs/IE_Assess.yaml')) output_mapping <- yaml::read_yaml(paste0(here::here(), '/inst/mappings/IE_Assess.yaml')) -# incorrect inputs throw errors ------------------------------------------- -test_that("incorrect inputs throw errors", { - test_incorrect_inputs( - IE_Map_Raw, - dfIE, - 'dfIE', - dfSUBJ, - input_spec +test_that("valid output is returned", { + test_valid_output( + map_function, + dfs, + output_spec, + output_mapping ) }) -# output is created as expected ------------------------------------------- -test_that("output created as expected", { - test_correct_output( - IE_Map_Raw, - dfIE, - 'dfIE', - dfSUBJ, - output_mapping +test_that("invalid data throw errors", { + test_invalid_data( + map_function, + dfs, + input_spec, + input_mapping ) }) -# incorrect mappings throw errors ----------------------------------------- -test_that("incorrect mappings throw errors", { - expect_snapshot(IE_Map_Raw( - dfs = list(dfIE = dfIE, dfSUBJ = dfSUBJ), - lMapping = list( - dfIE = list( - strIDCol = "not an id", - strCategoryCol = "IE_CATEGORY", - strValueCol = "IE_VALUE" - ), - dfSUBJ = list( - strIDCol = "SubjectID", - strSiteCol = "SiteID" - ) - ), - bQuiet = F - )) - - expect_snapshot(IE_Map_Raw( - dfs = list(dfIE = dfIE, dfSUBJ = dfSUBJ), - lMapping = list( - dfIE = list( - strIDCol = "SubjectID", - strCategoryCol = "IE_CATEGORY", - strValueCol = "IE_VALUE" - ), - dfSUBJ = list( - strIDCol = "not an id", - strSiteCol = "SiteID" - ) - ), - bQuiet = F - )) +test_that("missing column throws errors", { + test_missing_column( + map_function, + dfs, + input_spec, + input_mapping + ) }) -# custom tests ------------------------------------------------------------ -test_that("NA values in input data are handled", { - # NA SiteID and TimeOnTreatment. - dfIE1 <- tibble::tribble( - ~SubjectID, 1, 1, 1, 1, 2, 2, 4, 4 - ) - dfExposure1 <- tibble::tribble( - ~SubjectID, ~SiteID, ~TimeOnTreatment, - 1, 1, 10, - 2, 1, NA, - 3, NA, 30, - 4, 2, 50 - ) - mapped1 <- IE_Map_Raw( - list(dfIE = dfIE1, dfSUBJ = dfExposure1) - ) - expect_null(mapped1) - - # NA SubjectID in IE domain. - dfIE2 <- tibble::tribble( - ~SubjectID, 1, NA, 1, 1, 2, 2, 4, 4 - ) - dfExposure2 <- tibble::tribble( - ~SubjectID, ~SiteID, ~TimeOnTreatment, - 1, 1, 10, - 2, 1, 20, - 3, 3, 30, - 4, 2, 50 - ) - mapped2 <- IE_Map_Raw( - list(dfIE = dfIE2, dfSUBJ = dfExposure2) - ) - expect_null(mapped2) +test_that("missing value throws errors", { + test_missing_value( + map_function, + dfs, + input_spec, + input_mapping + ) +}) - # NA SubjectID in SUBJ domain. - dfIE3 <- tibble::tribble( - ~SubjectID, 1, 1, 1, 1, 2, 2, 4, 4 - ) - dfExposure3 <- tibble::tribble( - ~SubjectID, ~SiteID, ~TimeOnTreatment, - NA, 1, 10, - 2, 1, 20, - 3, 2, 30, - 4, 2, 50 - ) - mapped3 <- IE_Map_Raw( - list(dfIE = dfIE3, dfSUBJ = dfExposure3) - ) - expect_null(mapped3) +test_that('duplicate subject ID is detected', { + test_duplicate_subject_id(map_function, dfs) }) -test_that("bQuiet works as intended", { - expect_message( - IE_Map_Raw(dfs = list(dfIE = dfIE, dfSUBJ = dfSUBJ), bQuiet = FALSE) - ) +test_that("invalid mapping throws errors", { + test_invalid_mapping( + map_function, + dfs, + input_spec, + input_mapping + ) }) -test_that("bReturnChecks works as intended", { - expect_true( - all(names(IE_Map_Raw(dfs = list(dfIE = dfIE, dfSUBJ = dfSUBJ), bReturnChecks = TRUE)) == c("df", "lChecks")) - ) +test_that("bQuiet and bReturnChecks work as intended", { + test_logical_parameters(map_function, dfs) }) diff --git a/tests/testthat/test_PD_Map_Raw.R b/tests/testthat/test_PD_Map_Raw.R index 7e363deb5..0c559923e 100644 --- a/tests/testthat/test_PD_Map_Raw.R +++ b/tests/testthat/test_PD_Map_Raw.R @@ -1,133 +1,67 @@ source(testthat::test_path("testdata/data.R")) + +map_function <- gsm::PD_Map_Raw + +dfs <- list( + dfPD = dfPD, + dfSUBJ = dfSUBJ +) + input_spec <- yaml::read_yaml(paste0(here::here(), '/inst/specs/PD_Map_Raw.yaml')) -output_mapping <- yaml::read_yaml(paste0(here::here(), '/inst/mappings/PD_Assess.yaml')) +input_mapping <- yaml::read_yaml(paste0(here::here(), '/inst/mappings/PD_Map_Raw.yaml')) -# incorrect inputs throw errors ------------------------------------------- -test_that("incorrect inputs throw errors", { - test_incorrect_inputs( - PD_Map_Raw, - dfPD, - 'dfPD', - dfSUBJ, - input_spec - ) -}) +output_spec <- yaml::read_yaml(paste0(here::here(), '/inst/specs/PD_Assess.yaml')) +output_mapping <- yaml::read_yaml(paste0(here::here(), '/inst/mappings/PD_Assess.yaml')) -# output is created as expected ------------------------------------------- -test_that("output created as expected", { - test_correct_output( - PD_Map_Raw, - dfPD, - 'dfPD', - dfSUBJ, +test_that("valid output is returned", { + test_valid_output( + map_function, + dfs, + output_spec, output_mapping ) }) -# incorrect mappings throw errors ----------------------------------------- -test_that("incorrect mappings throw errors", { - expect_snapshot( - PD_Map_Raw( - dfs = list(dfPD = dfPD, dfSUBJ = dfSUBJ), - lMapping = list( - dfPD = list(strIDCol = "not an id"), - dfSUBJ = list( - strIDCol = "SubjectID", - strSiteCol = "SiteID", - strTimeOnStudyCol = "TimeOnStudy" - ) - ), - bQuiet = F +test_that("invalid data throw errors", { + test_invalid_data( + map_function, + dfs, + input_spec, + input_mapping ) - ) +}) - expect_snapshot( - PD_Map_Raw( - dfs = list(dfPD = dfPD, dfSUBJ = dfSUBJ), - lMapping = list( - dfPD = list(strIDCol = "SubjectID"), - dfSUBJ = list( - strIDCol = "not an id", - strSiteCol = "SiteID", - strTimeOnStudyCol = "TimeOnStudy" - ) - ), - bQuiet = F +test_that("missing column throws errors", { + test_missing_column( + map_function, + dfs, + input_spec, + input_mapping ) - ) }) -# custom tests ------------------------------------------------------------ -test_that("NA values in input data are handled", { - # NA SiteID and TimeOnStudy. - dfPD1 <- tibble::tribble( - ~SubjectID, 1, 1, 1, 1, 2, 2, 4, 4 - ) - dfSUBJ1 <- tibble::tribble( - ~SubjectID, ~SiteID, ~TimeOnStudy, - 1, 1, 10, - 2, 1, NA, - 3, NA, 30, - 4, 2, 50 - ) - mapped1 <- PD_Map_Raw( - list(dfPD = dfPD1, dfSUBJ = dfSUBJ1) - ) - expect_null(mapped1) - - # NA SubjectID in PD domain. - dfPD2 <- tibble::tribble( - ~SubjectID, 1, NA, 1, 1, 2, 2, 4, 4 - ) - dfSUBJ2 <- tibble::tribble( - ~SubjectID, ~SiteID, ~TimeOnStudy, - 1, 1, 10, - 2, 1, 20, - 3, 3, 30, - 4, 2, 50 - ) - mapped2 <- PD_Map_Raw( - list(dfPD = dfPD2, dfSUBJ = dfSUBJ2) - ) - expect_null(mapped2) - - # NA SubjectID in SUBJ domain. - dfPD3 <- tibble::tribble( - ~SubjectID, 1, 1, 1, 1, 2, 2, 4, 4 - ) - dfSUBJ3 <- tibble::tribble( - ~SubjectID, ~SiteID, ~TimeOnStudy, - NA, 1, 10, - 2, 1, 20, - 3, 2, 30, - 4, 2, 50 - ) - mapped3 <- PD_Map_Raw( - list(dfPD = dfPD3, dfSUBJ = dfSUBJ3) - ) - expect_null(mapped3) +test_that("missing value throws errors", { + test_missing_value( + map_function, + dfs, + input_spec, + input_mapping + ) }) -test_that("duplicate SubjectID values are caught in dfSUBJ", { - dfPD <- tribble(~SubjectID, 1, 2) - - dfSUBJ <- tribble( - ~SubjectID, ~SiteID, ~TimeOnStudy, - 1, 1, 10, - 1, 1, 30 - ) - - expect_snapshot(PD_Map_Raw(dfs = list(dfPD = dfPD, dfSUBJ = dfSUBJ), bQuiet = F)) +test_that('duplicate subject ID is detected', { + test_duplicate_subject_id(map_function, dfs) }) -test_that("bQuiet works as intended", { - expect_message( - PD_Map_Raw(dfs = list(dfPD = dfPD, dfSUBJ = dfSUBJ), bQuiet = FALSE) - ) +test_that("invalid mapping throws errors", { + test_invalid_mapping( + map_function, + dfs, + input_spec, + input_mapping + ) }) -test_that("bReturnChecks works as intended", { - expect_true( - all(names(PD_Map_Raw(dfs = list(dfPD = dfPD, dfSUBJ = dfSUBJ), bReturnChecks = TRUE)) == c("df", "lChecks")) - ) +test_that("bQuiet and bReturnChecks work as intended", { + test_logical_parameters(map_function, dfs) }) From 8dcefe5b1e43e0b2d110b3dc9e19c15e6644098d Mon Sep 17 00:00:00 2001 From: Spencer Childress Date: Wed, 15 Jun 2022 09:47:59 -0400 Subject: [PATCH 75/87] reconcile AE_Assess and PD_Assess --- R/tests-assess_helpers.R | 9 +++ tests/testthat/test_AE_Assess.R | 77 ++++++++++++++------------ tests/testthat/test_Analyze_Wilcoxon.R | 6 +- tests/testthat/test_PD_Assess.R | 74 ++++++++++++------------- 4 files changed, 88 insertions(+), 78 deletions(-) create mode 100644 R/tests-assess_helpers.R diff --git a/R/tests-assess_helpers.R b/R/tests-assess_helpers.R new file mode 100644 index 000000000..41312e465 --- /dev/null +++ b/R/tests-assess_helpers.R @@ -0,0 +1,9 @@ +test_logical_assess_parameters <- function(assess_function, dfInput) { + expect_message( + assess_function(dfInput, bQuiet = FALSE) + ) + + expect_true( + "lChecks" %in% names(assess_funciton(dfInput, bReturnChecks = TRUE)) + ) +} diff --git a/tests/testthat/test_AE_Assess.R b/tests/testthat/test_AE_Assess.R index 3d1b0ee9e..6c987f7cb 100644 --- a/tests/testthat/test_AE_Assess.R +++ b/tests/testthat/test_AE_Assess.R @@ -1,10 +1,13 @@ source(testthat::test_path("testdata/data.R")) -aeInput <- AE_Map_Raw(dfs = list(dfAE = dfAE, dfSUBJ = dfSUBJ)) +assess_function <- gsm::AE_Assess +dfInput <- AE_Map_Raw(dfs = list(dfAE = dfAE, dfSUBJ = dfSUBJ)) +output_spec <- yaml::read_yaml(paste0(here::here(), '/inst/specs/AE_Assess.yaml')) +output_mapping <- yaml::read_yaml(paste0(here::here(), '/inst/mappings/AE_Assess.yaml')) # output is created as expected ------------------------------------------- test_that("output is created as expected", { - aeAssessment <- AE_Assess(aeInput, vThreshold = c(-5.1, 5.1)) + aeAssessment <- AE_Assess(dfInput, vThreshold = c(-5.1, 5.1)) expect_true(is.list(aeAssessment)) expect_equal(names(aeAssessment), c("strFunctionName", "lParams", "lTags", "dfInput", "dfTransformed", "dfAnalyzed", "dfFlagged", "dfSummary", "chart")) expect_true("data.frame" %in% class(aeAssessment$dfInput)) @@ -19,9 +22,9 @@ test_that("output is created as expected", { # metadata is returned as expected ---------------------------------------- test_that("metadata is returned as expected", { - aeAssessment <- AE_Assess(aeInput, vThreshold = c(-5.1, 5.1)) + aeAssessment <- AE_Assess(dfInput, vThreshold = c(-5.1, 5.1)) expect_equal("AE_Assess()", aeAssessment$strFunctionName) - expect_equal("aeInput", aeAssessment$lParams$dfInput) + expect_equal("dfInput", aeAssessment$lParams$dfInput) expect_equal("-5.1", aeAssessment$lParams$vThreshold[2]) expect_equal("5.1", aeAssessment$lParams$vThreshold[3]) expect_equal("AE", aeAssessment$lTags$Assessment) @@ -32,25 +35,27 @@ test_that("metadata is returned as expected", { test_that("incorrect inputs throw errors", { expect_snapshot_error(AE_Assess(list())) expect_snapshot_error(AE_Assess("Hi")) - expect_snapshot_error(AE_Assess(aeInput, strMethod = 123)) - expect_snapshot_error(AE_Assess(aeInput, strMethod = "abacus")) - expect_snapshot_error(AE_Assess(aeInput, strMethod = c("wilcoxon", "poisson"))) - expect_snapshot_error(AE_Assess(aeInput %>% select(-SubjectID))) - expect_snapshot_error(AE_Assess(aeInput %>% select(-SiteID))) - expect_snapshot_error(AE_Assess(aeInput %>% select(-Count))) - expect_snapshot_error(AE_Assess(aeInput %>% select(-Exposure))) - expect_snapshot_error(AE_Assess(aeInput %>% select(-Rate))) - expect_error(AE_Assess(aeInput, strKRILabel = c("label 1", "label 2"))) + expect_snapshot_error(AE_Assess(dfInput, strMethod = 123)) + expect_snapshot_error(AE_Assess(dfInput, strMethod = "abacus")) + expect_snapshot_error(AE_Assess(dfInput, strMethod = c("wilcoxon", "poisson"))) + expect_snapshot_error(AE_Assess(dfInput, vThreshold = "A")) + expect_snapshot_error(AE_Assess(dfInput, vThreshold = 1)) + expect_snapshot_error(AE_Assess(dfInput %>% select(-SubjectID))) + expect_snapshot_error(AE_Assess(dfInput %>% select(-SiteID))) + expect_snapshot_error(AE_Assess(dfInput %>% select(-Count))) + expect_snapshot_error(AE_Assess(dfInput %>% select(-Exposure))) + expect_snapshot_error(AE_Assess(dfInput %>% select(-Rate))) + expect_error(AE_Assess(dfInput, strKRILabel = c("label 1", "label 2"))) }) # incorrect lTags throw errors -------------------------------------------- test_that("incorrect lTags throw errors", { - expect_snapshot_error(AE_Assess(aeInput, vThreshold = c(-5.1, 5.1), lTags = "hi mom")) - expect_snapshot_error(AE_Assess(aeInput, vThreshold = c(-5.1, 5.1), lTags = list("hi", "mom"))) - expect_snapshot_error(AE_Assess(aeInput, vThreshold = c(-5.1, 5.1), lTags = list(greeting = "hi", "mom"))) + expect_snapshot_error(AE_Assess(dfInput, vThreshold = c(-5.1, 5.1), lTags = "hi mom")) + expect_snapshot_error(AE_Assess(dfInput, vThreshold = c(-5.1, 5.1), lTags = list("hi", "mom"))) + expect_snapshot_error(AE_Assess(dfInput, vThreshold = c(-5.1, 5.1), lTags = list(greeting = "hi", "mom"))) expect_silent( AE_Assess( - aeInput, + dfInput, vThreshold = c(-5.1, 5.1), lTags = list( greeting = "hi", @@ -58,17 +63,27 @@ test_that("incorrect lTags throw errors", { ) ) ) - expect_snapshot_error(AE_Assess(aeInput, lTags = list(SiteID = ""))) - expect_snapshot_error(AE_Assess(aeInput, lTags = list(N = ""))) - expect_snapshot_error(AE_Assess(aeInput, lTags = list(Score = ""))) - expect_snapshot_error(AE_Assess(aeInput, lTags = list(Flag = ""))) + expect_snapshot_error(AE_Assess(dfInput, lTags = list(SiteID = ""))) + expect_snapshot_error(AE_Assess(dfInput, lTags = list(N = ""))) + expect_snapshot_error(AE_Assess(dfInput, lTags = list(Score = ""))) + expect_snapshot_error(AE_Assess(dfInput, lTags = list(Flag = ""))) }) # custom tests ------------------------------------------------------------ +test_that("strMethod = 'wilcoxon' does not throw error", { + expect_error(AE_Assess(dfInput, strMethod = "wilcoxon"), NA) +}) + +test_that("NA in dfInput$Count results in Error for AE_Assess", { + aeInputNA <- dfInput + aeInputNA[1, "Count"] <- NA + expect_snapshot(AE_Assess(aeInputNA)) +}) + test_that("dfAnalyzed has appropriate model output regardless of statistical method", { - assessmentPoisson <- AE_Assess(aeInput, strMethod = "poisson") + assessmentPoisson <- AE_Assess(dfInput, strMethod = "poisson") expect_true(all(c("KRI", "KRILabel", "Score", "ScoreLabel") %in% names(assessmentPoisson$dfAnalyzed))) - assessmentWilcoxon <- AE_Assess(aeInput, strMethod = "wilcoxon") + assessmentWilcoxon <- AE_Assess(dfInput, strMethod = "wilcoxon") expect_true(all(c("KRI", "KRILabel", "Score", "ScoreLabel") %in% names(assessmentWilcoxon$dfAnalyzed))) expect_equal(unique(assessmentPoisson$dfAnalyzed$ScoreLabel), "Residuals") @@ -78,21 +93,11 @@ test_that("dfAnalyzed has appropriate model output regardless of statistical met expect_equal(sort(assessmentWilcoxon$dfAnalyzed$Score), sort(assessmentWilcoxon$dfSummary$Score)) }) -test_that("bQuiet works as intended", { - expect_message( - AE_Assess(aeInput, bQuiet = FALSE) - ) -}) - -test_that("bReturnChecks works as intended", { - expect_true( - "lChecks" %in% names(AE_Assess(aeInput, bReturnChecks = TRUE)) - ) +test_that("bQuiet and bReturnChecks work as intended", { + test_logical_assess_parameters(assess_function, dfInput) }) test_that("strKRILabel works as intended", { - ae <- AE_Assess(aeInput, strKRILabel = "my test label") + ae <- AE_Assess(dfInput, strKRILabel = "my test label") expect_equal(unique(ae$dfSummary$KRILabel), "my test label") }) - - diff --git a/tests/testthat/test_Analyze_Wilcoxon.R b/tests/testthat/test_Analyze_Wilcoxon.R index 4aa75249c..224a76ccd 100644 --- a/tests/testthat/test_Analyze_Wilcoxon.R +++ b/tests/testthat/test_Analyze_Wilcoxon.R @@ -14,12 +14,12 @@ test_that("output created as expected and has correct structure", { test_that("incorrect inputs throw errors", { expect_error(Analyze_Wilcoxon(list())) expect_error(Analyze_Wilcoxon("Hi")) - expect_error(Analyze_Wilcoxon(ae_prep, strOutcome = 1)) + expect_error(Analyze_Wilcoxon(ae_prep, strOutcomeCol = 1)) expect_error( Analyze_Wilcoxon(ae_prep %>% mutate(SiteID = ifelse(SiteID == first(SiteID), NA, SiteID))) ) - expect_error(Analyze_Wilcoxon(ae_prep, strOutcome = "coffee")) - expect_error(Analyze_Wilcoxon(ae_prep, strOutcome = c("Rate", "something else"))) + expect_error(Analyze_Wilcoxon(ae_prep, strOutcomeCol = "coffee")) + expect_error(Analyze_Wilcoxon(ae_prep, strOutcomeCol = c("Rate", "something else"))) }) test_that("error given if required column not found", { diff --git a/tests/testthat/test_PD_Assess.R b/tests/testthat/test_PD_Assess.R index ca4a6e55b..5d8d2cddf 100644 --- a/tests/testthat/test_PD_Assess.R +++ b/tests/testthat/test_PD_Assess.R @@ -1,10 +1,13 @@ source(testthat::test_path("testdata/data.R")) -pdInput <- PD_Map_Raw(dfs = list(dfPD = dfPD, dfSUBJ = dfSUBJ)) +assess_function <- gsm::PD_Assess +dfInput <- PD_Map_Raw(dfs = list(dfPD = dfPD, dfSUBJ = dfSUBJ)) +output_spec <- yaml::read_yaml(paste0(here::here(), '/inst/specs/PD_Assess.yaml')) +output_mapping <- yaml::read_yaml(paste0(here::here(), '/inst/mappings/PD_Assess.yaml')) # output is created as expected ------------------------------------------- test_that("output is created as expected", { - pdAssessment <- PD_Assess(pdInput) + pdAssessment <- PD_Assess(dfInput) expect_true(is.list(pdAssessment)) expect_equal(names(pdAssessment), c("strFunctionName", "lParams", "lTags", "dfInput", "dfTransformed", "dfAnalyzed", "dfFlagged", "dfSummary", "chart")) expect_true("data.frame" %in% class(pdAssessment$dfInput)) @@ -19,10 +22,11 @@ test_that("output is created as expected", { # metadata is returned as expected ---------------------------------------- test_that("metadata is returned as expected", { - pdAssessment <- PD_Assess(pdInput, vThreshold = c(-5, 5), strMethod = "poisson") + pdAssessment <- PD_Assess(dfInput, vThreshold = c(-5.1, 5.1), strMethod = "poisson") expect_equal("PD_Assess()", pdAssessment$strFunctionName) - expect_equal("-5", pdAssessment$lParams$vThreshold[2]) - expect_equal("5", pdAssessment$lParams$vThreshold[3]) + expect_equal("dfInput", pdAssessment$lParams$dfInput) + expect_equal("-5.1", pdAssessment$lParams$vThreshold[2]) + expect_equal("5.1", pdAssessment$lParams$vThreshold[3]) expect_equal("PD", pdAssessment$lTags$Assessment) expect_true("ggplot" %in% class(pdAssessment$chart)) }) @@ -31,27 +35,27 @@ test_that("metadata is returned as expected", { test_that("incorrect inputs throw errors", { expect_snapshot_error(PD_Assess(list())) expect_snapshot_error(PD_Assess("Hi")) - expect_snapshot_error(PD_Assess(pdInput, strLabel = 123)) - expect_snapshot_error(PD_Assess(pdInput, strMethod = "abacus")) - expect_snapshot_error(PD_Assess(pdInput, strMethod = c("wilcoxon", "poisson"))) - expect_snapshot_error(PD_Assess(pdInput, vThreshold = "A")) - expect_snapshot_error(PD_Assess(pdInput, vThreshold = 1)) - expect_snapshot_error(PD_Assess(pdInput %>% select(-SubjectID))) - expect_snapshot_error(PD_Assess(pdInput %>% select(-SiteID))) - expect_snapshot_error(PD_Assess(pdInput %>% select(-Count))) - expect_snapshot_error(PD_Assess(pdInput %>% select(-Exposure))) - expect_snapshot_error(PD_Assess(pdInput %>% select(-Rate))) - expect_error(PD_Assess(pdInput, strKRILabel = c("label 1", "label 2"))) + expect_snapshot_error(PD_Assess(dfInput, strLabel = 123)) + expect_snapshot_error(PD_Assess(dfInput, strMethod = "abacus")) + expect_snapshot_error(PD_Assess(dfInput, strMethod = c("wilcoxon", "poisson"))) + expect_snapshot_error(PD_Assess(dfInput, vThreshold = "A")) + expect_snapshot_error(PD_Assess(dfInput, vThreshold = 1)) + expect_snapshot_error(PD_Assess(dfInput %>% select(-SubjectID))) + expect_snapshot_error(PD_Assess(dfInput %>% select(-SiteID))) + expect_snapshot_error(PD_Assess(dfInput %>% select(-Count))) + expect_snapshot_error(PD_Assess(dfInput %>% select(-Exposure))) + expect_snapshot_error(PD_Assess(dfInput %>% select(-Rate))) + expect_error(PD_Assess(dfInput, strKRILabel = c("label 1", "label 2"))) }) # incorrect lTags throw errors -------------------------------------------- test_that("incorrect lTags throw errors", { - expect_error(PD_Assess(pdInput, vThreshold = c(-5.1, 5.1), lTags = "hi mom")) - expect_error(PD_Assess(pdInput, vThreshold = c(-5.1, 5.1), lTags = list("hi", "mom"))) - expect_error(PD_Assess(pdInput, vThreshold = c(-5.1, 5.1), lTags = list(greeting = "hi", "mom"))) + expect_error(PD_Assess(dfInput, vThreshold = c(-5.1, 5.1), lTags = "hi mom")) + expect_error(PD_Assess(dfInput, vThreshold = c(-5.1, 5.1), lTags = list("hi", "mom"))) + expect_error(PD_Assess(dfInput, vThreshold = c(-5.1, 5.1), lTags = list(greeting = "hi", "mom"))) expect_silent( PD_Assess( - pdInput, + dfInput, vThreshold = c(-5.1, 5.1), lTags = list( greeting = "hi", @@ -59,27 +63,27 @@ test_that("incorrect lTags throw errors", { ) ) ) - expect_error(PD_Assess(pdInput, lTags = list(SiteID = ""))) - expect_error(PD_Assess(pdInput, lTags = list(N = ""))) - expect_error(PD_Assess(pdInput, lTags = list(Score = ""))) - expect_error(PD_Assess(pdInput, lTags = list(Flag = ""))) + expect_error(PD_Assess(dfInput, lTags = list(SiteID = ""))) + expect_error(PD_Assess(dfInput, lTags = list(N = ""))) + expect_error(PD_Assess(dfInput, lTags = list(Score = ""))) + expect_error(PD_Assess(dfInput, lTags = list(Flag = ""))) }) # custom tests ------------------------------------------------------------ test_that("strMethod = 'wilcoxon' does not throw error", { - expect_error(PD_Assess(pdInput, strMethod = "wilcoxon"), NA) + expect_error(PD_Assess(dfInput, strMethod = "wilcoxon"), NA) }) test_that("NA in dfInput$Count results in Error for PD_Assess", { - pdInputNA <- pdInput + pdInputNA <- dfInput pdInputNA[1, "Count"] <- NA expect_snapshot(PD_Assess(pdInputNA)) }) test_that("dfAnalyzed has appropriate model output regardless of statistical method", { - assessmentPoisson <- PD_Assess(pdInput, strMethod = "poisson") + assessmentPoisson <- PD_Assess(dfInput, strMethod = "poisson") expect_true(all(c("KRI", "KRILabel", "Score", "ScoreLabel") %in% names(assessmentPoisson$dfAnalyzed))) - assessmentWilcoxon <- PD_Assess(pdInput, strMethod = "wilcoxon") + assessmentWilcoxon <- PD_Assess(dfInput, strMethod = "wilcoxon") expect_true(all(c("KRI", "KRILabel", "Score", "ScoreLabel") %in% names(assessmentWilcoxon$dfAnalyzed))) expect_equal(unique(assessmentPoisson$dfAnalyzed$ScoreLabel), "Residuals") @@ -89,19 +93,11 @@ test_that("dfAnalyzed has appropriate model output regardless of statistical met expect_equal(sort(assessmentWilcoxon$dfAnalyzed$Score), sort(assessmentWilcoxon$dfSummary$Score)) }) -test_that("bQuiet works as intended", { - expect_message( - PD_Assess(pdInput, bQuiet = FALSE) - ) -}) - -test_that("bReturnChecks works as intended", { - expect_true( - "lChecks" %in% names(PD_Assess(pdInput, bReturnChecks = TRUE)) - ) +test_that("bQuiet and bReturnChecks work as intended", { + test_logical_assess_parameters(assess_function, dfInput) }) test_that("strKRILabel works as intended", { - pd <- PD_Assess(pdInput, strKRILabel = "my test label") + pd <- PD_Assess(dfInput, strKRILabel = "my test label") expect_equal(unique(pd$dfSummary$KRILabel), "my test label") }) From f6fd483ee0f3e71c8fb09c8e2b31ca24db020eeb Mon Sep 17 00:00:00 2001 From: Spencer Childress Date: Wed, 15 Jun 2022 12:01:07 -0400 Subject: [PATCH 76/87] knock out some more unit tests --- R/Transform_EventCount.R | 7 ++++- R/tests-assess_helpers.R | 2 +- tests/testthat/_snaps/AE_Assess.md | 33 ++++++++++++++++++++ tests/testthat/test_Analyze_Poisson.R | 7 +++++ tests/testthat/test_Analyze_Wilcoxon.R | 12 ++++++- tests/testthat/test_Study_AssessmentReport.R | 9 +++++- tests/testthat/test_Study_Table.R | 16 +++++----- tests/testthat/test_Transform_EventCount.R | 18 +++++++++++ 8 files changed, 92 insertions(+), 12 deletions(-) diff --git a/R/Transform_EventCount.R b/R/Transform_EventCount.R index bb6a9f257..1f19117af 100644 --- a/R/Transform_EventCount.R +++ b/R/Transform_EventCount.R @@ -40,7 +40,12 @@ #' #' @export -Transform_EventCount <- function(dfInput, strCountCol, strExposureCol = NULL, strKRILabel = "[Not Specified]") { +Transform_EventCount <- function( + dfInput, + strCountCol, + strExposureCol = NULL, + strKRILabel = "[Not Specified]" +) { stopifnot( "dfInput is not a data frame" = is.data.frame(dfInput), "strCountCol not found in input data" = strCountCol %in% names(dfInput), diff --git a/R/tests-assess_helpers.R b/R/tests-assess_helpers.R index 41312e465..117a66dec 100644 --- a/R/tests-assess_helpers.R +++ b/R/tests-assess_helpers.R @@ -4,6 +4,6 @@ test_logical_assess_parameters <- function(assess_function, dfInput) { ) expect_true( - "lChecks" %in% names(assess_funciton(dfInput, bReturnChecks = TRUE)) + "lChecks" %in% names(assess_function(dfInput, bReturnChecks = TRUE)) ) } diff --git a/tests/testthat/_snaps/AE_Assess.md b/tests/testthat/_snaps/AE_Assess.md index 67e87b8c1..a1b2293e5 100644 --- a/tests/testthat/_snaps/AE_Assess.md +++ b/tests/testthat/_snaps/AE_Assess.md @@ -18,6 +18,14 @@ strMethod must be length 1 +--- + + vThreshold is not numeric + +--- + + vThreshold is not length 2 + --- One or more of these columns: SubjectID, SiteID, Count, Exposure, and Rate not found in dfInput @@ -66,3 +74,28 @@ lTags cannot contain elements named: 'SiteID', 'N', 'Score', or 'Flag' +# NA in dfInput$Count results in Error for AE_Assess + + Code + AE_Assess(aeInputNA) + Output + $strFunctionName + [1] "AE_Assess()" + + $lParams + $lParams$dfInput + [1] "aeInputNA" + + + $lTags + $lTags$Assessment + [1] "AE" + + + $dfInput + SubjectID SiteID Count Exposure Rate + 1 1234 X010X NA 3455 0.0005788712 + 2 5678 X102X 2 1745 0.0011461318 + 3 9876 X999X 0 1233 0.0000000000 + + diff --git a/tests/testthat/test_Analyze_Poisson.R b/tests/testthat/test_Analyze_Poisson.R index 73c833f30..69397384e 100644 --- a/tests/testthat/test_Analyze_Poisson.R +++ b/tests/testthat/test_Analyze_Poisson.R @@ -44,3 +44,10 @@ test_that("NA values are caught", { # expect_error(createNA("TotalExposure")) # expect_error(createNA("Rate")) }) + +test_that("bQuiet works as intended", { + ae_prep <- Transform_EventCount(ae_input, strCountCol = "Count", strExposureCol = "Exposure") + expect_message( + Analyze_Poisson(ae_prep, bQuiet = FALSE) + ) +}) diff --git a/tests/testthat/test_Analyze_Wilcoxon.R b/tests/testthat/test_Analyze_Wilcoxon.R index 224a76ccd..abb5f9ee7 100644 --- a/tests/testthat/test_Analyze_Wilcoxon.R +++ b/tests/testthat/test_Analyze_Wilcoxon.R @@ -14,12 +14,15 @@ test_that("output created as expected and has correct structure", { test_that("incorrect inputs throw errors", { expect_error(Analyze_Wilcoxon(list())) expect_error(Analyze_Wilcoxon("Hi")) - expect_error(Analyze_Wilcoxon(ae_prep, strOutcomeCol = 1)) expect_error( Analyze_Wilcoxon(ae_prep %>% mutate(SiteID = ifelse(SiteID == first(SiteID), NA, SiteID))) ) + expect_error(Analyze_Wilcoxon(ae_prep, strOutcomeCol = 1)) expect_error(Analyze_Wilcoxon(ae_prep, strOutcomeCol = "coffee")) expect_error(Analyze_Wilcoxon(ae_prep, strOutcomeCol = c("Rate", "something else"))) + expect_error(Analyze_Wilcoxon(ae_prep, strPredictorCol = 1)) + expect_error(Analyze_Wilcoxon(ae_prep, strPredictorCol = "coffee")) + expect_error(Analyze_Wilcoxon(ae_prep, strPredictorCol = c("Rate", "something else"))) }) test_that("error given if required column not found", { @@ -49,3 +52,10 @@ test_that("model isn't run with a single outcome value", { expect_true(all(is.na(aew_anly$Score))) expect_true(all(is.na(aew_anly$Estimate))) }) + +test_that("bQuiet works as intended", { + ae_prep <- Transform_EventCount(ae_input, strCountCol = "Count", strExposureCol = "Exposure") + expect_message( + Analyze_Poisson(ae_prep, bQuiet = FALSE) + ) +}) diff --git a/tests/testthat/test_Study_AssessmentReport.R b/tests/testthat/test_Study_AssessmentReport.R index f1481c3c2..500af586e 100644 --- a/tests/testthat/test_Study_AssessmentReport.R +++ b/tests/testthat/test_Study_AssessmentReport.R @@ -13,9 +13,16 @@ test_that("Assessment Report with all Valid assessments", { a <- Study_AssessmentReport(lAssessments = lAssessments) expect_true(is.data.frame(a$dfAllChecks)) expect_true(is.data.frame(a$dfSummary)) + expect_equal( + names(a$dfAllChecks) %>% sort, + c('assessment', 'check', 'cols_are_unique', 'columns_have_empty_values', 'columns_have_na', 'domain', 'has_expected_columns', 'has_required_params', 'is_data_frame', 'mapping_is_list', 'mappings_are_character', 'notes', 'spec_is_list', 'step') + ) + expect_equal( + names(a$dfSummary) %>% sort, + c('assessment', 'check', 'domain', 'notes', 'step') + ) }) - test_that("Assessment Report with an issue in dfSUBJ", { lData <- list( dfSUBJ = dfSUBJ, diff --git a/tests/testthat/test_Study_Table.R b/tests/testthat/test_Study_Table.R index 57766037a..f718185d0 100644 --- a/tests/testthat/test_Study_Table.R +++ b/tests/testthat/test_Study_Table.R @@ -60,14 +60,14 @@ test_that("bShowCounts works", { )) }) -# Issue #437 -# test_that("bShowSiteScore works", { -# -# tbl <- Study_Table(dfFindings = results, bShowSiteScore = FALSE) -# tblScore <- Study_Table(dfFindings = results, bShowSiteScore = TRUE) -# -# -# }) +test_that("bShowSiteScore works", { + expect_true( + 'Score' %in% Study_Table(dfFindings = results, bShowSiteScore = TRUE)$df_summary$Title + ) + expect_false( + 'Score' %in% Study_Table(dfFindings = results, bShowSiteScore = FALSE)$df_summary$Title + ) +}) test_that("vSiteScoreThreshold works", { tbl <- Study_Table(dfFindings = results, vSiteScoreThreshold = 2) diff --git a/tests/testthat/test_Transform_EventCount.R b/tests/testthat/test_Transform_EventCount.R index 2fe44c9bf..3bab28de0 100644 --- a/tests/testthat/test_Transform_EventCount.R +++ b/tests/testthat/test_Transform_EventCount.R @@ -92,6 +92,24 @@ test_that("NA in Exposure is removed ", { ) }) +test_that("NA in Count throws an error", { + sim4 <- data.frame( + SiteID = c(rep("site1", 11), rep("site2", 7), rep("site3", 12)), + event = c(NA, rep(0, 4), NA, rep(1, 11), NA, rep(2, 11), NA), + ndays = c(rep(5, 7), rep(10, 12), rep(10, 11)) + ) + + expect_error( + eventCount <- Transform_EventCount( + sim4, + strCountCol = "event", + strExposureCol = "ndays", + strKRILabel = "Test Label" + ) + ) +}) + + test_that("NA in Count throws an Error", { ae_input2 <- ae_input ae_input2[1, "Count"] <- NA From 6b4564044da1559ed16b7c0a2a3ce893272dd41c Mon Sep 17 00:00:00 2001 From: Spencer Childress Date: Wed, 15 Jun 2022 12:56:53 -0400 Subject: [PATCH 77/87] snaps? --- R/tests-map_raw_helpers.R | 28 +++++++++++++++++++--------- 1 file changed, 19 insertions(+), 9 deletions(-) diff --git a/R/tests-map_raw_helpers.R b/R/tests-map_raw_helpers.R index 99d33a23e..b0ebec309 100644 --- a/R/tests-map_raw_helpers.R +++ b/R/tests-map_raw_helpers.R @@ -43,13 +43,18 @@ test_invalid_data <- function( } test_missing_column <- function(map_function, dfs, spec, mapping) { - # missing variables + # for each domain in spec for (domain in names(spec)) { column_keys <- spec[[ domain ]]$vRequired + # for each required column in domain for (column_key in column_keys) { - column <- mapping[[ domain ]][[ column_key ]] dfs_edited <- dfs + + # retrieve column name from mapping + column <- mapping[[ domain ]][[ column_key ]] + + # set column to NULL dfs_edited[[ domain ]][[ column ]] <- NULL expect_snapshot( @@ -63,16 +68,21 @@ test_missing_column <- function(map_function, dfs, spec, mapping) { } test_missing_value <- function(map_function, dfs, spec, mapping) { + # for each domain in spec for (domain in names(spec)) { - message(domain) df <- dfs[[ domain ]] column_keys <- spec[[ domain ]]$vRequired + + # for each required column in domain for (column_key in column_keys) { - message(column_key) - column <- mapping[[ domain ]][[ column_key ]] - message(column) dfs_edited <- dfs + + # retrieve column name from mapping + column <- mapping[[ domain ]][[ column_key ]] + + # set a random value to NA dfs_edited[[ domain ]][ sample(1:nrow(df), 1), column ] <- NA + expect_null( map_function( dfs = dfs_edited, @@ -93,7 +103,7 @@ test_duplicate_subject_id <- function(map_function, dfs) { test_invalid_mapping <- function(map_function, dfs, spec, mapping) { # Subset mapping on columns required in spec. mapping_required <- mapping %>% - imap(function(columns, domain_key) { + imap(function(columns, domain_key) { # loop over domains domain_spec <- spec[[ domain_key ]]$vRequired columns[ @@ -103,8 +113,8 @@ test_invalid_mapping <- function(map_function, dfs, spec, mapping) { # Run assertion for each domain-column combination in mapping. mapping_required %>% - iwalk(function(columns, domain_key) { - iwalk(columns, function(column_value, column_key) { + iwalk(function(columns, domain_key) { # loop over domains + iwalk(columns, function(column_value, column_key) { # loop over columns in domain mapping_edited <- mapping_required mapping_edited[[ domain_key ]][[ column_key ]] <- 'asdf' From 5cf2d41ad1035d3ef94c484c3ba48492a67e488f Mon Sep 17 00:00:00 2001 From: Spencer Childress Date: Wed, 15 Jun 2022 13:38:58 -0400 Subject: [PATCH 78/87] testing relative paths --- tests/testthat/test_AE_Map_Raw.R | 10 ++++++---- tests/testthat/test_Consent_Map_Raw.R | 10 ++++++---- tests/testthat/test_IE_Map_Raw.R | 10 ++++++---- tests/testthat/test_PD_Map_Raw.R | 10 ++++++---- 4 files changed, 24 insertions(+), 16 deletions(-) diff --git a/tests/testthat/test_AE_Map_Raw.R b/tests/testthat/test_AE_Map_Raw.R index d3ce4507a..9b8beea37 100644 --- a/tests/testthat/test_AE_Map_Raw.R +++ b/tests/testthat/test_AE_Map_Raw.R @@ -7,11 +7,13 @@ dfs <- list( dfSUBJ = dfSUBJ ) -input_spec <- yaml::read_yaml(paste0(here::here(), '/inst/specs/AE_Map_Raw.yaml')) -input_mapping <- yaml::read_yaml(paste0(here::here(), '/inst/mappings/AE_Map_Raw.yaml')) +inst_path <- './' # paste0(inst_path, '') -output_spec <- yaml::read_yaml(paste0(here::here(), '/inst/specs/AE_Assess.yaml')) -output_mapping <- yaml::read_yaml(paste0(here::here(), '/inst/mappings/AE_Assess.yaml')) +input_spec <- yaml::read_yaml(paste0(inst_path, 'specs/AE_Map_Raw.yaml')) +input_mapping <- yaml::read_yaml(paste0(inst_path, 'mappings/AE_Map_Raw.yaml')) + +output_spec <- yaml::read_yaml(paste0(inst_path, 'specs/AE_Assess.yaml')) +output_mapping <- yaml::read_yaml(paste0(inst_path, 'mappings/AE_Assess.yaml')) test_that("valid output is returned", { test_valid_output( diff --git a/tests/testthat/test_Consent_Map_Raw.R b/tests/testthat/test_Consent_Map_Raw.R index 5fae4073c..18af6a8a0 100644 --- a/tests/testthat/test_Consent_Map_Raw.R +++ b/tests/testthat/test_Consent_Map_Raw.R @@ -7,11 +7,13 @@ dfs <- list( dfSUBJ = dfSUBJ ) -input_spec <- yaml::read_yaml(paste0(here::here(), '/inst/specs/IE_Map_Raw.yaml')) -input_mapping <- yaml::read_yaml(paste0(here::here(), '/inst/mappings/IE_Map_Raw.yaml')) +inst_path <- './' # paste0(inst_path, '') -output_spec <- yaml::read_yaml(paste0(here::here(), '/inst/specs/IE_Assess.yaml')) -output_mapping <- yaml::read_yaml(paste0(here::here(), '/inst/mappings/IE_Assess.yaml')) +input_spec <- yaml::read_yaml(paste0(inst_path, 'specs/IE_Map_Raw.yaml')) +input_mapping <- yaml::read_yaml(paste0(inst_path, 'mappings/IE_Map_Raw.yaml')) + +output_spec <- yaml::read_yaml(paste0(inst_path, 'specs/IE_Assess.yaml')) +output_mapping <- yaml::read_yaml(paste0(inst_path, 'mappings/IE_Assess.yaml')) test_that("valid output is returned", { test_valid_output( diff --git a/tests/testthat/test_IE_Map_Raw.R b/tests/testthat/test_IE_Map_Raw.R index 5fae4073c..18af6a8a0 100644 --- a/tests/testthat/test_IE_Map_Raw.R +++ b/tests/testthat/test_IE_Map_Raw.R @@ -7,11 +7,13 @@ dfs <- list( dfSUBJ = dfSUBJ ) -input_spec <- yaml::read_yaml(paste0(here::here(), '/inst/specs/IE_Map_Raw.yaml')) -input_mapping <- yaml::read_yaml(paste0(here::here(), '/inst/mappings/IE_Map_Raw.yaml')) +inst_path <- './' # paste0(inst_path, '') -output_spec <- yaml::read_yaml(paste0(here::here(), '/inst/specs/IE_Assess.yaml')) -output_mapping <- yaml::read_yaml(paste0(here::here(), '/inst/mappings/IE_Assess.yaml')) +input_spec <- yaml::read_yaml(paste0(inst_path, 'specs/IE_Map_Raw.yaml')) +input_mapping <- yaml::read_yaml(paste0(inst_path, 'mappings/IE_Map_Raw.yaml')) + +output_spec <- yaml::read_yaml(paste0(inst_path, 'specs/IE_Assess.yaml')) +output_mapping <- yaml::read_yaml(paste0(inst_path, 'mappings/IE_Assess.yaml')) test_that("valid output is returned", { test_valid_output( diff --git a/tests/testthat/test_PD_Map_Raw.R b/tests/testthat/test_PD_Map_Raw.R index 0c559923e..4308f6fe1 100644 --- a/tests/testthat/test_PD_Map_Raw.R +++ b/tests/testthat/test_PD_Map_Raw.R @@ -7,11 +7,13 @@ dfs <- list( dfSUBJ = dfSUBJ ) -input_spec <- yaml::read_yaml(paste0(here::here(), '/inst/specs/PD_Map_Raw.yaml')) -input_mapping <- yaml::read_yaml(paste0(here::here(), '/inst/mappings/PD_Map_Raw.yaml')) +inst_path <- './' # paste0(inst_path, '') -output_spec <- yaml::read_yaml(paste0(here::here(), '/inst/specs/PD_Assess.yaml')) -output_mapping <- yaml::read_yaml(paste0(here::here(), '/inst/mappings/PD_Assess.yaml')) +input_spec <- yaml::read_yaml(paste0(inst_path, 'specs/PD_Map_Raw.yaml')) +input_mapping <- yaml::read_yaml(paste0(inst_path, 'mappings/PD_Map_Raw.yaml')) + +output_spec <- yaml::read_yaml(paste0(inst_path, 'specs/PD_Assess.yaml')) +output_mapping <- yaml::read_yaml(paste0(inst_path, 'mappings/PD_Assess.yaml')) test_that("valid output is returned", { test_valid_output( From a3ad0163b4fc2f2c948c57720bf0c186b0d56479 Mon Sep 17 00:00:00 2001 From: Spencer Childress Date: Wed, 15 Jun 2022 16:28:08 -0400 Subject: [PATCH 79/87] remove vNACols from missing value test --- R/tests-map_raw_helpers.R | 11 +- tests/testthat/_snaps/Consent_Map_Raw.md | 210 +++++++++++++++-------- tests/testthat/test_AE_Assess.R | 4 +- tests/testthat/test_AE_Map_Raw.R | 10 +- tests/testthat/test_Consent_Map_Raw.R | 14 +- tests/testthat/test_IE_Map_Raw.R | 10 +- tests/testthat/test_PD_Assess.R | 4 +- tests/testthat/test_PD_Map_Raw.R | 10 +- 8 files changed, 168 insertions(+), 105 deletions(-) diff --git a/R/tests-map_raw_helpers.R b/R/tests-map_raw_helpers.R index b0ebec309..173dc2ac2 100644 --- a/R/tests-map_raw_helpers.R +++ b/R/tests-map_raw_helpers.R @@ -71,7 +71,10 @@ test_missing_value <- function(map_function, dfs, spec, mapping) { # for each domain in spec for (domain in names(spec)) { df <- dfs[[ domain ]] - column_keys <- spec[[ domain ]]$vRequired + column_keys <- setdiff( + spec[[ domain ]]$vRequired, + spec[[ domain ]]$vNACols + ) # for each required column in domain for (column_key in column_keys) { @@ -103,7 +106,7 @@ test_duplicate_subject_id <- function(map_function, dfs) { test_invalid_mapping <- function(map_function, dfs, spec, mapping) { # Subset mapping on columns required in spec. mapping_required <- mapping %>% - imap(function(columns, domain_key) { # loop over domains + purrr::imap(function(columns, domain_key) { # loop over domains domain_spec <- spec[[ domain_key ]]$vRequired columns[ @@ -113,8 +116,8 @@ test_invalid_mapping <- function(map_function, dfs, spec, mapping) { # Run assertion for each domain-column combination in mapping. mapping_required %>% - iwalk(function(columns, domain_key) { # loop over domains - iwalk(columns, function(column_value, column_key) { # loop over columns in domain + purrr::iwalk(function(columns, domain_key) { # loop over domains + purrr::iwalk(columns, function(column_value, column_key) { # loop over columns in domain mapping_edited <- mapping_required mapping_edited[[ domain_key ]][[ column_key ]] <- 'asdf' diff --git a/tests/testthat/_snaps/Consent_Map_Raw.md b/tests/testthat/_snaps/Consent_Map_Raw.md index 3fac631a4..3cc7b0566 100644 --- a/tests/testthat/_snaps/Consent_Map_Raw.md +++ b/tests/testthat/_snaps/Consent_Map_Raw.md @@ -4,20 +4,20 @@ map_function(dfs = purrr::imap(dfs, ~ list()), bQuiet = FALSE) Message - -- Checking Input Data for `IE_Map_Raw()` -- + -- Checking Input Data for `Consent_Map_Raw()` -- x df is not a data.frame() - x the following columns not found in df: SubjectID, IE_CATEGORY, IE_VALUE + x the following columns not found in df: SubjectID, CONSENT_TYPE, CONSENT_VALUE, CONSENT_DATE x NA check not run x Empty Value check not run x Unique Column Check not run x df is not a data.frame() - x the following columns not found in df: SubjectID, SiteID + x the following columns not found in df: SubjectID, SiteID, RandDate x NA check not run x Empty Value check not run x Unique Column Check not run - ! Issues found for `IE_Map_Raw()` - ! `IE_Map_Raw()` did not run because of failed check. + ! Issues found for `Consent_Map_Raw()` + ! `Consent_Map_Raw()` did not run because of failed check. Output NULL @@ -28,15 +28,15 @@ bQuiet = FALSE) Message - -- Checking Input Data for `IE_Map_Raw()` -- + -- Checking Input Data for `Consent_Map_Raw()` -- x df is not a data.frame() - x the following columns not found in df: SubjectID, SiteID + x the following columns not found in df: SubjectID, SiteID, RandDate x NA check not run x Empty Value check not run x Unique Column Check not run - ! Issues found for `IE_Map_Raw()` - ! `IE_Map_Raw()` did not run because of failed check. + ! Issues found for `Consent_Map_Raw()` + ! `Consent_Map_Raw()` did not run because of failed check. Output NULL @@ -47,15 +47,15 @@ bQuiet = FALSE) Message - -- Checking Input Data for `IE_Map_Raw()` -- + -- Checking Input Data for `Consent_Map_Raw()` -- x df is not a data.frame() - x the following columns not found in df: SubjectID, IE_CATEGORY, IE_VALUE + x the following columns not found in df: SubjectID, CONSENT_TYPE, CONSENT_VALUE, CONSENT_DATE x NA check not run x Empty Value check not run x Unique Column Check not run - ! Issues found for `IE_Map_Raw()` - ! `IE_Map_Raw()` did not run because of failed check. + ! Issues found for `Consent_Map_Raw()` + ! `Consent_Map_Raw()` did not run because of failed check. Output NULL @@ -65,20 +65,20 @@ map_function(dfs = purrr::imap(dfs, ~"Hi Mom"), bQuiet = FALSE) Message - -- Checking Input Data for `IE_Map_Raw()` -- + -- Checking Input Data for `Consent_Map_Raw()` -- x df is not a data.frame() - x the following columns not found in df: SubjectID, IE_CATEGORY, IE_VALUE + x the following columns not found in df: SubjectID, CONSENT_TYPE, CONSENT_VALUE, CONSENT_DATE x NA check not run x Empty Value check not run x Unique Column Check not run x df is not a data.frame() - x the following columns not found in df: SubjectID, SiteID + x the following columns not found in df: SubjectID, SiteID, RandDate x NA check not run x Empty Value check not run x Unique Column Check not run - ! Issues found for `IE_Map_Raw()` - ! `IE_Map_Raw()` did not run because of failed check. + ! Issues found for `Consent_Map_Raw()` + ! `Consent_Map_Raw()` did not run because of failed check. Output NULL @@ -88,20 +88,20 @@ map_function(dfs = purrr::imap(dfs, ~9999), bQuiet = FALSE) Message - -- Checking Input Data for `IE_Map_Raw()` -- + -- Checking Input Data for `Consent_Map_Raw()` -- x df is not a data.frame() - x the following columns not found in df: SubjectID, IE_CATEGORY, IE_VALUE + x the following columns not found in df: SubjectID, CONSENT_TYPE, CONSENT_VALUE, CONSENT_DATE x NA check not run x Empty Value check not run x Unique Column Check not run x df is not a data.frame() - x the following columns not found in df: SubjectID, SiteID + x the following columns not found in df: SubjectID, SiteID, RandDate x NA check not run x Empty Value check not run x Unique Column Check not run - ! Issues found for `IE_Map_Raw()` - ! `IE_Map_Raw()` did not run because of failed check. + ! Issues found for `Consent_Map_Raw()` + ! `Consent_Map_Raw()` did not run because of failed check. Output NULL @@ -111,20 +111,20 @@ map_function(dfs = purrr::imap(dfs, ~TRUE), bQuiet = FALSE) Message - -- Checking Input Data for `IE_Map_Raw()` -- + -- Checking Input Data for `Consent_Map_Raw()` -- x df is not a data.frame() - x the following columns not found in df: SubjectID, IE_CATEGORY, IE_VALUE + x the following columns not found in df: SubjectID, CONSENT_TYPE, CONSENT_VALUE, CONSENT_DATE x NA check not run x Empty Value check not run x Unique Column Check not run x df is not a data.frame() - x the following columns not found in df: SubjectID, SiteID + x the following columns not found in df: SubjectID, SiteID, RandDate x NA check not run x Empty Value check not run x Unique Column Check not run - ! Issues found for `IE_Map_Raw()` - ! `IE_Map_Raw()` did not run because of failed check. + ! Issues found for `Consent_Map_Raw()` + ! `Consent_Map_Raw()` did not run because of failed check. Output NULL @@ -134,16 +134,16 @@ map_function(dfs = purrr::imap(dfs, ~.x), lMapping = list(), bQuiet = FALSE) Message - -- Checking Input Data for `IE_Map_Raw()` -- + -- Checking Input Data for `Consent_Map_Raw()` -- - x "mapping" does not contain required parameters: strIDCol, strCategoryCol, strValueCol + x "mapping" does not contain required parameters: strIDCol, strTypeCol, strValueCol, strDateCol x mapping is not a list() x Non-character column names found in mapping: - x "mapping" does not contain required parameters: strIDCol, strSiteCol + x "mapping" does not contain required parameters: strIDCol, strSiteCol, strRandDateCol x mapping is not a list() x Non-character column names found in mapping: - ! Issues found for `IE_Map_Raw()` - ! `IE_Map_Raw()` did not run because of failed check. + ! Issues found for `Consent_Map_Raw()` + ! `Consent_Map_Raw()` did not run because of failed check. Output NULL @@ -153,11 +153,11 @@ map_function(dfs = dfs_edited, bQuiet = FALSE) Message - -- Checking Input Data for `IE_Map_Raw()` -- + -- Checking Input Data for `Consent_Map_Raw()` -- x Unexpected duplicates found in column: SubjectID - ! Issues found for `IE_Map_Raw()` - ! `IE_Map_Raw()` did not run because of failed check. + ! Issues found for `Consent_Map_Raw()` + ! `Consent_Map_Raw()` did not run because of failed check. Output NULL @@ -167,14 +167,14 @@ map_function(dfs = dfs_edited, bQuiet = FALSE) Message - -- Checking Input Data for `IE_Map_Raw()` -- + -- Checking Input Data for `Consent_Map_Raw()` -- x the following columns not found in df: SubjectID x NA check not run x Empty Value check not run x Unique Column Check not run - ! Issues found for `IE_Map_Raw()` - ! `IE_Map_Raw()` did not run because of failed check. + ! Issues found for `Consent_Map_Raw()` + ! `Consent_Map_Raw()` did not run because of failed check. Output NULL @@ -184,14 +184,14 @@ map_function(dfs = dfs_edited, bQuiet = FALSE) Message - -- Checking Input Data for `IE_Map_Raw()` -- + -- Checking Input Data for `Consent_Map_Raw()` -- - x the following columns not found in df: IE_CATEGORY + x the following columns not found in df: CONSENT_TYPE x NA check not run x Empty Value check not run x Unique Column Check not run - ! Issues found for `IE_Map_Raw()` - ! `IE_Map_Raw()` did not run because of failed check. + ! Issues found for `Consent_Map_Raw()` + ! `Consent_Map_Raw()` did not run because of failed check. Output NULL @@ -201,14 +201,14 @@ map_function(dfs = dfs_edited, bQuiet = FALSE) Message - -- Checking Input Data for `IE_Map_Raw()` -- + -- Checking Input Data for `Consent_Map_Raw()` -- - x the following columns not found in df: IE_VALUE + x the following columns not found in df: CONSENT_VALUE x NA check not run x Empty Value check not run x Unique Column Check not run - ! Issues found for `IE_Map_Raw()` - ! `IE_Map_Raw()` did not run because of failed check. + ! Issues found for `Consent_Map_Raw()` + ! `Consent_Map_Raw()` did not run because of failed check. Output NULL @@ -218,14 +218,31 @@ map_function(dfs = dfs_edited, bQuiet = FALSE) Message - -- Checking Input Data for `IE_Map_Raw()` -- + -- Checking Input Data for `Consent_Map_Raw()` -- + + x the following columns not found in df: CONSENT_DATE + x NA check not run + x Empty Value check not run + x Unique Column Check not run + ! Issues found for `Consent_Map_Raw()` + ! `Consent_Map_Raw()` did not run because of failed check. + Output + NULL + +--- + + Code + map_function(dfs = dfs_edited, bQuiet = FALSE) + Message + + -- Checking Input Data for `Consent_Map_Raw()` -- x the following columns not found in df: SubjectID x NA check not run x Empty Value check not run x Unique Column Check not run - ! Issues found for `IE_Map_Raw()` - ! `IE_Map_Raw()` did not run because of failed check. + ! Issues found for `Consent_Map_Raw()` + ! `Consent_Map_Raw()` did not run because of failed check. Output NULL @@ -235,14 +252,31 @@ map_function(dfs = dfs_edited, bQuiet = FALSE) Message - -- Checking Input Data for `IE_Map_Raw()` -- + -- Checking Input Data for `Consent_Map_Raw()` -- x the following columns not found in df: SiteID x NA check not run x Empty Value check not run x Unique Column Check not run - ! Issues found for `IE_Map_Raw()` - ! `IE_Map_Raw()` did not run because of failed check. + ! Issues found for `Consent_Map_Raw()` + ! `Consent_Map_Raw()` did not run because of failed check. + Output + NULL + +--- + + Code + map_function(dfs = dfs_edited, bQuiet = FALSE) + Message + + -- Checking Input Data for `Consent_Map_Raw()` -- + + x the following columns not found in df: RandDate + x NA check not run + x Empty Value check not run + x Unique Column Check not run + ! Issues found for `Consent_Map_Raw()` + ! `Consent_Map_Raw()` did not run because of failed check. Output NULL @@ -252,11 +286,11 @@ map_function(dfs = dfs_edited, bQuiet = FALSE) Message - -- Checking Input Data for `IE_Map_Raw()` -- + -- Checking Input Data for `Consent_Map_Raw()` -- x Unexpected duplicates found in column: SubjectID - ! Issues found for `IE_Map_Raw()` - ! `IE_Map_Raw()` did not run because of failed check. + ! Issues found for `Consent_Map_Raw()` + ! `Consent_Map_Raw()` did not run because of failed check. Output NULL @@ -266,14 +300,48 @@ map_function(dfs = dfs, lMapping = mapping_edited, bQuiet = FALSE) Message - -- Checking Input Data for `IE_Map_Raw()` -- + -- Checking Input Data for `Consent_Map_Raw()` -- + + x the following columns not found in df: asdf + x NA check not run + x Empty Value check not run + x Unique Column Check not run + ! Issues found for `Consent_Map_Raw()` + ! `Consent_Map_Raw()` did not run because of failed check. + Output + NULL + +--- + + Code + map_function(dfs = dfs, lMapping = mapping_edited, bQuiet = FALSE) + Message + + -- Checking Input Data for `Consent_Map_Raw()` -- + + x the following columns not found in df: asdf + x NA check not run + x Empty Value check not run + x Unique Column Check not run + ! Issues found for `Consent_Map_Raw()` + ! `Consent_Map_Raw()` did not run because of failed check. + Output + NULL + +--- + + Code + map_function(dfs = dfs, lMapping = mapping_edited, bQuiet = FALSE) + Message + + -- Checking Input Data for `Consent_Map_Raw()` -- x the following columns not found in df: asdf x NA check not run x Empty Value check not run x Unique Column Check not run - ! Issues found for `IE_Map_Raw()` - ! `IE_Map_Raw()` did not run because of failed check. + ! Issues found for `Consent_Map_Raw()` + ! `Consent_Map_Raw()` did not run because of failed check. Output NULL @@ -283,14 +351,14 @@ map_function(dfs = dfs, lMapping = mapping_edited, bQuiet = FALSE) Message - -- Checking Input Data for `IE_Map_Raw()` -- + -- Checking Input Data for `Consent_Map_Raw()` -- x the following columns not found in df: asdf x NA check not run x Empty Value check not run x Unique Column Check not run - ! Issues found for `IE_Map_Raw()` - ! `IE_Map_Raw()` did not run because of failed check. + ! Issues found for `Consent_Map_Raw()` + ! `Consent_Map_Raw()` did not run because of failed check. Output NULL @@ -300,14 +368,14 @@ map_function(dfs = dfs, lMapping = mapping_edited, bQuiet = FALSE) Message - -- Checking Input Data for `IE_Map_Raw()` -- + -- Checking Input Data for `Consent_Map_Raw()` -- x the following columns not found in df: asdf x NA check not run x Empty Value check not run x Unique Column Check not run - ! Issues found for `IE_Map_Raw()` - ! `IE_Map_Raw()` did not run because of failed check. + ! Issues found for `Consent_Map_Raw()` + ! `Consent_Map_Raw()` did not run because of failed check. Output NULL @@ -317,14 +385,14 @@ map_function(dfs = dfs, lMapping = mapping_edited, bQuiet = FALSE) Message - -- Checking Input Data for `IE_Map_Raw()` -- + -- Checking Input Data for `Consent_Map_Raw()` -- x the following columns not found in df: asdf x NA check not run x Empty Value check not run x Unique Column Check not run - ! Issues found for `IE_Map_Raw()` - ! `IE_Map_Raw()` did not run because of failed check. + ! Issues found for `Consent_Map_Raw()` + ! `Consent_Map_Raw()` did not run because of failed check. Output NULL @@ -334,14 +402,14 @@ map_function(dfs = dfs, lMapping = mapping_edited, bQuiet = FALSE) Message - -- Checking Input Data for `IE_Map_Raw()` -- + -- Checking Input Data for `Consent_Map_Raw()` -- x the following columns not found in df: asdf x NA check not run x Empty Value check not run x Unique Column Check not run - ! Issues found for `IE_Map_Raw()` - ! `IE_Map_Raw()` did not run because of failed check. + ! Issues found for `Consent_Map_Raw()` + ! `Consent_Map_Raw()` did not run because of failed check. Output NULL diff --git a/tests/testthat/test_AE_Assess.R b/tests/testthat/test_AE_Assess.R index 6c987f7cb..4aa745489 100644 --- a/tests/testthat/test_AE_Assess.R +++ b/tests/testthat/test_AE_Assess.R @@ -2,8 +2,8 @@ source(testthat::test_path("testdata/data.R")) assess_function <- gsm::AE_Assess dfInput <- AE_Map_Raw(dfs = list(dfAE = dfAE, dfSUBJ = dfSUBJ)) -output_spec <- yaml::read_yaml(paste0(here::here(), '/inst/specs/AE_Assess.yaml')) -output_mapping <- yaml::read_yaml(paste0(here::here(), '/inst/mappings/AE_Assess.yaml')) +output_spec <- yaml::read_yaml(system.file('specs', 'AE_Assess.yaml', package = 'gsm')) +output_mapping <- yaml::read_yaml(system.file('mappings', 'AE_Assess.yaml', package = 'gsm')) # output is created as expected ------------------------------------------- test_that("output is created as expected", { diff --git a/tests/testthat/test_AE_Map_Raw.R b/tests/testthat/test_AE_Map_Raw.R index 9b8beea37..ed5dfc93f 100644 --- a/tests/testthat/test_AE_Map_Raw.R +++ b/tests/testthat/test_AE_Map_Raw.R @@ -7,13 +7,11 @@ dfs <- list( dfSUBJ = dfSUBJ ) -inst_path <- './' # paste0(inst_path, '') +input_spec <- yaml::read_yaml(system.file('specs', 'AE_Map_Raw.yaml', package = 'gsm')) +input_mapping <- yaml::read_yaml(system.file('mappings', 'AE_Map_Raw.yaml', package = 'gsm')) -input_spec <- yaml::read_yaml(paste0(inst_path, 'specs/AE_Map_Raw.yaml')) -input_mapping <- yaml::read_yaml(paste0(inst_path, 'mappings/AE_Map_Raw.yaml')) - -output_spec <- yaml::read_yaml(paste0(inst_path, 'specs/AE_Assess.yaml')) -output_mapping <- yaml::read_yaml(paste0(inst_path, 'mappings/AE_Assess.yaml')) +output_spec <- yaml::read_yaml(system.file('specs', 'AE_Assess.yaml', package = 'gsm')) +output_mapping <- yaml::read_yaml(system.file('mappings', 'AE_Assess.yaml', package = 'gsm')) test_that("valid output is returned", { test_valid_output( diff --git a/tests/testthat/test_Consent_Map_Raw.R b/tests/testthat/test_Consent_Map_Raw.R index 18af6a8a0..2399433b2 100644 --- a/tests/testthat/test_Consent_Map_Raw.R +++ b/tests/testthat/test_Consent_Map_Raw.R @@ -1,19 +1,17 @@ source(testthat::test_path("testdata/data.R")) -map_function <- gsm::IE_Map_Raw +map_function <- gsm::Consent_Map_Raw dfs <- list( - dfIE = dfIE, + dfCONSENT = dfCONSENT, dfSUBJ = dfSUBJ ) -inst_path <- './' # paste0(inst_path, '') +input_spec <- yaml::read_yaml(system.file('specs', 'Consent_Map_Raw.yaml', package = 'gsm')) +input_mapping <- yaml::read_yaml(system.file('mappings', 'Consent_Map_Raw.yaml', package = 'gsm')) -input_spec <- yaml::read_yaml(paste0(inst_path, 'specs/IE_Map_Raw.yaml')) -input_mapping <- yaml::read_yaml(paste0(inst_path, 'mappings/IE_Map_Raw.yaml')) - -output_spec <- yaml::read_yaml(paste0(inst_path, 'specs/IE_Assess.yaml')) -output_mapping <- yaml::read_yaml(paste0(inst_path, 'mappings/IE_Assess.yaml')) +output_spec <- yaml::read_yaml(system.file('specs', 'Consent_Assess.yaml', package = 'gsm')) +output_mapping <- yaml::read_yaml(system.file('mappings', 'Consent_Assess.yaml', package = 'gsm')) test_that("valid output is returned", { test_valid_output( diff --git a/tests/testthat/test_IE_Map_Raw.R b/tests/testthat/test_IE_Map_Raw.R index 18af6a8a0..34a200f55 100644 --- a/tests/testthat/test_IE_Map_Raw.R +++ b/tests/testthat/test_IE_Map_Raw.R @@ -7,13 +7,11 @@ dfs <- list( dfSUBJ = dfSUBJ ) -inst_path <- './' # paste0(inst_path, '') +input_spec <- yaml::read_yaml(system.file('specs', 'IE_Map_Raw.yaml', package = 'gsm')) +input_mapping <- yaml::read_yaml(system.file('mappings', 'IE_Map_Raw.yaml', package = 'gsm')) -input_spec <- yaml::read_yaml(paste0(inst_path, 'specs/IE_Map_Raw.yaml')) -input_mapping <- yaml::read_yaml(paste0(inst_path, 'mappings/IE_Map_Raw.yaml')) - -output_spec <- yaml::read_yaml(paste0(inst_path, 'specs/IE_Assess.yaml')) -output_mapping <- yaml::read_yaml(paste0(inst_path, 'mappings/IE_Assess.yaml')) +output_spec <- yaml::read_yaml(system.file('specs', 'IE_Assess.yaml', package = 'gsm')) +output_mapping <- yaml::read_yaml(system.file('mappings', 'IE_Assess.yaml', package = 'gsm')) test_that("valid output is returned", { test_valid_output( diff --git a/tests/testthat/test_PD_Assess.R b/tests/testthat/test_PD_Assess.R index 5d8d2cddf..78a8a9949 100644 --- a/tests/testthat/test_PD_Assess.R +++ b/tests/testthat/test_PD_Assess.R @@ -2,8 +2,8 @@ source(testthat::test_path("testdata/data.R")) assess_function <- gsm::PD_Assess dfInput <- PD_Map_Raw(dfs = list(dfPD = dfPD, dfSUBJ = dfSUBJ)) -output_spec <- yaml::read_yaml(paste0(here::here(), '/inst/specs/PD_Assess.yaml')) -output_mapping <- yaml::read_yaml(paste0(here::here(), '/inst/mappings/PD_Assess.yaml')) +output_spec <- yaml::read_yaml(system.file('specs', 'PD_Assess.yaml', package = 'gsm')) +output_mapping <- yaml::read_yaml(system.file('mappings', 'PD_Assess.yaml', package = 'gsm')) # output is created as expected ------------------------------------------- test_that("output is created as expected", { diff --git a/tests/testthat/test_PD_Map_Raw.R b/tests/testthat/test_PD_Map_Raw.R index 4308f6fe1..dda2696f5 100644 --- a/tests/testthat/test_PD_Map_Raw.R +++ b/tests/testthat/test_PD_Map_Raw.R @@ -7,13 +7,11 @@ dfs <- list( dfSUBJ = dfSUBJ ) -inst_path <- './' # paste0(inst_path, '') +input_spec <- yaml::read_yaml(system.file('specs', 'PD_Map_Raw.yaml', package = 'gsm')) +input_mapping <- yaml::read_yaml(system.file('mappings', 'PD_Map_Raw.yaml', package = 'gsm')) -input_spec <- yaml::read_yaml(paste0(inst_path, 'specs/PD_Map_Raw.yaml')) -input_mapping <- yaml::read_yaml(paste0(inst_path, 'mappings/PD_Map_Raw.yaml')) - -output_spec <- yaml::read_yaml(paste0(inst_path, 'specs/PD_Assess.yaml')) -output_mapping <- yaml::read_yaml(paste0(inst_path, 'mappings/PD_Assess.yaml')) +output_spec <- yaml::read_yaml(system.file('specs', 'PD_Assess.yaml', package = 'gsm')) +output_mapping <- yaml::read_yaml(system.file('mappings', 'PD_Assess.yaml', package = 'gsm')) test_that("valid output is returned", { test_valid_output( From a208335a8f4c0e42bcb198ae11975e5e2d95693e Mon Sep 17 00:00:00 2001 From: Spencer Childress Date: Wed, 15 Jun 2022 16:41:35 -0400 Subject: [PATCH 80/87] across(all_of(check_na), ... --- R/util-is_mapping_valid.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/util-is_mapping_valid.R b/R/util-is_mapping_valid.R index 69b7eae84..8c1094653 100644 --- a/R/util-is_mapping_valid.R +++ b/R/util-is_mapping_valid.R @@ -124,7 +124,7 @@ is_mapping_valid <- function(df, mapping, spec, bQuiet = TRUE) { check_na <- colNames[!colNames %in% no_check_na] if (any(is.na(df[check_na]))) { warning <- df %>% - summarize(across(check_na, ~ sum(is.na(.)))) %>% + summarize(across(all_of(check_na), ~ sum(is.na(.)))) %>% tidyr::pivot_longer(everything()) %>% filter(.data$value > 0) %>% mutate(warning = paste0(.data$value, " NA values found in column: ", .data$name)) From 74aa9859b0319044026da12d24f83f3103171847 Mon Sep 17 00:00:00 2001 From: Spencer Childress Date: Thu, 16 Jun 2022 11:55:27 -0400 Subject: [PATCH 81/87] Update R/tests-map_raw_helpers.R Co-authored-by: Matt Roumaya <40671730+mattroumaya@users.noreply.github.com> --- R/tests-map_raw_helpers.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/tests-map_raw_helpers.R b/R/tests-map_raw_helpers.R index 173dc2ac2..47ae66aaf 100644 --- a/R/tests-map_raw_helpers.R +++ b/R/tests-map_raw_helpers.R @@ -98,7 +98,7 @@ test_missing_value <- function(map_function, dfs, spec, mapping) { test_duplicate_subject_id <- function(map_function, dfs) { dfs_edited <- dfs - dfs_edited$dfSUBJ$SubjectID <- 1 + dfs_edited$dfSUBJ$SubjectID <- "1" expect_snapshot(map_function(dfs = dfs_edited, bQuiet = FALSE)) } From 718e40bb0b7df2317ee35ce432e68965b7d047c4 Mon Sep 17 00:00:00 2001 From: Spencer Childress Date: Thu, 16 Jun 2022 11:56:00 -0400 Subject: [PATCH 82/87] Update R/tests-map_raw_helpers.R Co-authored-by: Matt Roumaya <40671730+mattroumaya@users.noreply.github.com> --- R/tests-map_raw_helpers.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/tests-map_raw_helpers.R b/R/tests-map_raw_helpers.R index 47ae66aaf..614bf5ebb 100644 --- a/R/tests-map_raw_helpers.R +++ b/R/tests-map_raw_helpers.R @@ -133,7 +133,7 @@ test_invalid_mapping <- function(map_function, dfs, spec, mapping) { } test_logical_parameters <- function(map_function, dfs) { - expect_message( + expect_snapshot_message( map_function(dfs = dfs, bQuiet = FALSE) ) From e4ab6ffaad03ce65bbb9921809fddf78d0d718ba Mon Sep 17 00:00:00 2001 From: Spencer Childress Date: Thu, 16 Jun 2022 13:58:53 -0400 Subject: [PATCH 83/87] fix #548 --- R/Disp_Map.R | 2 +- R/tests-assess_helpers.R | 4 +- R/tests-map_raw_helpers.R | 6 +- tests/testthat/_snaps/AE_Assess.md | 28 +- tests/testthat/_snaps/AE_Map_Adam.md | 14 + tests/testthat/_snaps/AE_Map_Raw.md | 336 +++++++++++++++++ tests/testthat/_snaps/Analyze_Poisson.md | 7 + tests/testthat/_snaps/Analyze_Wilcoxon.md | 7 + tests/testthat/_snaps/Consent_Assess.md | 21 ++ tests/testthat/_snaps/Consent_Map_Raw.md | 357 ++++++++++++++++++ tests/testthat/_snaps/IE_Assess.md | 21 ++ tests/testthat/_snaps/IE_Map_Raw.md | 340 +++++++++++++++++ tests/testthat/_snaps/PD_Assess.md | 28 +- tests/testthat/_snaps/PD_Map_Raw.md | 323 ++++++++++++++++ .../testthat/_snaps/util_is_mapping_valid.md | 95 +++++ tests/testthat/test_AE_Assess.R | 96 ++--- tests/testthat/test_AE_Map_Adam.R | 6 +- tests/testthat/test_AE_Map_Raw.R | 8 + tests/testthat/test_Analyze_Chisq.R | 13 +- tests/testthat/test_Analyze_Poisson.R | 6 +- tests/testthat/test_Analyze_Wilcoxon.R | 6 +- tests/testthat/test_Consent_Assess.R | 89 +++-- tests/testthat/test_Consent_Map_Raw.R | 8 + tests/testthat/test_IE_Assess.R | 89 +++-- tests/testthat/test_IE_Map_Raw.R | 8 + tests/testthat/test_PD_Assess.R | 96 ++--- tests/testthat/test_PD_Map_Raw.R | 8 + tests/testthat/test_util_is_mapping_valid.R | 13 +- 28 files changed, 1817 insertions(+), 218 deletions(-) create mode 100644 tests/testthat/_snaps/Analyze_Poisson.md create mode 100644 tests/testthat/_snaps/Analyze_Wilcoxon.md diff --git a/R/Disp_Map.R b/R/Disp_Map.R index e45ff6d5f..38e4546c4 100644 --- a/R/Disp_Map.R +++ b/R/Disp_Map.R @@ -42,7 +42,7 @@ Disp_Map <- function(dfDisp, strCol, strReason = "any", vReasonIgnore = c("", " select( SubjectID = .data$SUBJID, SiteID = .data$SITEID, - strCol + all_of(strCol) ) %>% mutate(Count = case_when( tolower(strReason) == "any" & !(tolower(.data[[strCol]]) %in% tolower(vReasonIgnore)) ~ 1, diff --git a/R/tests-assess_helpers.R b/R/tests-assess_helpers.R index 117a66dec..2048bdece 100644 --- a/R/tests-assess_helpers.R +++ b/R/tests-assess_helpers.R @@ -1,6 +1,6 @@ test_logical_assess_parameters <- function(assess_function, dfInput) { - expect_message( - assess_function(dfInput, bQuiet = FALSE) + expect_snapshot( + assessment <- assess_function(dfInput, bQuiet = FALSE) ) expect_true( diff --git a/R/tests-map_raw_helpers.R b/R/tests-map_raw_helpers.R index 614bf5ebb..dc33f2eed 100644 --- a/R/tests-map_raw_helpers.R +++ b/R/tests-map_raw_helpers.R @@ -86,7 +86,7 @@ test_missing_value <- function(map_function, dfs, spec, mapping) { # set a random value to NA dfs_edited[[ domain ]][ sample(1:nrow(df), 1), column ] <- NA - expect_null( + expect_snapshot( map_function( dfs = dfs_edited, bQuiet = FALSE @@ -133,8 +133,8 @@ test_invalid_mapping <- function(map_function, dfs, spec, mapping) { } test_logical_parameters <- function(map_function, dfs) { - expect_snapshot_message( - map_function(dfs = dfs, bQuiet = FALSE) + expect_snapshot( + dfInput <- map_function(dfs = dfs, bQuiet = FALSE) ) expect_true( diff --git a/tests/testthat/_snaps/AE_Assess.md b/tests/testthat/_snaps/AE_Assess.md index a1b2293e5..1068fbb8d 100644 --- a/tests/testthat/_snaps/AE_Assess.md +++ b/tests/testthat/_snaps/AE_Assess.md @@ -74,17 +74,17 @@ lTags cannot contain elements named: 'SiteID', 'N', 'Score', or 'Flag' -# NA in dfInput$Count results in Error for AE_Assess +# NA in dfInput$Count results in Error for assess_function Code - AE_Assess(aeInputNA) + assess_function(dfInputNA) Output $strFunctionName - [1] "AE_Assess()" + [1] "assess_function()" $lParams $lParams$dfInput - [1] "aeInputNA" + [1] "dfInputNA" $lTags @@ -99,3 +99,23 @@ 3 9876 X999X 0 1233 0.0000000000 +# bQuiet and bReturnChecks work as intended + + Code + assessment <- assess_function(dfInput, bQuiet = FALSE) + Message + + -- Checking Input Data for `AE_Assess()` -- + + v No issues found for `AE_Assess()` + + -- Initializing `AE_Assess()` -- + + Input data has 3 rows. + v `Transform_EventCount()` returned output with 3 rows. + i Fitting log-linked Poisson generalized linear model of [ TotalCount ] ~ [ log( TotalExposure ) ]. + v `Analyze_Poisson()` returned output with 3 rows. + v `Flag()` returned output with 3 rows. + v `Summarize()` returned output with 3 rows. + v `Visualize_Scatter()` created a chart. + diff --git a/tests/testthat/_snaps/AE_Map_Adam.md b/tests/testthat/_snaps/AE_Map_Adam.md index 00831b050..729cbdf89 100644 --- a/tests/testthat/_snaps/AE_Map_Adam.md +++ b/tests/testthat/_snaps/AE_Map_Adam.md @@ -188,3 +188,17 @@ Output NULL +# bQuiet works as intended + + Code + dfInput <- AE_Map_Adam(dfs = list(dfADAE = dfADAE, dfADSL = dfADSL), bQuiet = FALSE) + Message + + -- Checking Input Data for `AE_Map_Adam()` -- + + v No issues found for `AE_Map_Adam()` + + -- Initializing `AE_Map_Adam()` -- + + v `AE_Map_Adam()` returned output with 4 rows. + diff --git a/tests/testthat/_snaps/AE_Map_Raw.md b/tests/testthat/_snaps/AE_Map_Raw.md index acf7a41a3..b87884fe4 100644 --- a/tests/testthat/_snaps/AE_Map_Raw.md +++ b/tests/testthat/_snaps/AE_Map_Raw.md @@ -1,3 +1,265 @@ +# metadata have not changed + + { + "type": "list", + "attributes": { + "names": { + "type": "character", + "attributes": {}, + "value": ["dfAE", "dfSUBJ"] + } + }, + "value": [ + { + "type": "list", + "attributes": { + "names": { + "type": "character", + "attributes": {}, + "value": ["vRequired"] + } + }, + "value": [ + { + "type": "character", + "attributes": {}, + "value": ["strIDCol"] + } + ] + }, + { + "type": "list", + "attributes": { + "names": { + "type": "character", + "attributes": {}, + "value": ["vRequired", "vUniqueCols"] + } + }, + "value": [ + { + "type": "character", + "attributes": {}, + "value": ["strIDCol", "strSiteCol", "strTimeOnTreatmentCol"] + }, + { + "type": "character", + "attributes": {}, + "value": ["strIDCol"] + } + ] + } + ] + } + +--- + + { + "type": "list", + "attributes": { + "names": { + "type": "character", + "attributes": {}, + "value": ["dfSUBJ", "dfAE"] + } + }, + "value": [ + { + "type": "list", + "attributes": { + "names": { + "type": "character", + "attributes": {}, + "value": ["strIDCol", "strSiteCol", "strTimeOnTreatmentCol", "strTimeOnStudyCol", "strRandFlagCol", "strRandDateCol", "strStudyCompletionFlagCol", "strStudyDiscontinuationReasonCol", "strTreatmentCompletionFlagCol", "strTreatmentDiscontinuationReasonCol"] + } + }, + "value": [ + { + "type": "character", + "attributes": {}, + "value": ["SubjectID"] + }, + { + "type": "character", + "attributes": {}, + "value": ["SiteID"] + }, + { + "type": "character", + "attributes": {}, + "value": ["TimeOnTreatment"] + }, + { + "type": "character", + "attributes": {}, + "value": ["TimeOnStudy"] + }, + { + "type": "character", + "attributes": {}, + "value": ["RandFlag"] + }, + { + "type": "character", + "attributes": {}, + "value": ["RandDate"] + }, + { + "type": "character", + "attributes": {}, + "value": ["StudCompletion"] + }, + { + "type": "character", + "attributes": {}, + "value": ["StudDCReason"] + }, + { + "type": "character", + "attributes": {}, + "value": ["TrtCompletion"] + }, + { + "type": "character", + "attributes": {}, + "value": ["TrtDCReason"] + } + ] + }, + { + "type": "list", + "attributes": { + "names": { + "type": "character", + "attributes": {}, + "value": ["strIDCol", "strTreatmentEmergentCol", "strTreatmentEmergentVal", "strGradeCol", "strSeriousCol", "strSeriousVal"] + } + }, + "value": [ + { + "type": "character", + "attributes": {}, + "value": ["SubjectID"] + }, + { + "type": "character", + "attributes": {}, + "value": ["AE_TE_FLAG"] + }, + { + "type": "logical", + "attributes": {}, + "value": [true] + }, + { + "type": "character", + "attributes": {}, + "value": ["AE_GRADE"] + }, + { + "type": "character", + "attributes": {}, + "value": ["AE_SERIOUS"] + }, + { + "type": "character", + "attributes": {}, + "value": ["Yes"] + } + ] + } + ] + } + +--- + + { + "type": "list", + "attributes": { + "names": { + "type": "character", + "attributes": {}, + "value": ["dfInput"] + } + }, + "value": [ + { + "type": "list", + "attributes": { + "names": { + "type": "character", + "attributes": {}, + "value": ["vRequired", "vUniqueCols"] + } + }, + "value": [ + { + "type": "character", + "attributes": {}, + "value": ["strIDCol", "strSiteCol", "strCountCol", "strExposureCol", "strRateCol"] + }, + { + "type": "character", + "attributes": {}, + "value": ["strIDCol"] + } + ] + } + ] + } + +--- + + { + "type": "list", + "attributes": { + "names": { + "type": "character", + "attributes": {}, + "value": ["dfInput"] + } + }, + "value": [ + { + "type": "list", + "attributes": { + "names": { + "type": "character", + "attributes": {}, + "value": ["strIDCol", "strSiteCol", "strCountCol", "strExposureCol", "strRateCol"] + } + }, + "value": [ + { + "type": "character", + "attributes": {}, + "value": ["SubjectID"] + }, + { + "type": "character", + "attributes": {}, + "value": ["SiteID"] + }, + { + "type": "character", + "attributes": {}, + "value": ["Count"] + }, + { + "type": "character", + "attributes": {}, + "value": ["Exposure"] + }, + { + "type": "character", + "attributes": {}, + "value": ["Rate"] + } + ] + } + ] + } + # invalid data throw errors Code @@ -229,6 +491,62 @@ Output NULL +# missing value throws errors + + Code + map_function(dfs = dfs_edited, bQuiet = FALSE) + Message + + -- Checking Input Data for `AE_Map_Raw()` -- + + x 1 NA values found in column: SubjectID + ! Issues found for `AE_Map_Raw()` + ! `AE_Map_Raw()` did not run because of failed check. + Output + NULL + +--- + + Code + map_function(dfs = dfs_edited, bQuiet = FALSE) + Message + + -- Checking Input Data for `AE_Map_Raw()` -- + + x 1 NA values found in column: SubjectID + ! Issues found for `AE_Map_Raw()` + ! `AE_Map_Raw()` did not run because of failed check. + Output + NULL + +--- + + Code + map_function(dfs = dfs_edited, bQuiet = FALSE) + Message + + -- Checking Input Data for `AE_Map_Raw()` -- + + x 1 NA values found in column: SiteID + ! Issues found for `AE_Map_Raw()` + ! `AE_Map_Raw()` did not run because of failed check. + Output + NULL + +--- + + Code + map_function(dfs = dfs_edited, bQuiet = FALSE) + Message + + -- Checking Input Data for `AE_Map_Raw()` -- + + x 1 NA values found in column: TimeOnTreatment + ! Issues found for `AE_Map_Raw()` + ! `AE_Map_Raw()` did not run because of failed check. + Output + NULL + # duplicate subject ID is detected Code @@ -311,3 +629,21 @@ Output NULL +# bQuiet and bReturnChecks work as intended + + Code + dfInput <- map_function(dfs = dfs, bQuiet = FALSE) + Message + + -- Checking Input Data for `AE_Map_Raw()` -- + + v No issues found for `AE_Map_Raw()` + + -- Initializing `AE_Map_Raw()` -- + + i Intializing merge of domain and subject data + i 1 ID(s) in subject data not found in domain data. + These participants will have 0s imputed for the following domain data columns: Count. + NA's will be imputed for all other columns. + v `AE_Map_Raw()` returned output with 3 rows. + diff --git a/tests/testthat/_snaps/Analyze_Poisson.md b/tests/testthat/_snaps/Analyze_Poisson.md new file mode 100644 index 000000000..3334ca7d2 --- /dev/null +++ b/tests/testthat/_snaps/Analyze_Poisson.md @@ -0,0 +1,7 @@ +# bQuiet works as intended + + Code + dfAnalyzed <- Analyze_Poisson(dfTransformed, bQuiet = FALSE) + Message + i Fitting log-linked Poisson generalized linear model of [ TotalCount ] ~ [ log( TotalExposure ) ]. + diff --git a/tests/testthat/_snaps/Analyze_Wilcoxon.md b/tests/testthat/_snaps/Analyze_Wilcoxon.md new file mode 100644 index 000000000..3334ca7d2 --- /dev/null +++ b/tests/testthat/_snaps/Analyze_Wilcoxon.md @@ -0,0 +1,7 @@ +# bQuiet works as intended + + Code + dfAnalyzed <- Analyze_Poisson(dfTransformed, bQuiet = FALSE) + Message + i Fitting log-linked Poisson generalized linear model of [ TotalCount ] ~ [ log( TotalExposure ) ]. + diff --git a/tests/testthat/_snaps/Consent_Assess.md b/tests/testthat/_snaps/Consent_Assess.md index 34d3a24c9..58c180ee0 100644 --- a/tests/testthat/_snaps/Consent_Assess.md +++ b/tests/testthat/_snaps/Consent_Assess.md @@ -38,3 +38,24 @@ lTags has unnamed elements +# bQuiet and bReturnChecks work as intended + + Code + assessment <- assess_function(dfInput, bQuiet = FALSE) + Message + + -- Checking Input Data for `Consent_Assess()` -- + + v No issues found for `Consent_Assess()` + + -- Initializing `Consent_Assess()` -- + + Input data has 3 rows. + v `Transform_EventCount()` returned output with 3 rows. + `Score` column created from `KRI`. + `ScoreLabel` column created from `KRILabel`. + i No analysis function used. `dfTransformed` copied directly to `dfAnalyzed` with added `ScoreLabel` column. + v `Flag()` returned output with 3 rows. + v `Summarize()` returned output with 3 rows. + v `Visualize_Count()` created a chart. + diff --git a/tests/testthat/_snaps/Consent_Map_Raw.md b/tests/testthat/_snaps/Consent_Map_Raw.md index 3cc7b0566..52c36a2ed 100644 --- a/tests/testthat/_snaps/Consent_Map_Raw.md +++ b/tests/testthat/_snaps/Consent_Map_Raw.md @@ -1,3 +1,260 @@ +# metadata have not changed + + { + "type": "list", + "attributes": { + "names": { + "type": "character", + "attributes": {}, + "value": ["dfCONSENT", "dfSUBJ"] + } + }, + "value": [ + { + "type": "list", + "attributes": { + "names": { + "type": "character", + "attributes": {}, + "value": ["vRequired", "vNACols"] + } + }, + "value": [ + { + "type": "character", + "attributes": {}, + "value": ["strIDCol", "strTypeCol", "strValueCol", "strDateCol"] + }, + { + "type": "character", + "attributes": {}, + "value": ["strDateCol"] + } + ] + }, + { + "type": "list", + "attributes": { + "names": { + "type": "character", + "attributes": {}, + "value": ["vRequired", "vUniqueCols"] + } + }, + "value": [ + { + "type": "character", + "attributes": {}, + "value": ["strIDCol", "strSiteCol", "strRandDateCol"] + }, + { + "type": "character", + "attributes": {}, + "value": ["strIDCol"] + } + ] + } + ] + } + +--- + + { + "type": "list", + "attributes": { + "names": { + "type": "character", + "attributes": {}, + "value": ["dfSUBJ", "dfCONSENT"] + } + }, + "value": [ + { + "type": "list", + "attributes": { + "names": { + "type": "character", + "attributes": {}, + "value": ["strIDCol", "strSiteCol", "strTimeOnTreatmentCol", "strTimeOnStudyCol", "strRandFlagCol", "strRandDateCol", "strStudyCompletionFlagCol", "strStudyDiscontinuationReasonCol", "strTreatmentCompletionFlagCol", "strTreatmentDiscontinuationReasonCol"] + } + }, + "value": [ + { + "type": "character", + "attributes": {}, + "value": ["SubjectID"] + }, + { + "type": "character", + "attributes": {}, + "value": ["SiteID"] + }, + { + "type": "character", + "attributes": {}, + "value": ["TimeOnTreatment"] + }, + { + "type": "character", + "attributes": {}, + "value": ["TimeOnStudy"] + }, + { + "type": "character", + "attributes": {}, + "value": ["RandFlag"] + }, + { + "type": "character", + "attributes": {}, + "value": ["RandDate"] + }, + { + "type": "character", + "attributes": {}, + "value": ["StudCompletion"] + }, + { + "type": "character", + "attributes": {}, + "value": ["StudDCReason"] + }, + { + "type": "character", + "attributes": {}, + "value": ["TrtCompletion"] + }, + { + "type": "character", + "attributes": {}, + "value": ["TrtDCReason"] + } + ] + }, + { + "type": "list", + "attributes": { + "names": { + "type": "character", + "attributes": {}, + "value": ["strIDCol", "strTypeCol", "strValueCol", "strDateCol", "strConsentTypeValue", "strConsentStatusValue"] + } + }, + "value": [ + { + "type": "character", + "attributes": {}, + "value": ["SubjectID"] + }, + { + "type": "character", + "attributes": {}, + "value": ["CONSENT_TYPE"] + }, + { + "type": "character", + "attributes": {}, + "value": ["CONSENT_VALUE"] + }, + { + "type": "character", + "attributes": {}, + "value": ["CONSENT_DATE"] + }, + { + "type": "character", + "attributes": {}, + "value": ["MAINCONSENT"] + }, + { + "type": "character", + "attributes": {}, + "value": ["Y"] + } + ] + } + ] + } + +--- + + { + "type": "list", + "attributes": { + "names": { + "type": "character", + "attributes": {}, + "value": ["dfInput"] + } + }, + "value": [ + { + "type": "list", + "attributes": { + "names": { + "type": "character", + "attributes": {}, + "value": ["vRequired", "vUniqueCols"] + } + }, + "value": [ + { + "type": "character", + "attributes": {}, + "value": ["strIDCol", "strSiteCol", "strCountCol"] + }, + { + "type": "character", + "attributes": {}, + "value": ["strIDCol"] + } + ] + } + ] + } + +--- + + { + "type": "list", + "attributes": { + "names": { + "type": "character", + "attributes": {}, + "value": ["dfInput"] + } + }, + "value": [ + { + "type": "list", + "attributes": { + "names": { + "type": "character", + "attributes": {}, + "value": ["strIDCol", "strSiteCol", "strCountCol"] + } + }, + "value": [ + { + "type": "character", + "attributes": {}, + "value": ["SubjectID"] + }, + { + "type": "character", + "attributes": {}, + "value": ["SiteID"] + }, + { + "type": "character", + "attributes": {}, + "value": ["Count"] + } + ] + } + ] + } + # invalid data throw errors Code @@ -280,6 +537,90 @@ Output NULL +# missing value throws errors + + Code + map_function(dfs = dfs_edited, bQuiet = FALSE) + Message + + -- Checking Input Data for `Consent_Map_Raw()` -- + + x 1 NA values found in column: SubjectID + ! Issues found for `Consent_Map_Raw()` + ! `Consent_Map_Raw()` did not run because of failed check. + Output + NULL + +--- + + Code + map_function(dfs = dfs_edited, bQuiet = FALSE) + Message + + -- Checking Input Data for `Consent_Map_Raw()` -- + + x 1 NA values found in column: CONSENT_TYPE + ! Issues found for `Consent_Map_Raw()` + ! `Consent_Map_Raw()` did not run because of failed check. + Output + NULL + +--- + + Code + map_function(dfs = dfs_edited, bQuiet = FALSE) + Message + + -- Checking Input Data for `Consent_Map_Raw()` -- + + x 1 NA values found in column: CONSENT_VALUE + ! Issues found for `Consent_Map_Raw()` + ! `Consent_Map_Raw()` did not run because of failed check. + Output + NULL + +--- + + Code + map_function(dfs = dfs_edited, bQuiet = FALSE) + Message + + -- Checking Input Data for `Consent_Map_Raw()` -- + + x 1 NA values found in column: SubjectID + ! Issues found for `Consent_Map_Raw()` + ! `Consent_Map_Raw()` did not run because of failed check. + Output + NULL + +--- + + Code + map_function(dfs = dfs_edited, bQuiet = FALSE) + Message + + -- Checking Input Data for `Consent_Map_Raw()` -- + + x 1 NA values found in column: SiteID + ! Issues found for `Consent_Map_Raw()` + ! `Consent_Map_Raw()` did not run because of failed check. + Output + NULL + +--- + + Code + map_function(dfs = dfs_edited, bQuiet = FALSE) + Message + + -- Checking Input Data for `Consent_Map_Raw()` -- + + x 1 NA values found in column: RandDate + ! Issues found for `Consent_Map_Raw()` + ! `Consent_Map_Raw()` did not run because of failed check. + Output + NULL + # duplicate subject ID is detected Code @@ -413,3 +754,19 @@ Output NULL +# bQuiet and bReturnChecks work as intended + + Code + dfInput <- map_function(dfs = dfs, bQuiet = FALSE) + Message + + -- Checking Input Data for `Consent_Map_Raw()` -- + + v No issues found for `Consent_Map_Raw()` + + -- Initializing `Consent_Map_Raw()` -- + + i Intializing merge of domain and subject data + i 1 ID(s) in subject data not found in domain data.These participants will have NA values imputed for all domain data columns: + v `Consent_Map_Raw()` returned output with 3 rows. + diff --git a/tests/testthat/_snaps/IE_Assess.md b/tests/testthat/_snaps/IE_Assess.md index 482c64bc5..23f0c0206 100644 --- a/tests/testthat/_snaps/IE_Assess.md +++ b/tests/testthat/_snaps/IE_Assess.md @@ -14,3 +14,24 @@ lTags cannot contain elements named: 'SiteID', 'N', 'Score', or 'Flag' +# bQuiet and bReturnChecks work as intended + + Code + assessment <- assess_function(dfInput, bQuiet = FALSE) + Message + + -- Checking Input Data for `IE_Assess()` -- + + v No issues found for `IE_Assess()` + + -- Initializing `IE_Assess()` -- + + Input data has 3 rows. + v `Transform_EventCount()` returned output with 3 rows. + `Score` column created from `KRI`. + `ScoreLabel` column created from `KRILabel`. + i No analysis function used. `dfTransformed` copied directly to `dfAnalyzed` with added `ScoreLabel` column. + v `Flag()` returned output with 3 rows. + v `Summarize()` returned output with 3 rows. + v `Visualize_Count()` created a chart. + diff --git a/tests/testthat/_snaps/IE_Map_Raw.md b/tests/testthat/_snaps/IE_Map_Raw.md index 3fac631a4..dc9f56e51 100644 --- a/tests/testthat/_snaps/IE_Map_Raw.md +++ b/tests/testthat/_snaps/IE_Map_Raw.md @@ -1,3 +1,255 @@ +# metadata have not changed + + { + "type": "list", + "attributes": { + "names": { + "type": "character", + "attributes": {}, + "value": ["dfIE", "dfSUBJ"] + } + }, + "value": [ + { + "type": "list", + "attributes": { + "names": { + "type": "character", + "attributes": {}, + "value": ["vRequired"] + } + }, + "value": [ + { + "type": "character", + "attributes": {}, + "value": ["strIDCol", "strCategoryCol", "strValueCol"] + } + ] + }, + { + "type": "list", + "attributes": { + "names": { + "type": "character", + "attributes": {}, + "value": ["vRequired", "vUniqueCols"] + } + }, + "value": [ + { + "type": "character", + "attributes": {}, + "value": ["strIDCol", "strSiteCol"] + }, + { + "type": "character", + "attributes": {}, + "value": ["strIDCol"] + } + ] + } + ] + } + +--- + + { + "type": "list", + "attributes": { + "names": { + "type": "character", + "attributes": {}, + "value": ["dfSUBJ", "dfIE"] + } + }, + "value": [ + { + "type": "list", + "attributes": { + "names": { + "type": "character", + "attributes": {}, + "value": ["strIDCol", "strSiteCol", "strTimeOnTreatmentCol", "strTimeOnStudyCol", "strRandFlagCol", "strRandDateCol", "strStudyCompletionFlagCol", "strStudyDiscontinuationReasonCol", "strTreatmentCompletionFlagCol", "strTreatmentDiscontinuationReasonCol"] + } + }, + "value": [ + { + "type": "character", + "attributes": {}, + "value": ["SubjectID"] + }, + { + "type": "character", + "attributes": {}, + "value": ["SiteID"] + }, + { + "type": "character", + "attributes": {}, + "value": ["TimeOnTreatment"] + }, + { + "type": "character", + "attributes": {}, + "value": ["TimeOnStudy"] + }, + { + "type": "character", + "attributes": {}, + "value": ["RandFlag"] + }, + { + "type": "character", + "attributes": {}, + "value": ["RandDate"] + }, + { + "type": "character", + "attributes": {}, + "value": ["StudCompletion"] + }, + { + "type": "character", + "attributes": {}, + "value": ["StudDCReason"] + }, + { + "type": "character", + "attributes": {}, + "value": ["TrtCompletion"] + }, + { + "type": "character", + "attributes": {}, + "value": ["TrtDCReason"] + } + ] + }, + { + "type": "list", + "attributes": { + "names": { + "type": "character", + "attributes": {}, + "value": ["strIDCol", "strCategoryCol", "strValueCol", "strVersionCol", "vCategoryValues", "vExpectedResultValues"] + } + }, + "value": [ + { + "type": "character", + "attributes": {}, + "value": ["SubjectID"] + }, + { + "type": "character", + "attributes": {}, + "value": ["IE_CATEGORY"] + }, + { + "type": "character", + "attributes": {}, + "value": ["IE_VALUE"] + }, + { + "type": "character", + "attributes": {}, + "value": ["IE_PROTOCOLVERSION"] + }, + { + "type": "character", + "attributes": {}, + "value": ["EXCL", "INCL"] + }, + { + "type": "integer", + "attributes": {}, + "value": [0, 1] + } + ] + } + ] + } + +--- + + { + "type": "list", + "attributes": { + "names": { + "type": "character", + "attributes": {}, + "value": ["dfInput"] + } + }, + "value": [ + { + "type": "list", + "attributes": { + "names": { + "type": "character", + "attributes": {}, + "value": ["vRequired", "vUniqueCols"] + } + }, + "value": [ + { + "type": "character", + "attributes": {}, + "value": ["strIDCol", "strSiteCol", "strCountCol"] + }, + { + "type": "character", + "attributes": {}, + "value": ["strIDCol"] + } + ] + } + ] + } + +--- + + { + "type": "list", + "attributes": { + "names": { + "type": "character", + "attributes": {}, + "value": ["dfInput"] + } + }, + "value": [ + { + "type": "list", + "attributes": { + "names": { + "type": "character", + "attributes": {}, + "value": ["strIDCol", "strSiteCol", "strCountCol"] + } + }, + "value": [ + { + "type": "character", + "attributes": {}, + "value": ["SubjectID"] + }, + { + "type": "character", + "attributes": {}, + "value": ["SiteID"] + }, + { + "type": "character", + "attributes": {}, + "value": ["Count"] + } + ] + } + ] + } + # invalid data throw errors Code @@ -246,6 +498,76 @@ Output NULL +# missing value throws errors + + Code + map_function(dfs = dfs_edited, bQuiet = FALSE) + Message + + -- Checking Input Data for `IE_Map_Raw()` -- + + x 1 NA values found in column: SubjectID + ! Issues found for `IE_Map_Raw()` + ! `IE_Map_Raw()` did not run because of failed check. + Output + NULL + +--- + + Code + map_function(dfs = dfs_edited, bQuiet = FALSE) + Message + + -- Checking Input Data for `IE_Map_Raw()` -- + + x 1 NA values found in column: IE_CATEGORY + ! Issues found for `IE_Map_Raw()` + ! `IE_Map_Raw()` did not run because of failed check. + Output + NULL + +--- + + Code + map_function(dfs = dfs_edited, bQuiet = FALSE) + Message + + -- Checking Input Data for `IE_Map_Raw()` -- + + x 1 NA values found in column: IE_VALUE + ! Issues found for `IE_Map_Raw()` + ! `IE_Map_Raw()` did not run because of failed check. + Output + NULL + +--- + + Code + map_function(dfs = dfs_edited, bQuiet = FALSE) + Message + + -- Checking Input Data for `IE_Map_Raw()` -- + + x 1 NA values found in column: SubjectID + ! Issues found for `IE_Map_Raw()` + ! `IE_Map_Raw()` did not run because of failed check. + Output + NULL + +--- + + Code + map_function(dfs = dfs_edited, bQuiet = FALSE) + Message + + -- Checking Input Data for `IE_Map_Raw()` -- + + x 1 NA values found in column: SiteID + ! Issues found for `IE_Map_Raw()` + ! `IE_Map_Raw()` did not run because of failed check. + Output + NULL + # duplicate subject ID is detected Code @@ -345,3 +667,21 @@ Output NULL +# bQuiet and bReturnChecks work as intended + + Code + dfInput <- map_function(dfs = dfs, bQuiet = FALSE) + Message + + -- Checking Input Data for `IE_Map_Raw()` -- + + v No issues found for `IE_Map_Raw()` + + -- Initializing `IE_Map_Raw()` -- + + i Intializing merge of domain and subject data + i 1 ID(s) in subject data not found in domain data. + These participants will have 0s imputed for the following domain data columns: Count. + NA's will be imputed for all other columns. + v `IE_Map_Raw()` returned output with 3 rows. + diff --git a/tests/testthat/_snaps/PD_Assess.md b/tests/testthat/_snaps/PD_Assess.md index c615820b9..dd9c85623 100644 --- a/tests/testthat/_snaps/PD_Assess.md +++ b/tests/testthat/_snaps/PD_Assess.md @@ -46,17 +46,17 @@ One or more of these columns: SubjectID, SiteID, Count, Exposure, and Rate not found in dfInput -# NA in dfInput$Count results in Error for PD_Assess +# NA in dfInput$Count results in Error for assess_function Code - PD_Assess(pdInputNA) + assess_function(dfInputNA) Output $strFunctionName - [1] "PD_Assess()" + [1] "assess_function()" $lParams $lParams$dfInput - [1] "pdInputNA" + [1] "dfInputNA" $lTags @@ -71,3 +71,23 @@ 3 9876 X999X 2 4567 0.0004379242 +# bQuiet and bReturnChecks work as intended + + Code + assessment <- assess_function(dfInput, bQuiet = FALSE) + Message + + -- Checking Input Data for `PD_Assess()` -- + + v No issues found for `PD_Assess()` + + -- Initializing `PD_Assess()` -- + + Input data has 3 rows. + v `Transform_EventCount()` returned output with 3 rows. + i Fitting log-linked Poisson generalized linear model of [ TotalCount ] ~ [ log( TotalExposure ) ]. + v `Analyze_Poisson()` returned output with 3 rows. + v `Flag()` returned output with 3 rows. + v `Summarize()` returned output with 3 rows. + v `Visualize_Scatter()` created a chart. + diff --git a/tests/testthat/_snaps/PD_Map_Raw.md b/tests/testthat/_snaps/PD_Map_Raw.md index fde7f7918..4b5d41ac3 100644 --- a/tests/testthat/_snaps/PD_Map_Raw.md +++ b/tests/testthat/_snaps/PD_Map_Raw.md @@ -1,3 +1,255 @@ +# metadata have not changed + + { + "type": "list", + "attributes": { + "names": { + "type": "character", + "attributes": {}, + "value": ["dfPD", "dfSUBJ"] + } + }, + "value": [ + { + "type": "list", + "attributes": { + "names": { + "type": "character", + "attributes": {}, + "value": ["vRequired"] + } + }, + "value": [ + { + "type": "character", + "attributes": {}, + "value": ["strIDCol"] + } + ] + }, + { + "type": "list", + "attributes": { + "names": { + "type": "character", + "attributes": {}, + "value": ["vRequired", "vUniqueCols"] + } + }, + "value": [ + { + "type": "character", + "attributes": {}, + "value": ["strIDCol", "strSiteCol", "strTimeOnStudyCol"] + }, + { + "type": "character", + "attributes": {}, + "value": ["strIDCol"] + } + ] + } + ] + } + +--- + + { + "type": "list", + "attributes": { + "names": { + "type": "character", + "attributes": {}, + "value": ["dfSUBJ", "dfPD"] + } + }, + "value": [ + { + "type": "list", + "attributes": { + "names": { + "type": "character", + "attributes": {}, + "value": ["strIDCol", "strSiteCol", "strTimeOnTreatmentCol", "strTimeOnStudyCol", "strRandFlagCol", "strRandDateCol", "strStudyCompletionFlagCol", "strStudyDiscontinuationReasonCol", "strTreatmentCompletionFlagCol", "strTreatmentDiscontinuationReasonCol"] + } + }, + "value": [ + { + "type": "character", + "attributes": {}, + "value": ["SubjectID"] + }, + { + "type": "character", + "attributes": {}, + "value": ["SiteID"] + }, + { + "type": "character", + "attributes": {}, + "value": ["TimeOnTreatment"] + }, + { + "type": "character", + "attributes": {}, + "value": ["TimeOnStudy"] + }, + { + "type": "character", + "attributes": {}, + "value": ["RandFlag"] + }, + { + "type": "character", + "attributes": {}, + "value": ["RandDate"] + }, + { + "type": "character", + "attributes": {}, + "value": ["StudCompletion"] + }, + { + "type": "character", + "attributes": {}, + "value": ["StudDCReason"] + }, + { + "type": "character", + "attributes": {}, + "value": ["TrtCompletion"] + }, + { + "type": "character", + "attributes": {}, + "value": ["TrtDCReason"] + } + ] + }, + { + "type": "list", + "attributes": { + "names": { + "type": "character", + "attributes": {}, + "value": ["strIDCol", "strCategoryCol", "strImportantCol", "strImportantVal"] + } + }, + "value": [ + { + "type": "character", + "attributes": {}, + "value": ["SubjectID"] + }, + { + "type": "character", + "attributes": {}, + "value": ["PD_CATEGORY"] + }, + { + "type": "character", + "attributes": {}, + "value": ["PD_IMPORTANT_FLAG"] + }, + { + "type": "character", + "attributes": {}, + "value": ["Y"] + } + ] + } + ] + } + +--- + + { + "type": "list", + "attributes": { + "names": { + "type": "character", + "attributes": {}, + "value": ["dfInput"] + } + }, + "value": [ + { + "type": "list", + "attributes": { + "names": { + "type": "character", + "attributes": {}, + "value": ["vRequired", "vUniqueCols"] + } + }, + "value": [ + { + "type": "character", + "attributes": {}, + "value": ["strIDCol", "strSiteCol", "strCountCol", "strExposureCol", "strRateCol"] + }, + { + "type": "character", + "attributes": {}, + "value": ["strIDCol"] + } + ] + } + ] + } + +--- + + { + "type": "list", + "attributes": { + "names": { + "type": "character", + "attributes": {}, + "value": ["dfInput"] + } + }, + "value": [ + { + "type": "list", + "attributes": { + "names": { + "type": "character", + "attributes": {}, + "value": ["strIDCol", "strSiteCol", "strCountCol", "strExposureCol", "strRateCol"] + } + }, + "value": [ + { + "type": "character", + "attributes": {}, + "value": ["SubjectID"] + }, + { + "type": "character", + "attributes": {}, + "value": ["SiteID"] + }, + { + "type": "character", + "attributes": {}, + "value": ["Count"] + }, + { + "type": "character", + "attributes": {}, + "value": ["Exposure"] + }, + { + "type": "character", + "attributes": {}, + "value": ["Rate"] + } + ] + } + ] + } + # invalid data throw errors Code @@ -229,6 +481,62 @@ Output NULL +# missing value throws errors + + Code + map_function(dfs = dfs_edited, bQuiet = FALSE) + Message + + -- Checking Input Data for `PD_Map_Raw()` -- + + x 1 NA values found in column: SubjectID + ! Issues found for `PD_Map_Raw()` + ! `PD_Map_Raw()` did not run because of failed check. + Output + NULL + +--- + + Code + map_function(dfs = dfs_edited, bQuiet = FALSE) + Message + + -- Checking Input Data for `PD_Map_Raw()` -- + + x 1 NA values found in column: SubjectID + ! Issues found for `PD_Map_Raw()` + ! `PD_Map_Raw()` did not run because of failed check. + Output + NULL + +--- + + Code + map_function(dfs = dfs_edited, bQuiet = FALSE) + Message + + -- Checking Input Data for `PD_Map_Raw()` -- + + x 1 NA values found in column: SiteID + ! Issues found for `PD_Map_Raw()` + ! `PD_Map_Raw()` did not run because of failed check. + Output + NULL + +--- + + Code + map_function(dfs = dfs_edited, bQuiet = FALSE) + Message + + -- Checking Input Data for `PD_Map_Raw()` -- + + x 1 NA values found in column: TimeOnStudy + ! Issues found for `PD_Map_Raw()` + ! `PD_Map_Raw()` did not run because of failed check. + Output + NULL + # duplicate subject ID is detected Code @@ -311,3 +619,18 @@ Output NULL +# bQuiet and bReturnChecks work as intended + + Code + dfInput <- map_function(dfs = dfs, bQuiet = FALSE) + Message + + -- Checking Input Data for `PD_Map_Raw()` -- + + v No issues found for `PD_Map_Raw()` + + -- Initializing `PD_Map_Raw()` -- + + i Intializing merge of domain and subject data + v `PD_Map_Raw()` returned output with 3 rows. + diff --git a/tests/testthat/_snaps/util_is_mapping_valid.md b/tests/testthat/_snaps/util_is_mapping_valid.md index b11221ce1..4c13cbfa5 100644 --- a/tests/testthat/_snaps/util_is_mapping_valid.md +++ b/tests/testthat/_snaps/util_is_mapping_valid.md @@ -1,3 +1,89 @@ +# vUniqueCols are caught + + Code + is_mapping_valid(dfSUBJ, mapping = mapping_rdsl, spec = list(vUniqueCols = "strIDCol", + vRequired = c("strIDCol")), bQuiet = FALSE) + Message + x Unexpected duplicates found in column: SubjectID + Output + $status + [1] FALSE + + $tests_if + $tests_if$is_data_frame + $tests_if$is_data_frame$status + [1] TRUE + + $tests_if$is_data_frame$warning + [1] NA + + + $tests_if$has_required_params + $tests_if$has_required_params$status + [1] TRUE + + $tests_if$has_required_params$warning + [1] NA + + + $tests_if$spec_is_list + $tests_if$spec_is_list$status + [1] TRUE + + $tests_if$spec_is_list$warning + [1] NA + + + $tests_if$mapping_is_list + $tests_if$mapping_is_list$status + [1] TRUE + + $tests_if$mapping_is_list$warning + [1] NA + + + $tests_if$mappings_are_character + $tests_if$mappings_are_character$status + [1] TRUE + + $tests_if$mappings_are_character$warning + [1] NA + + + $tests_if$has_expected_columns + $tests_if$has_expected_columns$status + [1] TRUE + + $tests_if$has_expected_columns$warning + [1] NA + + + $tests_if$columns_have_na + $tests_if$columns_have_na$status + [1] TRUE + + $tests_if$columns_have_na$warning + [1] NA + + + $tests_if$columns_have_empty_values + $tests_if$columns_have_empty_values$status + [1] TRUE + + $tests_if$columns_have_empty_values$warning + [1] NA + + + $tests_if$cols_are_unique + $tests_if$cols_are_unique$status + [1] FALSE + + $tests_if$cols_are_unique$warning + [1] "Unexpected duplicates found in column: SubjectID" + + + + # status is FALSE when spec is incorrect Code @@ -85,3 +171,12 @@ +# bQuiet works as intended + + Code + result <- is_mapping_valid(df = dfSUBJ, mapping = mapping_rdsl, bQuiet = FALSE, + spec = list(vRequired = "notACol")) + Message + x "mapping" does not contain required parameters: notACol + x Non-character column names found in mapping: + diff --git a/tests/testthat/test_AE_Assess.R b/tests/testthat/test_AE_Assess.R index 4aa745489..3c9ee5b06 100644 --- a/tests/testthat/test_AE_Assess.R +++ b/tests/testthat/test_AE_Assess.R @@ -7,54 +7,54 @@ output_mapping <- yaml::read_yaml(system.file('mappings', 'AE_Assess.yaml', pack # output is created as expected ------------------------------------------- test_that("output is created as expected", { - aeAssessment <- AE_Assess(dfInput, vThreshold = c(-5.1, 5.1)) - expect_true(is.list(aeAssessment)) - expect_equal(names(aeAssessment), c("strFunctionName", "lParams", "lTags", "dfInput", "dfTransformed", "dfAnalyzed", "dfFlagged", "dfSummary", "chart")) - expect_true("data.frame" %in% class(aeAssessment$dfInput)) - expect_true("data.frame" %in% class(aeAssessment$dfTransformed)) - expect_true("data.frame" %in% class(aeAssessment$dfAnalyzed)) - expect_true("data.frame" %in% class(aeAssessment$dfFlagged)) - expect_true("data.frame" %in% class(aeAssessment$dfSummary)) - expect_type(aeAssessment$strFunctionName, "character") - expect_type(aeAssessment$lParams, "list") - expect_type(aeAssessment$lTags, "list") + assessment <- assess_function(dfInput, vThreshold = c(-5.1, 5.1)) + expect_true(is.list(assessment)) + expect_equal(names(assessment), c("strFunctionName", "lParams", "lTags", "dfInput", "dfTransformed", "dfAnalyzed", "dfFlagged", "dfSummary", "chart")) + expect_true("data.frame" %in% class(assessment$dfInput)) + expect_true("data.frame" %in% class(assessment$dfTransformed)) + expect_true("data.frame" %in% class(assessment$dfAnalyzed)) + expect_true("data.frame" %in% class(assessment$dfFlagged)) + expect_true("data.frame" %in% class(assessment$dfSummary)) + expect_type(assessment$strFunctionName, "character") + expect_type(assessment$lParams, "list") + expect_type(assessment$lTags, "list") }) # metadata is returned as expected ---------------------------------------- test_that("metadata is returned as expected", { - aeAssessment <- AE_Assess(dfInput, vThreshold = c(-5.1, 5.1)) - expect_equal("AE_Assess()", aeAssessment$strFunctionName) - expect_equal("dfInput", aeAssessment$lParams$dfInput) - expect_equal("-5.1", aeAssessment$lParams$vThreshold[2]) - expect_equal("5.1", aeAssessment$lParams$vThreshold[3]) - expect_equal("AE", aeAssessment$lTags$Assessment) - expect_true("ggplot" %in% class(aeAssessment$chart)) + assessment <- assess_function(dfInput, vThreshold = c(-5.1, 5.1)) + expect_equal("assess_function()", assessment$strFunctionName) + expect_equal("dfInput", assessment$lParams$dfInput) + expect_equal("-5.1", assessment$lParams$vThreshold[2]) + expect_equal("5.1", assessment$lParams$vThreshold[3]) + expect_equal("AE", assessment$lTags$Assessment) + expect_true("ggplot" %in% class(assessment$chart)) }) # incorrect inputs throw errors ------------------------------------------- test_that("incorrect inputs throw errors", { - expect_snapshot_error(AE_Assess(list())) - expect_snapshot_error(AE_Assess("Hi")) - expect_snapshot_error(AE_Assess(dfInput, strMethod = 123)) - expect_snapshot_error(AE_Assess(dfInput, strMethod = "abacus")) - expect_snapshot_error(AE_Assess(dfInput, strMethod = c("wilcoxon", "poisson"))) - expect_snapshot_error(AE_Assess(dfInput, vThreshold = "A")) - expect_snapshot_error(AE_Assess(dfInput, vThreshold = 1)) - expect_snapshot_error(AE_Assess(dfInput %>% select(-SubjectID))) - expect_snapshot_error(AE_Assess(dfInput %>% select(-SiteID))) - expect_snapshot_error(AE_Assess(dfInput %>% select(-Count))) - expect_snapshot_error(AE_Assess(dfInput %>% select(-Exposure))) - expect_snapshot_error(AE_Assess(dfInput %>% select(-Rate))) - expect_error(AE_Assess(dfInput, strKRILabel = c("label 1", "label 2"))) + expect_snapshot_error(assess_function(list())) + expect_snapshot_error(assess_function("Hi")) + expect_snapshot_error(assess_function(dfInput, strMethod = 123)) + expect_snapshot_error(assess_function(dfInput, strMethod = "abacus")) + expect_snapshot_error(assess_function(dfInput, strMethod = c("wilcoxon", "poisson"))) + expect_snapshot_error(assess_function(dfInput, vThreshold = "A")) + expect_snapshot_error(assess_function(dfInput, vThreshold = 1)) + expect_snapshot_error(assess_function(dfInput %>% select(-SubjectID))) + expect_snapshot_error(assess_function(dfInput %>% select(-SiteID))) + expect_snapshot_error(assess_function(dfInput %>% select(-Count))) + expect_snapshot_error(assess_function(dfInput %>% select(-Exposure))) + expect_snapshot_error(assess_function(dfInput %>% select(-Rate))) + expect_error(assess_function(dfInput, strKRILabel = c("label 1", "label 2"))) }) # incorrect lTags throw errors -------------------------------------------- test_that("incorrect lTags throw errors", { - expect_snapshot_error(AE_Assess(dfInput, vThreshold = c(-5.1, 5.1), lTags = "hi mom")) - expect_snapshot_error(AE_Assess(dfInput, vThreshold = c(-5.1, 5.1), lTags = list("hi", "mom"))) - expect_snapshot_error(AE_Assess(dfInput, vThreshold = c(-5.1, 5.1), lTags = list(greeting = "hi", "mom"))) + expect_snapshot_error(assess_function(dfInput, vThreshold = c(-5.1, 5.1), lTags = "hi mom")) + expect_snapshot_error(assess_function(dfInput, vThreshold = c(-5.1, 5.1), lTags = list("hi", "mom"))) + expect_snapshot_error(assess_function(dfInput, vThreshold = c(-5.1, 5.1), lTags = list(greeting = "hi", "mom"))) expect_silent( - AE_Assess( + assess_function( dfInput, vThreshold = c(-5.1, 5.1), lTags = list( @@ -63,27 +63,27 @@ test_that("incorrect lTags throw errors", { ) ) ) - expect_snapshot_error(AE_Assess(dfInput, lTags = list(SiteID = ""))) - expect_snapshot_error(AE_Assess(dfInput, lTags = list(N = ""))) - expect_snapshot_error(AE_Assess(dfInput, lTags = list(Score = ""))) - expect_snapshot_error(AE_Assess(dfInput, lTags = list(Flag = ""))) + expect_snapshot_error(assess_function(dfInput, lTags = list(SiteID = ""))) + expect_snapshot_error(assess_function(dfInput, lTags = list(N = ""))) + expect_snapshot_error(assess_function(dfInput, lTags = list(Score = ""))) + expect_snapshot_error(assess_function(dfInput, lTags = list(Flag = ""))) }) # custom tests ------------------------------------------------------------ test_that("strMethod = 'wilcoxon' does not throw error", { - expect_error(AE_Assess(dfInput, strMethod = "wilcoxon"), NA) + expect_error(assess_function(dfInput, strMethod = "wilcoxon"), NA) }) -test_that("NA in dfInput$Count results in Error for AE_Assess", { - aeInputNA <- dfInput - aeInputNA[1, "Count"] <- NA - expect_snapshot(AE_Assess(aeInputNA)) +test_that("NA in dfInput$Count results in Error for assess_function", { + dfInputNA <- dfInput + dfInputNA[1, "Count"] <- NA + expect_snapshot(assess_function(dfInputNA)) }) test_that("dfAnalyzed has appropriate model output regardless of statistical method", { - assessmentPoisson <- AE_Assess(dfInput, strMethod = "poisson") + assessmentPoisson <- assess_function(dfInput, strMethod = "poisson") expect_true(all(c("KRI", "KRILabel", "Score", "ScoreLabel") %in% names(assessmentPoisson$dfAnalyzed))) - assessmentWilcoxon <- AE_Assess(dfInput, strMethod = "wilcoxon") + assessmentWilcoxon <- assess_function(dfInput, strMethod = "wilcoxon") expect_true(all(c("KRI", "KRILabel", "Score", "ScoreLabel") %in% names(assessmentWilcoxon$dfAnalyzed))) expect_equal(unique(assessmentPoisson$dfAnalyzed$ScoreLabel), "Residuals") @@ -98,6 +98,6 @@ test_that("bQuiet and bReturnChecks work as intended", { }) test_that("strKRILabel works as intended", { - ae <- AE_Assess(dfInput, strKRILabel = "my test label") - expect_equal(unique(ae$dfSummary$KRILabel), "my test label") + assessment <- assess_function(dfInput, strKRILabel = "my test label") + expect_equal(unique(assessment$dfSummary$KRILabel), "my test label") }) diff --git a/tests/testthat/test_AE_Map_Adam.R b/tests/testthat/test_AE_Map_Adam.R index afb0e7acb..4933423ed 100644 --- a/tests/testthat/test_AE_Map_Adam.R +++ b/tests/testthat/test_AE_Map_Adam.R @@ -121,13 +121,13 @@ test_that("NA values in input data are handled", { }) test_that("bQuiet works as intended", { - expect_message( - AE_Map_Adam(dfs = list(dfAE = dfAE, dfSUBJ = dfSUBJ), bQuiet = FALSE) + expect_snapshot( + dfInput <- AE_Map_Adam(dfs = list(dfADAE = dfADAE, dfADSL = dfADSL), bQuiet = FALSE) ) }) test_that("bReturnChecks works as intended", { expect_true( - all(names(AE_Map_Adam(dfs = list(dfAE = dfAE, dfSUBJ = dfSUBJ), bReturnChecks = TRUE)) == c("df", "lChecks")) + all(names(AE_Map_Adam(dfs = list(dfADAE = dfADAE, dfADSL = dfADSL), bReturnChecks = TRUE)) == c("df", "lChecks")) ) }) diff --git a/tests/testthat/test_AE_Map_Raw.R b/tests/testthat/test_AE_Map_Raw.R index ed5dfc93f..d6cbdcf7b 100644 --- a/tests/testthat/test_AE_Map_Raw.R +++ b/tests/testthat/test_AE_Map_Raw.R @@ -13,6 +13,14 @@ input_mapping <- yaml::read_yaml(system.file('mappings', 'AE_Map_Raw.yaml', pack output_spec <- yaml::read_yaml(system.file('specs', 'AE_Assess.yaml', package = 'gsm')) output_mapping <- yaml::read_yaml(system.file('mappings', 'AE_Assess.yaml', package = 'gsm')) +test_that('metadata have not changed', { + expect_snapshot_value(input_spec, 'json2') + expect_snapshot_value(input_mapping, 'json2') + + expect_snapshot_value(output_spec, 'json2') + expect_snapshot_value(output_mapping, 'json2') +}) + test_that("valid output is returned", { test_valid_output( map_function, diff --git a/tests/testthat/test_Analyze_Chisq.R b/tests/testthat/test_Analyze_Chisq.R index 683e7e1b4..4567134a5 100644 --- a/tests/testthat/test_Analyze_Chisq.R +++ b/tests/testthat/test_Analyze_Chisq.R @@ -1,7 +1,16 @@ source(testthat::test_path("testdata/data.R")) -dfInput <- Disp_Map(dfDisp, strCol = "DCREASCD", strReason = "Adverse Event") -dfTransformed <- Transform_EventCount(dfInput, strCountCol = "Count", strKRILabel = "Discontinuation Reasons/Site") +dfInput <- Disp_Map( + dfDisp, + strCol = "DCREASCD", + strReason = "Adverse Event" +) + +dfTransformed <- Transform_EventCount( + dfInput, + strCountCol = "Count", + strKRILabel = "Discontinuation Reasons/Site" +) test_that("output created as expected and has correct structure", { chisq <- suppressWarnings(Analyze_Chisq(dfTransformed)) diff --git a/tests/testthat/test_Analyze_Poisson.R b/tests/testthat/test_Analyze_Poisson.R index 69397384e..b7722f966 100644 --- a/tests/testthat/test_Analyze_Poisson.R +++ b/tests/testthat/test_Analyze_Poisson.R @@ -46,8 +46,8 @@ test_that("NA values are caught", { }) test_that("bQuiet works as intended", { - ae_prep <- Transform_EventCount(ae_input, strCountCol = "Count", strExposureCol = "Exposure") - expect_message( - Analyze_Poisson(ae_prep, bQuiet = FALSE) + dfTransformed <- Transform_EventCount(ae_input, strCountCol = "Count", strExposureCol = "Exposure") + expect_snapshot( + dfAnalyzed <- Analyze_Poisson(dfTransformed, bQuiet = FALSE) ) }) diff --git a/tests/testthat/test_Analyze_Wilcoxon.R b/tests/testthat/test_Analyze_Wilcoxon.R index abb5f9ee7..f03cb8d73 100644 --- a/tests/testthat/test_Analyze_Wilcoxon.R +++ b/tests/testthat/test_Analyze_Wilcoxon.R @@ -54,8 +54,8 @@ test_that("model isn't run with a single outcome value", { }) test_that("bQuiet works as intended", { - ae_prep <- Transform_EventCount(ae_input, strCountCol = "Count", strExposureCol = "Exposure") - expect_message( - Analyze_Poisson(ae_prep, bQuiet = FALSE) + dfTransformed <- Transform_EventCount(ae_input, strCountCol = "Count", strExposureCol = "Exposure") + expect_snapshot( + dfAnalyzed <- Analyze_Poisson(dfTransformed, bQuiet = FALSE) ) }) diff --git a/tests/testthat/test_Consent_Assess.R b/tests/testthat/test_Consent_Assess.R index 6366104f5..16d6fcd7f 100644 --- a/tests/testthat/test_Consent_Assess.R +++ b/tests/testthat/test_Consent_Assess.R @@ -1,79 +1,74 @@ source(testthat::test_path("testdata/data.R")) -consentInput <- Consent_Map_Raw(dfs = list(dfCONSENT = dfCONSENT, dfSUBJ = dfSUBJ)) +assess_function <- gsm::Consent_Assess +dfInput <- Consent_Map_Raw(dfs = list(dfCONSENT = dfCONSENT, dfSUBJ = dfSUBJ)) +output_spec <- yaml::read_yaml(system.file('specs', 'Consent_Assess.yaml', package = 'gsm')) +output_mapping <- yaml::read_yaml(system.file('mappings', 'Consent_Assess.yaml', package = 'gsm')) # output is created as expected ------------------------------------------- test_that("output is created as expected", { - consentAssessment <- Consent_Assess(consentInput) - expect_true(is.list(consentAssessment)) - expect_equal(names(consentAssessment), c("strFunctionName", "lParams", "lTags", "dfInput", "dfTransformed", "dfAnalyzed", "dfFlagged", "dfSummary", "chart")) - expect_true("data.frame" %in% class(consentAssessment$dfInput)) - expect_true("data.frame" %in% class(consentAssessment$dfTransformed)) - expect_true("data.frame" %in% class(consentAssessment$dfAnalyzed)) - expect_true("data.frame" %in% class(consentAssessment$dfFlagged)) - expect_true("data.frame" %in% class(consentAssessment$dfSummary)) - expect_type(consentAssessment$strFunctionName, "character") - expect_type(consentAssessment$lParams, "list") - expect_type(consentAssessment$lTags, "list") + assessment <- assess_function(dfInput) + expect_true(is.list(assessment)) + expect_equal(names(assessment), c("strFunctionName", "lParams", "lTags", "dfInput", "dfTransformed", "dfAnalyzed", "dfFlagged", "dfSummary", "chart")) + expect_true("data.frame" %in% class(assessment$dfInput)) + expect_true("data.frame" %in% class(assessment$dfTransformed)) + expect_true("data.frame" %in% class(assessment$dfAnalyzed)) + expect_true("data.frame" %in% class(assessment$dfFlagged)) + expect_true("data.frame" %in% class(assessment$dfSummary)) + expect_type(assessment$strFunctionName, "character") + expect_type(assessment$lParams, "list") + expect_type(assessment$lTags, "list") }) # metadata is returned as expected ---------------------------------------- test_that("metadata is returned as expected", { - consentAssessment <- Consent_Assess(consentInput, nThreshold = 0.6) - expect_equal("Consent_Assess()", consentAssessment$strFunctionName) - expect_equal("consentInput", consentAssessment$lParams$dfInput) - expect_equal("0.6", consentAssessment$lParams$nThreshold) - expect_equal("Consent", consentAssessment$lTags$Assessment) - expect_true("ggplot" %in% class(consentAssessment$chart)) + assessment <- assess_function(dfInput, nThreshold = 0.6) + expect_equal("assess_function()", assessment$strFunctionName) + expect_equal("dfInput", assessment$lParams$dfInput) + expect_equal("0.6", assessment$lParams$nThreshold) + expect_equal("Consent", assessment$lTags$Assessment) + expect_true("ggplot" %in% class(assessment$chart)) }) # incorrect inputs throw errors ------------------------------------------- test_that("incorrect inputs throw errors", { - expect_snapshot_error(Consent_Assess(list())) - expect_snapshot_error(Consent_Assess("Hi")) - expect_snapshot_error(Consent_Assess(consentInput, nThreshold = "A")) - expect_snapshot_error(Consent_Assess(consentInput, nThreshold = c(1, 2))) - expect_snapshot_error(Consent_Assess(consentInput %>% select(-SubjectID))) - expect_snapshot_error(Consent_Assess(consentInput %>% select(-SiteID))) - expect_snapshot_error(Consent_Assess(consentInput %>% select(-Count))) - expect_error(Consent_Assess(consentInput, strKRILabel = c("label 1", "label 2"))) + expect_snapshot_error(assess_function(list())) + expect_snapshot_error(assess_function("Hi")) + expect_snapshot_error(assess_function(dfInput, nThreshold = "A")) + expect_snapshot_error(assess_function(dfInput, nThreshold = c(1, 2))) + expect_snapshot_error(assess_function(dfInput %>% select(-SubjectID))) + expect_snapshot_error(assess_function(dfInput %>% select(-SiteID))) + expect_snapshot_error(assess_function(dfInput %>% select(-Count))) + expect_error(assess_function(dfInput, strKRILabel = c("label 1", "label 2"))) }) # incorrect lTags throw errors -------------------------------------------- test_that("incorrect lTags throw errors", { - expect_snapshot_error(Consent_Assess(consentInput, lTags = "hi mom")) - expect_snapshot_error(Consent_Assess(consentInput, lTags = list("hi", "mom"))) - expect_snapshot_error(Consent_Assess(consentInput, lTags = list(greeting = "hi", "mom"))) - expect_silent(Consent_Assess(consentInput, lTags = list(greeting = "hi", person = "mom"))) - expect_error(Consent_Assess(consentInput, lTags = list(SiteID = ""))) - expect_error(Consent_Assess(consentInput, lTags = list(N = ""))) - expect_error(Consent_Assess(consentInput, lTags = list(Score = ""))) - expect_error(Consent_Assess(consentInput, lTags = list(Flag = ""))) + expect_snapshot_error(assess_function(dfInput, lTags = "hi mom")) + expect_snapshot_error(assess_function(dfInput, lTags = list("hi", "mom"))) + expect_snapshot_error(assess_function(dfInput, lTags = list(greeting = "hi", "mom"))) + expect_silent(assess_function(dfInput, lTags = list(greeting = "hi", person = "mom"))) + expect_error(assess_function(dfInput, lTags = list(SiteID = ""))) + expect_error(assess_function(dfInput, lTags = list(N = ""))) + expect_error(assess_function(dfInput, lTags = list(Score = ""))) + expect_error(assess_function(dfInput, lTags = list(Flag = ""))) }) # custom tests ------------------------------------------------------------ test_that("dfAnalyzed has appropriate model output regardless of statistical method", { - assessment <- Consent_Assess(consentInput) + assessment <- assess_function(dfInput) expect_equal(unique(assessment$dfAnalyzed$ScoreLabel), "Total Number of Consent Issues") expect_equal(sort(assessment$dfAnalyzed$Score), sort(assessment$dfSummary$Score)) }) -test_that("bQuiet works as intended", { - expect_message( - Consent_Assess(consentInput, bQuiet = FALSE) - ) -}) - -test_that("bReturnChecks works as intended", { - expect_true( - "lChecks" %in% names(Consent_Assess(consentInput, bReturnChecks = TRUE)) - ) +test_that("bQuiet and bReturnChecks work as intended", { + test_logical_assess_parameters(assess_function, dfInput) }) test_that("strKRILabel works as intended", { - consent <- Consent_Assess(consentInput, strKRILabel = "my test label") - expect_equal(unique(consent$dfSummary$KRILabel), "my test label") + assessment <- assess_function(dfInput, strKRILabel = "my test label") + expect_equal(unique(assessment$dfSummary$KRILabel), "my test label") }) diff --git a/tests/testthat/test_Consent_Map_Raw.R b/tests/testthat/test_Consent_Map_Raw.R index 2399433b2..423c983c7 100644 --- a/tests/testthat/test_Consent_Map_Raw.R +++ b/tests/testthat/test_Consent_Map_Raw.R @@ -13,6 +13,14 @@ input_mapping <- yaml::read_yaml(system.file('mappings', 'Consent_Map_Raw.yaml', output_spec <- yaml::read_yaml(system.file('specs', 'Consent_Assess.yaml', package = 'gsm')) output_mapping <- yaml::read_yaml(system.file('mappings', 'Consent_Assess.yaml', package = 'gsm')) +test_that('metadata have not changed', { + expect_snapshot_value(input_spec, 'json2') + expect_snapshot_value(input_mapping, 'json2') + + expect_snapshot_value(output_spec, 'json2') + expect_snapshot_value(output_mapping, 'json2') +}) + test_that("valid output is returned", { test_valid_output( map_function, diff --git a/tests/testthat/test_IE_Assess.R b/tests/testthat/test_IE_Assess.R index 904616a2e..0a9564a79 100644 --- a/tests/testthat/test_IE_Assess.R +++ b/tests/testthat/test_IE_Assess.R @@ -1,76 +1,71 @@ source(testthat::test_path("testdata/data.R")) -ieInput <- IE_Map_Raw(dfs = list(dfIE = dfIE, dfSUBJ = dfSUBJ)) +assess_function <- gsm::IE_Assess +dfInput <- IE_Map_Raw(dfs = list(dfIE = dfIE, dfSUBJ = dfSUBJ)) +output_spec <- yaml::read_yaml(system.file('specs', 'IE_Assess.yaml', package = 'gsm')) +output_mapping <- yaml::read_yaml(system.file('mappings', 'IE_Assess.yaml', package = 'gsm')) # output is created as expected ------------------------------------------- test_that("output is created as expected", { - ieAssessment <- IE_Assess(ieInput) - expect_true(is.list(ieAssessment)) - expect_equal(names(ieAssessment), c("strFunctionName", "lParams", "lTags", "dfInput", "dfTransformed", "dfAnalyzed", "dfFlagged", "dfSummary", "chart")) - expect_true("data.frame" %in% class(ieAssessment$dfInput)) - expect_true("data.frame" %in% class(ieAssessment$dfTransformed)) - expect_true("data.frame" %in% class(ieAssessment$dfAnalyzed)) - expect_true("data.frame" %in% class(ieAssessment$dfFlagged)) - expect_true("data.frame" %in% class(ieAssessment$dfSummary)) - expect_type(ieAssessment$strFunctionName, "character") - expect_type(ieAssessment$lParams, "list") - expect_type(ieAssessment$lTags, "list") + assessment <- assess_function(dfInput) + expect_true(is.list(assessment)) + expect_equal(names(assessment), c("strFunctionName", "lParams", "lTags", "dfInput", "dfTransformed", "dfAnalyzed", "dfFlagged", "dfSummary", "chart")) + expect_true("data.frame" %in% class(assessment$dfInput)) + expect_true("data.frame" %in% class(assessment$dfTransformed)) + expect_true("data.frame" %in% class(assessment$dfAnalyzed)) + expect_true("data.frame" %in% class(assessment$dfFlagged)) + expect_true("data.frame" %in% class(assessment$dfSummary)) + expect_type(assessment$strFunctionName, "character") + expect_type(assessment$lParams, "list") + expect_type(assessment$lTags, "list") }) # metadata is returned as expected ---------------------------------------- test_that("metadata is returned as expected", { - ieAssessment <- IE_Assess(ieInput, nThreshold = 0.755555) - expect_equal("IE_Assess()", ieAssessment$strFunctionName) - expect_equal("0.755555", ieAssessment$lParams$nThreshold) - expect_equal("IE", ieAssessment$lTags$Assessment) - expect_true("ggplot" %in% class(ieAssessment$chart)) + assessment <- assess_function(dfInput, nThreshold = 0.755555) + expect_equal("assess_function()", assessment$strFunctionName) + expect_equal("0.755555", assessment$lParams$nThreshold) + expect_equal("IE", assessment$lTags$Assessment) + expect_true("ggplot" %in% class(assessment$chart)) }) # incorrect inputs throw errors ------------------------------------------- test_that("incorrect inputs throw errors", { - expect_error(IE_Assess(list())) - expect_error(IE_Assess("Hi")) - expect_error(IE_Assess(ieInput, nThreshold = FALSE)) - expect_error(IE_Assess(ieInput, nThreshold = "A")) - expect_error(IE_Assess(ieInput, nThreshold = c(1, 2))) - expect_error(IE_Assess(ieInput %>% select(-SubjectID))) - expect_error(IE_Assess(ieInput %>% select(-SiteID))) - expect_error(IE_Assess(ieInput %>% select(-Count))) - expect_error(IE_Assess(ieInput, strKRILabel = c("label 1", "label 2"))) + expect_error(assess_function(list())) + expect_error(assess_function("Hi")) + expect_error(assess_function(dfInput, nThreshold = FALSE)) + expect_error(assess_function(dfInput, nThreshold = "A")) + expect_error(assess_function(dfInput, nThreshold = c(1, 2))) + expect_error(assess_function(dfInput %>% select(-SubjectID))) + expect_error(assess_function(dfInput %>% select(-SiteID))) + expect_error(assess_function(dfInput %>% select(-Count))) + expect_error(assess_function(dfInput, strKRILabel = c("label 1", "label 2"))) }) # incorrect lTags throw errors -------------------------------------------- test_that("incorrect lTags throw errors", { - expect_error(IE_Assess(ieInput, lTags = "hi mom")) - expect_error(IE_Assess(ieInput, lTags = list("hi", "mom"))) - expect_error(IE_Assess(ieInput, lTags = list(greeting = "hi", "mom"))) - expect_silent(IE_Assess(ieInput, lTags = list(greeting = "hi", person = "mom"))) - expect_snapshot_error(IE_Assess(ieInput, lTags = list(SiteID = ""))) - expect_snapshot_error(IE_Assess(ieInput, lTags = list(N = ""))) - expect_snapshot_error(IE_Assess(ieInput, lTags = list(Score = ""))) - expect_snapshot_error(IE_Assess(ieInput, lTags = list(Flag = ""))) + expect_error(assess_function(dfInput, lTags = "hi mom")) + expect_error(assess_function(dfInput, lTags = list("hi", "mom"))) + expect_error(assess_function(dfInput, lTags = list(greeting = "hi", "mom"))) + expect_silent(assess_function(dfInput, lTags = list(greeting = "hi", person = "mom"))) + expect_snapshot_error(assess_function(dfInput, lTags = list(SiteID = ""))) + expect_snapshot_error(assess_function(dfInput, lTags = list(N = ""))) + expect_snapshot_error(assess_function(dfInput, lTags = list(Score = ""))) + expect_snapshot_error(assess_function(dfInput, lTags = list(Flag = ""))) }) # custom tests ------------------------------------------------------------ test_that("dfAnalyzed has appropriate model output regardless of statistical method", { - assessment <- IE_Assess(ieInput) + assessment <- assess_function(dfInput) expect_equal(unique(assessment$dfAnalyzed$ScoreLabel), "# of Inclusion/Exclusion Issues") expect_equal(sort(assessment$dfAnalyzed$Score), sort(assessment$dfSummary$Score)) }) -test_that("bQuiet works as intended", { - expect_message( - IE_Assess(ieInput, bQuiet = FALSE) - ) -}) - -test_that("bReturnChecks works as intended", { - expect_true( - "lChecks" %in% names(IE_Assess(ieInput, bReturnChecks = TRUE)) - ) +test_that("bQuiet and bReturnChecks work as intended", { + test_logical_assess_parameters(assess_function, dfInput) }) test_that("strKRILabel works as intended", { - ie <- IE_Assess(ieInput, strKRILabel = "my test label") - expect_equal(unique(ie$dfSummary$KRILabel), "my test label") + assessment <- assess_function(dfInput, strKRILabel = "my test label") + expect_equal(unique(assessment$dfSummary$KRILabel), "my test label") }) diff --git a/tests/testthat/test_IE_Map_Raw.R b/tests/testthat/test_IE_Map_Raw.R index 34a200f55..22a45ae90 100644 --- a/tests/testthat/test_IE_Map_Raw.R +++ b/tests/testthat/test_IE_Map_Raw.R @@ -13,6 +13,14 @@ input_mapping <- yaml::read_yaml(system.file('mappings', 'IE_Map_Raw.yaml', pack output_spec <- yaml::read_yaml(system.file('specs', 'IE_Assess.yaml', package = 'gsm')) output_mapping <- yaml::read_yaml(system.file('mappings', 'IE_Assess.yaml', package = 'gsm')) +test_that('metadata have not changed', { + expect_snapshot_value(input_spec, 'json2') + expect_snapshot_value(input_mapping, 'json2') + + expect_snapshot_value(output_spec, 'json2') + expect_snapshot_value(output_mapping, 'json2') +}) + test_that("valid output is returned", { test_valid_output( map_function, diff --git a/tests/testthat/test_PD_Assess.R b/tests/testthat/test_PD_Assess.R index 78a8a9949..1a8521171 100644 --- a/tests/testthat/test_PD_Assess.R +++ b/tests/testthat/test_PD_Assess.R @@ -7,54 +7,54 @@ output_mapping <- yaml::read_yaml(system.file('mappings', 'PD_Assess.yaml', pack # output is created as expected ------------------------------------------- test_that("output is created as expected", { - pdAssessment <- PD_Assess(dfInput) - expect_true(is.list(pdAssessment)) - expect_equal(names(pdAssessment), c("strFunctionName", "lParams", "lTags", "dfInput", "dfTransformed", "dfAnalyzed", "dfFlagged", "dfSummary", "chart")) - expect_true("data.frame" %in% class(pdAssessment$dfInput)) - expect_true("data.frame" %in% class(pdAssessment$dfTransformed)) - expect_true("data.frame" %in% class(pdAssessment$dfAnalyzed)) - expect_true("data.frame" %in% class(pdAssessment$dfFlagged)) - expect_true("data.frame" %in% class(pdAssessment$dfSummary)) - expect_type(pdAssessment$strFunctionName, "character") - expect_type(pdAssessment$lParams, "list") - expect_type(pdAssessment$lTags, "list") + assessment <- assess_function(dfInput) + expect_true(is.list(assessment)) + expect_equal(names(assessment), c("strFunctionName", "lParams", "lTags", "dfInput", "dfTransformed", "dfAnalyzed", "dfFlagged", "dfSummary", "chart")) + expect_true("data.frame" %in% class(assessment$dfInput)) + expect_true("data.frame" %in% class(assessment$dfTransformed)) + expect_true("data.frame" %in% class(assessment$dfAnalyzed)) + expect_true("data.frame" %in% class(assessment$dfFlagged)) + expect_true("data.frame" %in% class(assessment$dfSummary)) + expect_type(assessment$strFunctionName, "character") + expect_type(assessment$lParams, "list") + expect_type(assessment$lTags, "list") }) # metadata is returned as expected ---------------------------------------- test_that("metadata is returned as expected", { - pdAssessment <- PD_Assess(dfInput, vThreshold = c(-5.1, 5.1), strMethod = "poisson") - expect_equal("PD_Assess()", pdAssessment$strFunctionName) - expect_equal("dfInput", pdAssessment$lParams$dfInput) - expect_equal("-5.1", pdAssessment$lParams$vThreshold[2]) - expect_equal("5.1", pdAssessment$lParams$vThreshold[3]) - expect_equal("PD", pdAssessment$lTags$Assessment) - expect_true("ggplot" %in% class(pdAssessment$chart)) + assessment <- assess_function(dfInput, vThreshold = c(-5.1, 5.1), strMethod = "poisson") + expect_equal("assess_function()", assessment$strFunctionName) + expect_equal("dfInput", assessment$lParams$dfInput) + expect_equal("-5.1", assessment$lParams$vThreshold[2]) + expect_equal("5.1", assessment$lParams$vThreshold[3]) + expect_equal("PD", assessment$lTags$Assessment) + expect_true("ggplot" %in% class(assessment$chart)) }) # incorrect inputs throw errors ------------------------------------------- test_that("incorrect inputs throw errors", { - expect_snapshot_error(PD_Assess(list())) - expect_snapshot_error(PD_Assess("Hi")) - expect_snapshot_error(PD_Assess(dfInput, strLabel = 123)) - expect_snapshot_error(PD_Assess(dfInput, strMethod = "abacus")) - expect_snapshot_error(PD_Assess(dfInput, strMethod = c("wilcoxon", "poisson"))) - expect_snapshot_error(PD_Assess(dfInput, vThreshold = "A")) - expect_snapshot_error(PD_Assess(dfInput, vThreshold = 1)) - expect_snapshot_error(PD_Assess(dfInput %>% select(-SubjectID))) - expect_snapshot_error(PD_Assess(dfInput %>% select(-SiteID))) - expect_snapshot_error(PD_Assess(dfInput %>% select(-Count))) - expect_snapshot_error(PD_Assess(dfInput %>% select(-Exposure))) - expect_snapshot_error(PD_Assess(dfInput %>% select(-Rate))) - expect_error(PD_Assess(dfInput, strKRILabel = c("label 1", "label 2"))) + expect_snapshot_error(assess_function(list())) + expect_snapshot_error(assess_function("Hi")) + expect_snapshot_error(assess_function(dfInput, strLabel = 123)) + expect_snapshot_error(assess_function(dfInput, strMethod = "abacus")) + expect_snapshot_error(assess_function(dfInput, strMethod = c("wilcoxon", "poisson"))) + expect_snapshot_error(assess_function(dfInput, vThreshold = "A")) + expect_snapshot_error(assess_function(dfInput, vThreshold = 1)) + expect_snapshot_error(assess_function(dfInput %>% select(-SubjectID))) + expect_snapshot_error(assess_function(dfInput %>% select(-SiteID))) + expect_snapshot_error(assess_function(dfInput %>% select(-Count))) + expect_snapshot_error(assess_function(dfInput %>% select(-Exposure))) + expect_snapshot_error(assess_function(dfInput %>% select(-Rate))) + expect_error(assess_function(dfInput, strKRILabel = c("label 1", "label 2"))) }) # incorrect lTags throw errors -------------------------------------------- test_that("incorrect lTags throw errors", { - expect_error(PD_Assess(dfInput, vThreshold = c(-5.1, 5.1), lTags = "hi mom")) - expect_error(PD_Assess(dfInput, vThreshold = c(-5.1, 5.1), lTags = list("hi", "mom"))) - expect_error(PD_Assess(dfInput, vThreshold = c(-5.1, 5.1), lTags = list(greeting = "hi", "mom"))) + expect_error(assess_function(dfInput, vThreshold = c(-5.1, 5.1), lTags = "hi mom")) + expect_error(assess_function(dfInput, vThreshold = c(-5.1, 5.1), lTags = list("hi", "mom"))) + expect_error(assess_function(dfInput, vThreshold = c(-5.1, 5.1), lTags = list(greeting = "hi", "mom"))) expect_silent( - PD_Assess( + assess_function( dfInput, vThreshold = c(-5.1, 5.1), lTags = list( @@ -63,27 +63,27 @@ test_that("incorrect lTags throw errors", { ) ) ) - expect_error(PD_Assess(dfInput, lTags = list(SiteID = ""))) - expect_error(PD_Assess(dfInput, lTags = list(N = ""))) - expect_error(PD_Assess(dfInput, lTags = list(Score = ""))) - expect_error(PD_Assess(dfInput, lTags = list(Flag = ""))) + expect_error(assess_function(dfInput, lTags = list(SiteID = ""))) + expect_error(assess_function(dfInput, lTags = list(N = ""))) + expect_error(assess_function(dfInput, lTags = list(Score = ""))) + expect_error(assess_function(dfInput, lTags = list(Flag = ""))) }) # custom tests ------------------------------------------------------------ test_that("strMethod = 'wilcoxon' does not throw error", { - expect_error(PD_Assess(dfInput, strMethod = "wilcoxon"), NA) + expect_error(assess_function(dfInput, strMethod = "wilcoxon"), NA) }) -test_that("NA in dfInput$Count results in Error for PD_Assess", { - pdInputNA <- dfInput - pdInputNA[1, "Count"] <- NA - expect_snapshot(PD_Assess(pdInputNA)) +test_that("NA in dfInput$Count results in Error for assess_function", { + dfInputNA <- dfInput + dfInputNA[1, "Count"] <- NA + expect_snapshot(assess_function(dfInputNA)) }) test_that("dfAnalyzed has appropriate model output regardless of statistical method", { - assessmentPoisson <- PD_Assess(dfInput, strMethod = "poisson") + assessmentPoisson <- assess_function(dfInput, strMethod = "poisson") expect_true(all(c("KRI", "KRILabel", "Score", "ScoreLabel") %in% names(assessmentPoisson$dfAnalyzed))) - assessmentWilcoxon <- PD_Assess(dfInput, strMethod = "wilcoxon") + assessmentWilcoxon <- assess_function(dfInput, strMethod = "wilcoxon") expect_true(all(c("KRI", "KRILabel", "Score", "ScoreLabel") %in% names(assessmentWilcoxon$dfAnalyzed))) expect_equal(unique(assessmentPoisson$dfAnalyzed$ScoreLabel), "Residuals") @@ -98,6 +98,6 @@ test_that("bQuiet and bReturnChecks work as intended", { }) test_that("strKRILabel works as intended", { - pd <- PD_Assess(dfInput, strKRILabel = "my test label") - expect_equal(unique(pd$dfSummary$KRILabel), "my test label") + assessment <- assess_function(dfInput, strKRILabel = "my test label") + expect_equal(unique(assessment$dfSummary$KRILabel), "my test label") }) diff --git a/tests/testthat/test_PD_Map_Raw.R b/tests/testthat/test_PD_Map_Raw.R index dda2696f5..67bab3d5b 100644 --- a/tests/testthat/test_PD_Map_Raw.R +++ b/tests/testthat/test_PD_Map_Raw.R @@ -13,6 +13,14 @@ input_mapping <- yaml::read_yaml(system.file('mappings', 'PD_Map_Raw.yaml', pack output_spec <- yaml::read_yaml(system.file('specs', 'PD_Assess.yaml', package = 'gsm')) output_mapping <- yaml::read_yaml(system.file('mappings', 'PD_Assess.yaml', package = 'gsm')) +test_that('metadata have not changed', { + expect_snapshot_value(input_spec, 'json2') + expect_snapshot_value(input_mapping, 'json2') + + expect_snapshot_value(output_spec, 'json2') + expect_snapshot_value(output_mapping, 'json2') +}) + test_that("valid output is returned", { test_valid_output( map_function, diff --git a/tests/testthat/test_util_is_mapping_valid.R b/tests/testthat/test_util_is_mapping_valid.R index bc353a85f..b154a5a09 100644 --- a/tests/testthat/test_util_is_mapping_valid.R +++ b/tests/testthat/test_util_is_mapping_valid.R @@ -53,7 +53,7 @@ test_that("NA values are ignored when specified in vNACols", { test_that("vUniqueCols are caught", { dfSUBJ <- bind_rows(dfSUBJ[1, ], dfSUBJ) - expect_message( + expect_snapshot( is_mapping_valid( dfSUBJ, mapping = mapping_rdsl, @@ -61,7 +61,7 @@ test_that("vUniqueCols are caught", { vUniqueCols = "strIDCol", vRequired = c("strIDCol") ), - bQuiet = F + bQuiet = FALSE ) ) }) @@ -89,5 +89,12 @@ test_that("status is FALSE when spec is incorrect", { test_that("bQuiet works as intended", { - expect_message(is_mapping_valid(df = dfSUBJ, mapping = mapping_rdsl, bQuiet = FALSE, spec = list(vRequired = "notACol"))) + expect_snapshot( + result <- is_mapping_valid( + df = dfSUBJ, + mapping = mapping_rdsl, + bQuiet = FALSE, + spec = list(vRequired = "notACol") + ) + ) }) From 2c4a448c406e0206282df36a6d34b8cb5ca4ff27 Mon Sep 17 00:00:00 2001 From: Spencer Childress Date: Thu, 16 Jun 2022 17:52:37 -0400 Subject: [PATCH 84/87] prepare release; `pkgdown::build_site()` failed --- DESCRIPTION | 2 +- NEWS.md | 6 + R/AE_Map_Adam.R | 5 +- R/Analyze_Identity.R | 13 +- R/Analyze_Poisson.R | 2 +- R/Analyze_Wilcoxon.R | 2 +- R/Study_AssessmentReport.R | 69 +++--- R/Summarize.R | 3 +- R/Transform_EventCount.R | 14 +- R/tests-map_raw_helpers.R | 218 +++++++++---------- R/util-RunAssessment.R | 2 +- R/util-generate_md_table.R | 7 +- README.md | 9 +- inst/WORDLIST | 87 ++++++++ tests/testthat/helper-qualification.R | 6 +- tests/testthat/test_AE_Assess.R | 6 +- tests/testthat/test_AE_Map_Raw.R | 88 ++++---- tests/testthat/test_Analyze_Chisq.R | 12 +- tests/testthat/test_Analyze_Poisson.R | 6 +- tests/testthat/test_Analyze_Wilcoxon.R | 6 +- tests/testthat/test_Consent_Assess.R | 6 +- tests/testthat/test_Consent_Map_Raw.R | 88 ++++---- tests/testthat/test_IE_Assess.R | 6 +- tests/testthat/test_IE_Map_Raw.R | 88 ++++---- tests/testthat/test_PD_Assess.R | 6 +- tests/testthat/test_PD_Map_Raw.R | 88 ++++---- tests/testthat/test_Study_Assess.R | 3 +- tests/testthat/test_Study_AssessmentReport.R | 18 +- tests/testthat/test_Study_Table.R | 4 +- tests/testthat/test_Summarize.R | 32 +-- tests/testthat/test_Transform_EventCount.R | 43 ++-- tests/testthat/test_qual_T3_1.R | 4 +- tests/testthat/test_qual_T3_2.R | 2 +- tests/testthat/test_qual_T4_1.R | 2 +- tests/testthat/test_qual_T4_2.R | 2 +- tests/testthat/test_util-runAssessment.R | 2 - 36 files changed, 529 insertions(+), 428 deletions(-) create mode 100644 inst/WORDLIST diff --git a/DESCRIPTION b/DESCRIPTION index 905a007f6..474d93b60 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: gsm Title: Gilead Statistical Monitoring -Version: 1.0.0 +Version: 1.0.1 Authors@R: c( person("George", "Wu", email="george.wu@gilead.com", role = c("aut", "cre")), person("Jeremy", "Wildfire", email="jwildfire@gmail.com", role = c("aut")), diff --git a/NEWS.md b/NEWS.md index 0b1af122b..df74d3476 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,9 @@ +# gsm v1.0.1 + +This release explicitly captures the KRI of interest as part of the data model, standardizing the +input to and output from the analysis functions. View a full list of resolved issues +[here](https://github.com/Gilead-BioStats/gsm/issues?q=is%3Aissue+milestone%3Av1.0.1+is%3Aclosed). + # gsm v1.0.0 This release includes qualified functionality for Adverse Event and Protocol Deviation Assessments. diff --git a/R/AE_Map_Adam.R b/R/AE_Map_Adam.R index 7f123b49d..c9c988623 100644 --- a/R/AE_Map_Adam.R +++ b/R/AE_Map_Adam.R @@ -53,8 +53,9 @@ AE_Map_Adam <- function( mapping = lMapping ) - if (is.null(lMapping)) - lMapping <- checks$mapping + if (is.null(lMapping)) { + lMapping <- checks$mapping + } # Run mapping if checks passed. if (checks$status) { diff --git a/R/Analyze_Identity.R b/R/Analyze_Identity.R index 441a4965d..c3c47d29a 100644 --- a/R/Analyze_Identity.R +++ b/R/Analyze_Identity.R @@ -16,8 +16,7 @@ #' #' @export -Analyze_Identity <- function(dfTransformed, strValueCol = 'KRI', strLabelCol = "KRILabel", bQuiet = TRUE){ - +Analyze_Identity <- function(dfTransformed, strValueCol = "KRI", strLabelCol = "KRILabel", bQuiet = TRUE) { stopifnot( "dfTransformed is not a data.frame" = is.data.frame(dfTransformed), "strValueCol and/or strLabelCol not found in dfTransformed" = all(c(strValueCol, strLabelCol) %in% names(dfTransformed)), @@ -26,11 +25,13 @@ Analyze_Identity <- function(dfTransformed, strValueCol = 'KRI', strLabelCol = " ) dfAnalyzed <- dfTransformed %>% - mutate(Score = .data[[strValueCol]], - ScoreLabel = .data[[strLabelCol]]) + mutate( + Score = .data[[strValueCol]], + ScoreLabel = .data[[strLabelCol]] + ) - if(!bQuiet) cli::cli_text(paste0("{.var Score} column created from `", strValueCol, "`.")) - if(!bQuiet) cli::cli_text(paste0("{.var ScoreLabel} column created from `", strLabelCol, "`.")) + if (!bQuiet) cli::cli_text(paste0("{.var Score} column created from `", strValueCol, "`.")) + if (!bQuiet) cli::cli_text(paste0("{.var ScoreLabel} column created from `", strLabelCol, "`.")) return(dfAnalyzed) } diff --git a/R/Analyze_Poisson.R b/R/Analyze_Poisson.R index a5df0f394..d2ef765e6 100644 --- a/R/Analyze_Poisson.R +++ b/R/Analyze_Poisson.R @@ -74,7 +74,7 @@ Analyze_Poisson <- function(dfTransformed, bQuiet = TRUE) { Score = .data$.resid, .data$ScoreLabel, PredictedCount = .data$.fitted - ) %>% + ) %>% arrange(.data$Score) return(dfAnalyzed) diff --git a/R/Analyze_Wilcoxon.R b/R/Analyze_Wilcoxon.R index bdd9fba29..12e42abbe 100644 --- a/R/Analyze_Wilcoxon.R +++ b/R/Analyze_Wilcoxon.R @@ -131,6 +131,6 @@ Analyze_Wilcoxon <- function( select(names(dfTransformed), .data$Estimate, Score = .data$PValue) %>% mutate( ScoreLabel = "P value" - ) + ) ) } diff --git a/R/Study_AssessmentReport.R b/R/Study_AssessmentReport.R index ff2afe653..6c53c4dbd 100644 --- a/R/Study_AssessmentReport.R +++ b/R/Study_AssessmentReport.R @@ -21,49 +21,46 @@ #' @export Study_AssessmentReport <- function(lAssessments, bViewReport = FALSE) { - allChecks <- map(names(lAssessments), function(assessment) { + workflow <- lAssessments[[assessment]][["workflow"]] %>% + map_df( + ~ bind_cols(step = .x[["name"]], domain = .x[["inputs"]]) + ) %>% + mutate( + assessment = assessment, + index = as.character(row_number()) + ) - workflow <- lAssessments[[assessment]][['workflow']] %>% - map_df( - ~bind_cols(step = .x[['name']], domain = .x[['inputs']]) - ) %>% - mutate( - assessment = assessment, - index = as.character(row_number()) - ) - - allChecks <- map(lAssessments[[assessment]][['checks']], function(step) { - domains <- names(step[!names(step) %in% c('status', 'mapping')]) - - map(domains, function(domain) { - status <- step[[domain]][['status']] - step[[domain]][['tests_if']] %>% - bind_rows(.id = "names") %>% - mutate(status = ifelse(is.na(.data$warning), NA_character_, .data$warning)) %>% - select(-.data$warning) %>% - t() %>% - as_tibble(.name_repair = "minimal") %>% - janitor::row_to_names(1) %>% - mutate(domain = domain, - status = status) %>% - select(.data$domain, everything()) - }) + allChecks <- map(lAssessments[[assessment]][["checks"]], function(step) { + domains <- names(step[!names(step) %in% c("status", "mapping")]) - }) %>% - bind_rows(.id = 'index') + map(domains, function(domain) { + status <- step[[domain]][["status"]] + step[[domain]][["tests_if"]] %>% + bind_rows(.id = "names") %>% + mutate(status = ifelse(is.na(.data$warning), NA_character_, .data$warning)) %>% + select(-.data$warning) %>% + t() %>% + as_tibble(.name_repair = "minimal") %>% + janitor::row_to_names(1) %>% + mutate( + domain = domain, + status = status + ) %>% + select(.data$domain, everything()) + }) + }) %>% + bind_rows(.id = "index") left_join(workflow, allChecks, by = c("index", "domain")) - - }) %>% bind_rows() %>% - select(.data$assessment, .data$step, check = .data$status, .data$domain, everything(),-.data$index) %>% + select(.data$assessment, .data$step, check = .data$status, .data$domain, everything(), -.data$index) %>% suppressWarnings() found_data <- map(names(lAssessments), ~ lAssessments[[.x]][["lData"]]) %>% flatten() %>% - discard(~'logical' %in% class(.)) %>% + discard(~ "logical" %in% class(.)) %>% names() %>% unique() @@ -85,9 +82,11 @@ Study_AssessmentReport <- function(lAssessments, bViewReport = FALSE) { apply(allChecks[6:length(allChecks)], 1, function(x) paste(x[!is.na(x)], collapse = "
")), .data$notes ), - check = case_when(.data$check == TRUE ~ 1, - .data$check == FALSE ~ 2, - is.na(.data$check) ~ 3), + check = case_when( + .data$check == TRUE ~ 1, + .data$check == FALSE ~ 2, + is.na(.data$check) ~ 3 + ), notes = ifelse(.data$check == 3, "Check not run.", .data$notes) ) diff --git a/R/Summarize.R b/R/Summarize.R index c12c2c780..25c93a9b9 100644 --- a/R/Summarize.R +++ b/R/Summarize.R @@ -32,7 +32,6 @@ #' @export Summarize <- function(dfFlagged, strScoreCol = "Score", lTags = NULL) { - stopifnot( "dfFlagged is not a data frame" = is.data.frame(dfFlagged), "One or more of these columns: SiteID, N, Flag , strScoreCol, not found in dfFlagged" = all(c("SiteID", "N", "Flag", strScoreCol) %in% names(dfFlagged)) @@ -54,7 +53,7 @@ Summarize <- function(dfFlagged, strScoreCol = "Score", lTags = NULL) { .data$Score, .data$ScoreLabel, .data$Flag - ) %>% + ) %>% arrange(desc(abs(.data$KRI))) %>% arrange(match(.data$Flag, c(1, -1, 0))) %>% bind_cols(lTags[!names(lTags) %in% names(.data)]) diff --git a/R/Transform_EventCount.R b/R/Transform_EventCount.R index 1f19117af..7242c7255 100644 --- a/R/Transform_EventCount.R +++ b/R/Transform_EventCount.R @@ -41,10 +41,10 @@ #' @export Transform_EventCount <- function( - dfInput, - strCountCol, - strExposureCol = NULL, - strKRILabel = "[Not Specified]" + dfInput, + strCountCol, + strExposureCol = NULL, + strKRILabel = "[Not Specified]" ) { stopifnot( "dfInput is not a data frame" = is.data.frame(dfInput), @@ -65,14 +65,14 @@ Transform_EventCount <- function( } } - if(!is.null(strKRILabel)) { - + if (!is.null(strKRILabel)) { stopifnot( "strKRILabel must be length 1" = length(strKRILabel) <= 1 ) - if(strKRILabel %in% names(dfInput)) + if (strKRILabel %in% names(dfInput)) { stop(paste0("strKRILabel cannot be named with the following names: ", paste(names(dfInput), collapse = ", "))) + } } if (is.null(strExposureCol)) { diff --git a/R/tests-map_raw_helpers.R b/R/tests-map_raw_helpers.R index dc33f2eed..ef03cd3af 100644 --- a/R/tests-map_raw_helpers.R +++ b/R/tests-map_raw_helpers.R @@ -1,135 +1,135 @@ test_valid_output <- function( - map_function, - dfs, - spec, - mapping + map_function, + dfs, + spec, + mapping ) { - output <- map_function(dfs = dfs) + output <- map_function(dfs = dfs) - expect_true(is.data.frame(output)) - expect_equal(names(output), as.character(mapping$dfInput)) - expect_type(output$SubjectID, "character") - expect_type(output$SiteID, "character") - expect_true(class(output$Count) %in% c("double", "integer", "numeric")) + expect_true(is.data.frame(output)) + expect_equal(names(output), as.character(mapping$dfInput)) + expect_type(output$SubjectID, "character") + expect_type(output$SiteID, "character") + expect_true(class(output$Count) %in% c("double", "integer", "numeric")) } test_invalid_data <- function( - map_function, - dfs, - spec, - mapping + map_function, + dfs, + spec, + mapping ) { - map_domain <- names(dfs)[ - names(dfs) != 'dfSUBJ' - ] - - # empty data frames - expect_snapshot(map_function(dfs = purrr::imap(dfs, ~ list()), bQuiet = FALSE)) - expect_snapshot(map_function(dfs = purrr::imap(dfs, ~ if (.y == 'dfSUBJ') list() else .x), bQuiet = FALSE)) - expect_snapshot(map_function(dfs = purrr::imap(dfs, ~ if (.y == map_domain) list() else .x), bQuiet = FALSE)) - - # mistyped data frames - expect_snapshot(map_function(dfs = purrr::imap(dfs, ~ 'Hi Mom'), bQuiet = FALSE)) - expect_snapshot(map_function(dfs = purrr::imap(dfs, ~ 9999), bQuiet = FALSE)) - expect_snapshot(map_function(dfs = purrr::imap(dfs, ~ TRUE), bQuiet = FALSE)) - - # empty mapping - expect_snapshot(map_function(dfs = purrr::imap(dfs, ~ .x), lMapping = list(), bQuiet = FALSE)) - - # duplicate subject IDs in subject-level data frame - dfs_edited <- dfs - dfs_edited$dfSUBJ <- dfs_edited$dfSUBJ %>% bind_rows(head(., 1)) - expect_snapshot(map_function(dfs = dfs_edited, bQuiet = FALSE)) + map_domain <- names(dfs)[ + names(dfs) != "dfSUBJ" + ] + + # empty data frames + expect_snapshot(map_function(dfs = purrr::imap(dfs, ~ list()), bQuiet = FALSE)) + expect_snapshot(map_function(dfs = purrr::imap(dfs, ~ if (.y == "dfSUBJ") list() else .x), bQuiet = FALSE)) + expect_snapshot(map_function(dfs = purrr::imap(dfs, ~ if (.y == map_domain) list() else .x), bQuiet = FALSE)) + + # mistyped data frames + expect_snapshot(map_function(dfs = purrr::imap(dfs, ~"Hi Mom"), bQuiet = FALSE)) + expect_snapshot(map_function(dfs = purrr::imap(dfs, ~9999), bQuiet = FALSE)) + expect_snapshot(map_function(dfs = purrr::imap(dfs, ~TRUE), bQuiet = FALSE)) + + # empty mapping + expect_snapshot(map_function(dfs = purrr::imap(dfs, ~.x), lMapping = list(), bQuiet = FALSE)) + + # duplicate subject IDs in subject-level data frame + dfs_edited <- dfs + dfs_edited$dfSUBJ <- dfs_edited$dfSUBJ %>% bind_rows(head(., 1)) + expect_snapshot(map_function(dfs = dfs_edited, bQuiet = FALSE)) } test_missing_column <- function(map_function, dfs, spec, mapping) { - # for each domain in spec - for (domain in names(spec)) { - column_keys <- spec[[ domain ]]$vRequired - - # for each required column in domain - for (column_key in column_keys) { - dfs_edited <- dfs - - # retrieve column name from mapping - column <- mapping[[ domain ]][[ column_key ]] - - # set column to NULL - dfs_edited[[ domain ]][[ column ]] <- NULL - - expect_snapshot( - map_function( - dfs = dfs_edited, - bQuiet = FALSE - ) - ) - } - } -} + # for each domain in spec + for (domain in names(spec)) { + column_keys <- spec[[domain]]$vRequired -test_missing_value <- function(map_function, dfs, spec, mapping) { - # for each domain in spec - for (domain in names(spec)) { - df <- dfs[[ domain ]] - column_keys <- setdiff( - spec[[ domain ]]$vRequired, - spec[[ domain ]]$vNACols - ) + # for each required column in domain + for (column_key in column_keys) { + dfs_edited <- dfs - # for each required column in domain - for (column_key in column_keys) { - dfs_edited <- dfs + # retrieve column name from mapping + column <- mapping[[domain]][[column_key]] - # retrieve column name from mapping - column <- mapping[[ domain ]][[ column_key ]] + # set column to NULL + dfs_edited[[domain]][[column]] <- NULL - # set a random value to NA - dfs_edited[[ domain ]][ sample(1:nrow(df), 1), column ] <- NA + expect_snapshot( + map_function( + dfs = dfs_edited, + bQuiet = FALSE + ) + ) + } + } +} - expect_snapshot( - map_function( - dfs = dfs_edited, - bQuiet = FALSE - ) - ) - } +test_missing_value <- function(map_function, dfs, spec, mapping) { + # for each domain in spec + for (domain in names(spec)) { + df <- dfs[[domain]] + column_keys <- setdiff( + spec[[domain]]$vRequired, + spec[[domain]]$vNACols + ) + + # for each required column in domain + for (column_key in column_keys) { + dfs_edited <- dfs + + # retrieve column name from mapping + column <- mapping[[domain]][[column_key]] + + # set a random value to NA + dfs_edited[[domain]][sample(1:nrow(df), 1), column] <- NA + + expect_snapshot( + map_function( + dfs = dfs_edited, + bQuiet = FALSE + ) + ) } + } } test_duplicate_subject_id <- function(map_function, dfs) { - dfs_edited <- dfs - dfs_edited$dfSUBJ$SubjectID <- "1" + dfs_edited <- dfs + dfs_edited$dfSUBJ$SubjectID <- "1" - expect_snapshot(map_function(dfs = dfs_edited, bQuiet = FALSE)) + expect_snapshot(map_function(dfs = dfs_edited, bQuiet = FALSE)) } test_invalid_mapping <- function(map_function, dfs, spec, mapping) { - # Subset mapping on columns required in spec. - mapping_required <- mapping %>% - purrr::imap(function(columns, domain_key) { # loop over domains - domain_spec <- spec[[ domain_key ]]$vRequired - - columns[ - names(columns) %in% domain_spec - ] - }) - - # Run assertion for each domain-column combination in mapping. - mapping_required %>% - purrr::iwalk(function(columns, domain_key) { # loop over domains - purrr::iwalk(columns, function(column_value, column_key) { # loop over columns in domain - mapping_edited <- mapping_required - mapping_edited[[ domain_key ]][[ column_key ]] <- 'asdf' - - expect_snapshot( - map_function( - dfs = dfs, - lMapping = mapping_edited, - bQuiet = FALSE - ) - ) - }) - }) + # Subset mapping on columns required in spec. + mapping_required <- mapping %>% + purrr::imap(function(columns, domain_key) { # loop over domains + domain_spec <- spec[[domain_key]]$vRequired + + columns[ + names(columns) %in% domain_spec + ] + }) + + # Run assertion for each domain-column combination in mapping. + mapping_required %>% + purrr::iwalk(function(columns, domain_key) { # loop over domains + purrr::iwalk(columns, function(column_value, column_key) { # loop over columns in domain + mapping_edited <- mapping_required + mapping_edited[[domain_key]][[column_key]] <- "asdf" + + expect_snapshot( + map_function( + dfs = dfs, + lMapping = mapping_edited, + bQuiet = FALSE + ) + ) + }) + }) } test_logical_parameters <- function(map_function, dfs) { diff --git a/R/util-RunAssessment.R b/R/util-RunAssessment.R index c1cf910f9..380b69702 100644 --- a/R/util-RunAssessment.R +++ b/R/util-RunAssessment.R @@ -40,7 +40,7 @@ RunAssessment <- function(lAssessment, lData, lMapping, lTags = NULL, bQuiet = F lAssessment$lChecks <- list() lAssessment$bStatus <- TRUE - if(exists("workflow", where = lAssessment)) { + if (exists("workflow", where = lAssessment)) { # Run through each step in lAssessment$workflow stepCount <- 1 for (step in lAssessment$workflow) { diff --git a/R/util-generate_md_table.R b/R/util-generate_md_table.R index 51e0eb4d3..540a7cbef 100644 --- a/R/util-generate_md_table.R +++ b/R/util-generate_md_table.R @@ -91,7 +91,7 @@ generate_md_table <- function( # Reformat data frame as HTML table. knitr.kable.NA <- options(knitr.kable.NA = "") on.exit(knitr.kable.NA) - col_name_dict = c( + col_name_dict <- c( domain = "Domain", col_key = "Column Key", col_value = "Default Value", @@ -102,8 +102,9 @@ generate_md_table <- function( col_name_dict_bold <- paste0("**", col_name_dict, "**") names(col_name_dict_bold) <- names(col_name_dict) # paste won't keep names md <- knitr::kable(table, - format = "markdown", - col.names = col_name_dict_bold[names(table)]) %>% + format = "markdown", + col.names = col_name_dict_bold[names(table)] + ) %>% paste(collapse = "\n") # Append markdown header to HTML table. diff --git a/README.md b/README.md index 5ca053851..411ec6e0d 100644 --- a/README.md +++ b/README.md @@ -6,11 +6,11 @@ # Gilead Statistical Monitoring {gsm} R package -The {gsm} package provides a standardized workflow that leverages Key Risk Indicators (KRIs) and thresholds to conduct study-level Risk Based Monitoring (RBM) for clinical trials. This readme provides a high-level overview of {gsm}, see the [package website](silver-potato-cfe8c2fb.pages.github.io/) for additional details. +The {gsm} package provides a standardized workflow that leverages Key Risk Indicators (KRIs) and thresholds to conduct study-level Risk Based Monitoring (RBM) for clinical trials. This README provides a high-level overview of {gsm}; see the [package website](silver-potato-cfe8c2fb.pages.github.io/) for additional details. # Background -The {gsm} package performs risk assessments primarily focused on detecting differences in quality at the site-level. "High quality" is defined as absence of errors that matter. We interpret this as focusing on detecting potential issues related to critical data or process across the major risk categories of safety, efficacy, disposition, treatment, and general quality, where each category consists of one or more risk assessment(s). Each risk assessment will analyze the data to flag sites with potential issues and provide a visualization to help the user understand the issue. Some relevant references are provided below. +The {gsm} package performs risk assessments primarily focused on detecting differences in quality at the site-level. "High quality" is defined as the absence of errors that matter. We interpret this as focusing on detecting potential issues related to critical data or process across the major risk categories of safety, efficacy, disposition, treatment, and general quality, where each category consists of one or more risk assessment(s). Each risk assessment will analyze the data to flag sites with potential issues and provide a visualization to help the user understand the issue. Some relevant references are provided below. - Centralized Statistical Monitoring: [1](https://documents.pub/reader/full/centralized-statistical-monitoring-to-detect-data-integrity-issues-statisticalcentralized), [2](https://www.ncbi.nlm.nih.gov/pmc/articles/PMC7308734/), [3](https://www.magiworld.org/Journal/2014/1411_Centralized.pdf) - EMA/FDA Guidance on Risk Based Management: [1](https://www.fda.gov/media/121479/download), [2](https://www.fda.gov/media/116754/download), [3](https://www.fda.gov/media/129527/download), [4](https://www.ema.europa.eu/en/documents/scientific-guideline/reflection-paper-risk-based-quality-management-clinical-trials_en.pdf) @@ -35,12 +35,11 @@ All {gsm} assessments use a standardized 6 step data pipeline: 5. **Flag** - Uses `analyzed` data and numeric `thresholds` to create `flagged` data. 6. **Summarize** - Selects key columns from `flagged` data to create `summary` data. -To learn more about {gsm}'s data pipeline, visit the [Data Pipeline Vignette](https://github.com/Gilead-BioStats/gsm/wiki/Data-Pipeline-Vignette). - +To learn more about {gsm}'s data pipeline, visit the [Data Pipeline Vignette](https://silver-potato-cfe8c2fb.pages.github.io/articles/DataPipeline.html). # Quality Control -Since {gsm} is designed for use in a GCP framework, we have conducted extensive quality control as part of our development process. In particular, we do the following: +Since {gsm} is designed for use in a [GCP](https://en.wikipedia.org/wiki/Good_clinical_practice) framework, we have conducted extensive quality control as part of our development process. In particular, we do the following: - **Qualification Workflow** - All assessments have been Qualified as described in the Qualification Workflow Vignette. A Qualification Report Vignette is generated and attached to each release. - **Unit Tests** - Unit tests are written for all core functions. diff --git a/inst/WORDLIST b/inst/WORDLIST new file mode 100644 index 000000000..cc4652b91 --- /dev/null +++ b/inst/WORDLIST @@ -0,0 +1,87 @@ +ADSL +ADaM +AE +AEs +Bugfix +CMD +EMA +EventCount +GCP +IDEs +KRI +KRILabel +KRIs +NaN +PDs +PRs +PredictedCount +RBM +README +RandDate +Roxygen +SDTM +SITEID +SUBJID +ScoreLabel +SiteID +SubjectID +TRTEDT +TRTSDT +ThresholdCol +ThresholdHigh +ThresholdLow +TimeOnStudy +TimeOnTreatment +TotalCount +TotalExposure +USUBJID +YAML +clindata +customizations +dev +devtools +df +dfADAE +dfADSL +dfAE +dfCONSENT +dfFlagged +dfIE +dfInput +dfPD +dfSUBJ +dfSummary +dfTransformed +directionality +fontawesome +lParams +lTags +md +mergeSubjects +pkgdown +reprex +roxygen +safetyData +strCategoryCol +strCol +strColumn +strCountCol +strDateCol +strEndCol +strExposureCol +strFunctionName +strIDCol +strRandDateCol +strRateCol +strSiteCol +strStartCol +strTimeOnStudyCol +strTimeOnTreatmentCol +strTypeCol +strValueCol +strValueColumn +styler +testthat +tidyverse +vThreshold +valtools diff --git a/tests/testthat/helper-qualification.R b/tests/testthat/helper-qualification.R index cea3e4575..652bbf77b 100644 --- a/tests/testthat/helper-qualification.R +++ b/tests/testthat/helper-qualification.R @@ -1,7 +1,7 @@ qualification_transform_counts <- function(dfInput, - countCol = "Count", - exposureCol = "Exposure", - KRILabel = "") { + countCol = "Count", + exposureCol = "Exposure", + KRILabel = "") { if (is.na(exposureCol)) { dfTransformed <- dfInput %>% filter(!is.na(.data[[countCol]])) %>% diff --git a/tests/testthat/test_AE_Assess.R b/tests/testthat/test_AE_Assess.R index 3c9ee5b06..ee1d8bc56 100644 --- a/tests/testthat/test_AE_Assess.R +++ b/tests/testthat/test_AE_Assess.R @@ -2,8 +2,8 @@ source(testthat::test_path("testdata/data.R")) assess_function <- gsm::AE_Assess dfInput <- AE_Map_Raw(dfs = list(dfAE = dfAE, dfSUBJ = dfSUBJ)) -output_spec <- yaml::read_yaml(system.file('specs', 'AE_Assess.yaml', package = 'gsm')) -output_mapping <- yaml::read_yaml(system.file('mappings', 'AE_Assess.yaml', package = 'gsm')) +output_spec <- yaml::read_yaml(system.file("specs", "AE_Assess.yaml", package = "gsm")) +output_mapping <- yaml::read_yaml(system.file("mappings", "AE_Assess.yaml", package = "gsm")) # output is created as expected ------------------------------------------- test_that("output is created as expected", { @@ -94,7 +94,7 @@ test_that("dfAnalyzed has appropriate model output regardless of statistical met }) test_that("bQuiet and bReturnChecks work as intended", { - test_logical_assess_parameters(assess_function, dfInput) + test_logical_assess_parameters(assess_function, dfInput) }) test_that("strKRILabel works as intended", { diff --git a/tests/testthat/test_AE_Map_Raw.R b/tests/testthat/test_AE_Map_Raw.R index d6cbdcf7b..0b49f445f 100644 --- a/tests/testthat/test_AE_Map_Raw.R +++ b/tests/testthat/test_AE_Map_Raw.R @@ -3,73 +3,73 @@ source(testthat::test_path("testdata/data.R")) map_function <- gsm::AE_Map_Raw dfs <- list( - dfAE = dfAE, - dfSUBJ = dfSUBJ + dfAE = dfAE, + dfSUBJ = dfSUBJ ) -input_spec <- yaml::read_yaml(system.file('specs', 'AE_Map_Raw.yaml', package = 'gsm')) -input_mapping <- yaml::read_yaml(system.file('mappings', 'AE_Map_Raw.yaml', package = 'gsm')) +input_spec <- yaml::read_yaml(system.file("specs", "AE_Map_Raw.yaml", package = "gsm")) +input_mapping <- yaml::read_yaml(system.file("mappings", "AE_Map_Raw.yaml", package = "gsm")) -output_spec <- yaml::read_yaml(system.file('specs', 'AE_Assess.yaml', package = 'gsm')) -output_mapping <- yaml::read_yaml(system.file('mappings', 'AE_Assess.yaml', package = 'gsm')) +output_spec <- yaml::read_yaml(system.file("specs", "AE_Assess.yaml", package = "gsm")) +output_mapping <- yaml::read_yaml(system.file("mappings", "AE_Assess.yaml", package = "gsm")) -test_that('metadata have not changed', { - expect_snapshot_value(input_spec, 'json2') - expect_snapshot_value(input_mapping, 'json2') +test_that("metadata have not changed", { + expect_snapshot_value(input_spec, "json2") + expect_snapshot_value(input_mapping, "json2") - expect_snapshot_value(output_spec, 'json2') - expect_snapshot_value(output_mapping, 'json2') + expect_snapshot_value(output_spec, "json2") + expect_snapshot_value(output_mapping, "json2") }) test_that("valid output is returned", { - test_valid_output( - map_function, - dfs, - output_spec, - output_mapping - ) + test_valid_output( + map_function, + dfs, + output_spec, + output_mapping + ) }) test_that("invalid data throw errors", { - test_invalid_data( - map_function, - dfs, - input_spec, - input_mapping - ) + test_invalid_data( + map_function, + dfs, + input_spec, + input_mapping + ) }) test_that("missing column throws errors", { - test_missing_column( - map_function, - dfs, - input_spec, - input_mapping - ) + test_missing_column( + map_function, + dfs, + input_spec, + input_mapping + ) }) test_that("missing value throws errors", { - test_missing_value( - map_function, - dfs, - input_spec, - input_mapping - ) + test_missing_value( + map_function, + dfs, + input_spec, + input_mapping + ) }) -test_that('duplicate subject ID is detected', { - test_duplicate_subject_id(map_function, dfs) +test_that("duplicate subject ID is detected", { + test_duplicate_subject_id(map_function, dfs) }) test_that("invalid mapping throws errors", { - test_invalid_mapping( - map_function, - dfs, - input_spec, - input_mapping - ) + test_invalid_mapping( + map_function, + dfs, + input_spec, + input_mapping + ) }) test_that("bQuiet and bReturnChecks work as intended", { - test_logical_parameters(map_function, dfs) + test_logical_parameters(map_function, dfs) }) diff --git a/tests/testthat/test_Analyze_Chisq.R b/tests/testthat/test_Analyze_Chisq.R index 4567134a5..1fcd66309 100644 --- a/tests/testthat/test_Analyze_Chisq.R +++ b/tests/testthat/test_Analyze_Chisq.R @@ -1,15 +1,15 @@ source(testthat::test_path("testdata/data.R")) dfInput <- Disp_Map( - dfDisp, - strCol = "DCREASCD", - strReason = "Adverse Event" + dfDisp, + strCol = "DCREASCD", + strReason = "Adverse Event" ) dfTransformed <- Transform_EventCount( - dfInput, - strCountCol = "Count", - strKRILabel = "Discontinuation Reasons/Site" + dfInput, + strCountCol = "Count", + strKRILabel = "Discontinuation Reasons/Site" ) test_that("output created as expected and has correct structure", { diff --git a/tests/testthat/test_Analyze_Poisson.R b/tests/testthat/test_Analyze_Poisson.R index b7722f966..ba4925c41 100644 --- a/tests/testthat/test_Analyze_Poisson.R +++ b/tests/testthat/test_Analyze_Poisson.R @@ -7,8 +7,10 @@ test_that("output created as expected and has correct structure", { ae_anly <- Analyze_Poisson(ae_prep) expect_true(is.data.frame(ae_anly)) expect_equal(sort(unique(ae_input$SiteID)), sort(ae_anly$SiteID)) - expect_equal(names(ae_anly), c("SiteID", "N", "TotalCount", "TotalExposure", "KRI", "KRILabel", - "Score", "ScoreLabel", "PredictedCount")) + expect_equal(names(ae_anly), c( + "SiteID", "N", "TotalCount", "TotalExposure", "KRI", "KRILabel", + "Score", "ScoreLabel", "PredictedCount" + )) }) test_that("incorrect inputs throw errors", { diff --git a/tests/testthat/test_Analyze_Wilcoxon.R b/tests/testthat/test_Analyze_Wilcoxon.R index f03cb8d73..5f4d84588 100644 --- a/tests/testthat/test_Analyze_Wilcoxon.R +++ b/tests/testthat/test_Analyze_Wilcoxon.R @@ -6,8 +6,10 @@ ae_prep <- Transform_EventCount(ae_input, strCountCol = "Count", strExposureCol test_that("output created as expected and has correct structure", { aew_anly <- Analyze_Wilcoxon(ae_prep) expect_true(is.data.frame(aew_anly)) - expect_true(all(c("SiteID", "N", "TotalCount", "TotalExposure", "KRI", "KRILabel", - "Estimate", "Score", "ScoreLabel") %in% names(aew_anly))) + expect_true(all(c( + "SiteID", "N", "TotalCount", "TotalExposure", "KRI", "KRILabel", + "Estimate", "Score", "ScoreLabel" + ) %in% names(aew_anly))) expect_equal(sort(unique(ae_input$SiteID)), sort(aew_anly$SiteID)) }) diff --git a/tests/testthat/test_Consent_Assess.R b/tests/testthat/test_Consent_Assess.R index 16d6fcd7f..be3cd102c 100644 --- a/tests/testthat/test_Consent_Assess.R +++ b/tests/testthat/test_Consent_Assess.R @@ -2,8 +2,8 @@ source(testthat::test_path("testdata/data.R")) assess_function <- gsm::Consent_Assess dfInput <- Consent_Map_Raw(dfs = list(dfCONSENT = dfCONSENT, dfSUBJ = dfSUBJ)) -output_spec <- yaml::read_yaml(system.file('specs', 'Consent_Assess.yaml', package = 'gsm')) -output_mapping <- yaml::read_yaml(system.file('mappings', 'Consent_Assess.yaml', package = 'gsm')) +output_spec <- yaml::read_yaml(system.file("specs", "Consent_Assess.yaml", package = "gsm")) +output_mapping <- yaml::read_yaml(system.file("mappings", "Consent_Assess.yaml", package = "gsm")) # output is created as expected ------------------------------------------- test_that("output is created as expected", { @@ -65,7 +65,7 @@ test_that("dfAnalyzed has appropriate model output regardless of statistical met }) test_that("bQuiet and bReturnChecks work as intended", { - test_logical_assess_parameters(assess_function, dfInput) + test_logical_assess_parameters(assess_function, dfInput) }) test_that("strKRILabel works as intended", { diff --git a/tests/testthat/test_Consent_Map_Raw.R b/tests/testthat/test_Consent_Map_Raw.R index 423c983c7..292122340 100644 --- a/tests/testthat/test_Consent_Map_Raw.R +++ b/tests/testthat/test_Consent_Map_Raw.R @@ -3,73 +3,73 @@ source(testthat::test_path("testdata/data.R")) map_function <- gsm::Consent_Map_Raw dfs <- list( - dfCONSENT = dfCONSENT, - dfSUBJ = dfSUBJ + dfCONSENT = dfCONSENT, + dfSUBJ = dfSUBJ ) -input_spec <- yaml::read_yaml(system.file('specs', 'Consent_Map_Raw.yaml', package = 'gsm')) -input_mapping <- yaml::read_yaml(system.file('mappings', 'Consent_Map_Raw.yaml', package = 'gsm')) +input_spec <- yaml::read_yaml(system.file("specs", "Consent_Map_Raw.yaml", package = "gsm")) +input_mapping <- yaml::read_yaml(system.file("mappings", "Consent_Map_Raw.yaml", package = "gsm")) -output_spec <- yaml::read_yaml(system.file('specs', 'Consent_Assess.yaml', package = 'gsm')) -output_mapping <- yaml::read_yaml(system.file('mappings', 'Consent_Assess.yaml', package = 'gsm')) +output_spec <- yaml::read_yaml(system.file("specs", "Consent_Assess.yaml", package = "gsm")) +output_mapping <- yaml::read_yaml(system.file("mappings", "Consent_Assess.yaml", package = "gsm")) -test_that('metadata have not changed', { - expect_snapshot_value(input_spec, 'json2') - expect_snapshot_value(input_mapping, 'json2') +test_that("metadata have not changed", { + expect_snapshot_value(input_spec, "json2") + expect_snapshot_value(input_mapping, "json2") - expect_snapshot_value(output_spec, 'json2') - expect_snapshot_value(output_mapping, 'json2') + expect_snapshot_value(output_spec, "json2") + expect_snapshot_value(output_mapping, "json2") }) test_that("valid output is returned", { - test_valid_output( - map_function, - dfs, - output_spec, - output_mapping - ) + test_valid_output( + map_function, + dfs, + output_spec, + output_mapping + ) }) test_that("invalid data throw errors", { - test_invalid_data( - map_function, - dfs, - input_spec, - input_mapping - ) + test_invalid_data( + map_function, + dfs, + input_spec, + input_mapping + ) }) test_that("missing column throws errors", { - test_missing_column( - map_function, - dfs, - input_spec, - input_mapping - ) + test_missing_column( + map_function, + dfs, + input_spec, + input_mapping + ) }) test_that("missing value throws errors", { - test_missing_value( - map_function, - dfs, - input_spec, - input_mapping - ) + test_missing_value( + map_function, + dfs, + input_spec, + input_mapping + ) }) -test_that('duplicate subject ID is detected', { - test_duplicate_subject_id(map_function, dfs) +test_that("duplicate subject ID is detected", { + test_duplicate_subject_id(map_function, dfs) }) test_that("invalid mapping throws errors", { - test_invalid_mapping( - map_function, - dfs, - input_spec, - input_mapping - ) + test_invalid_mapping( + map_function, + dfs, + input_spec, + input_mapping + ) }) test_that("bQuiet and bReturnChecks work as intended", { - test_logical_parameters(map_function, dfs) + test_logical_parameters(map_function, dfs) }) diff --git a/tests/testthat/test_IE_Assess.R b/tests/testthat/test_IE_Assess.R index 0a9564a79..5cfb67301 100644 --- a/tests/testthat/test_IE_Assess.R +++ b/tests/testthat/test_IE_Assess.R @@ -2,8 +2,8 @@ source(testthat::test_path("testdata/data.R")) assess_function <- gsm::IE_Assess dfInput <- IE_Map_Raw(dfs = list(dfIE = dfIE, dfSUBJ = dfSUBJ)) -output_spec <- yaml::read_yaml(system.file('specs', 'IE_Assess.yaml', package = 'gsm')) -output_mapping <- yaml::read_yaml(system.file('mappings', 'IE_Assess.yaml', package = 'gsm')) +output_spec <- yaml::read_yaml(system.file("specs", "IE_Assess.yaml", package = "gsm")) +output_mapping <- yaml::read_yaml(system.file("mappings", "IE_Assess.yaml", package = "gsm")) # output is created as expected ------------------------------------------- test_that("output is created as expected", { @@ -62,7 +62,7 @@ test_that("dfAnalyzed has appropriate model output regardless of statistical met }) test_that("bQuiet and bReturnChecks work as intended", { - test_logical_assess_parameters(assess_function, dfInput) + test_logical_assess_parameters(assess_function, dfInput) }) test_that("strKRILabel works as intended", { diff --git a/tests/testthat/test_IE_Map_Raw.R b/tests/testthat/test_IE_Map_Raw.R index 22a45ae90..47d0298a8 100644 --- a/tests/testthat/test_IE_Map_Raw.R +++ b/tests/testthat/test_IE_Map_Raw.R @@ -3,73 +3,73 @@ source(testthat::test_path("testdata/data.R")) map_function <- gsm::IE_Map_Raw dfs <- list( - dfIE = dfIE, - dfSUBJ = dfSUBJ + dfIE = dfIE, + dfSUBJ = dfSUBJ ) -input_spec <- yaml::read_yaml(system.file('specs', 'IE_Map_Raw.yaml', package = 'gsm')) -input_mapping <- yaml::read_yaml(system.file('mappings', 'IE_Map_Raw.yaml', package = 'gsm')) +input_spec <- yaml::read_yaml(system.file("specs", "IE_Map_Raw.yaml", package = "gsm")) +input_mapping <- yaml::read_yaml(system.file("mappings", "IE_Map_Raw.yaml", package = "gsm")) -output_spec <- yaml::read_yaml(system.file('specs', 'IE_Assess.yaml', package = 'gsm')) -output_mapping <- yaml::read_yaml(system.file('mappings', 'IE_Assess.yaml', package = 'gsm')) +output_spec <- yaml::read_yaml(system.file("specs", "IE_Assess.yaml", package = "gsm")) +output_mapping <- yaml::read_yaml(system.file("mappings", "IE_Assess.yaml", package = "gsm")) -test_that('metadata have not changed', { - expect_snapshot_value(input_spec, 'json2') - expect_snapshot_value(input_mapping, 'json2') +test_that("metadata have not changed", { + expect_snapshot_value(input_spec, "json2") + expect_snapshot_value(input_mapping, "json2") - expect_snapshot_value(output_spec, 'json2') - expect_snapshot_value(output_mapping, 'json2') + expect_snapshot_value(output_spec, "json2") + expect_snapshot_value(output_mapping, "json2") }) test_that("valid output is returned", { - test_valid_output( - map_function, - dfs, - output_spec, - output_mapping - ) + test_valid_output( + map_function, + dfs, + output_spec, + output_mapping + ) }) test_that("invalid data throw errors", { - test_invalid_data( - map_function, - dfs, - input_spec, - input_mapping - ) + test_invalid_data( + map_function, + dfs, + input_spec, + input_mapping + ) }) test_that("missing column throws errors", { - test_missing_column( - map_function, - dfs, - input_spec, - input_mapping - ) + test_missing_column( + map_function, + dfs, + input_spec, + input_mapping + ) }) test_that("missing value throws errors", { - test_missing_value( - map_function, - dfs, - input_spec, - input_mapping - ) + test_missing_value( + map_function, + dfs, + input_spec, + input_mapping + ) }) -test_that('duplicate subject ID is detected', { - test_duplicate_subject_id(map_function, dfs) +test_that("duplicate subject ID is detected", { + test_duplicate_subject_id(map_function, dfs) }) test_that("invalid mapping throws errors", { - test_invalid_mapping( - map_function, - dfs, - input_spec, - input_mapping - ) + test_invalid_mapping( + map_function, + dfs, + input_spec, + input_mapping + ) }) test_that("bQuiet and bReturnChecks work as intended", { - test_logical_parameters(map_function, dfs) + test_logical_parameters(map_function, dfs) }) diff --git a/tests/testthat/test_PD_Assess.R b/tests/testthat/test_PD_Assess.R index 1a8521171..7a882b092 100644 --- a/tests/testthat/test_PD_Assess.R +++ b/tests/testthat/test_PD_Assess.R @@ -2,8 +2,8 @@ source(testthat::test_path("testdata/data.R")) assess_function <- gsm::PD_Assess dfInput <- PD_Map_Raw(dfs = list(dfPD = dfPD, dfSUBJ = dfSUBJ)) -output_spec <- yaml::read_yaml(system.file('specs', 'PD_Assess.yaml', package = 'gsm')) -output_mapping <- yaml::read_yaml(system.file('mappings', 'PD_Assess.yaml', package = 'gsm')) +output_spec <- yaml::read_yaml(system.file("specs", "PD_Assess.yaml", package = "gsm")) +output_mapping <- yaml::read_yaml(system.file("mappings", "PD_Assess.yaml", package = "gsm")) # output is created as expected ------------------------------------------- test_that("output is created as expected", { @@ -94,7 +94,7 @@ test_that("dfAnalyzed has appropriate model output regardless of statistical met }) test_that("bQuiet and bReturnChecks work as intended", { - test_logical_assess_parameters(assess_function, dfInput) + test_logical_assess_parameters(assess_function, dfInput) }) test_that("strKRILabel works as intended", { diff --git a/tests/testthat/test_PD_Map_Raw.R b/tests/testthat/test_PD_Map_Raw.R index 67bab3d5b..fe773e7f2 100644 --- a/tests/testthat/test_PD_Map_Raw.R +++ b/tests/testthat/test_PD_Map_Raw.R @@ -3,73 +3,73 @@ source(testthat::test_path("testdata/data.R")) map_function <- gsm::PD_Map_Raw dfs <- list( - dfPD = dfPD, - dfSUBJ = dfSUBJ + dfPD = dfPD, + dfSUBJ = dfSUBJ ) -input_spec <- yaml::read_yaml(system.file('specs', 'PD_Map_Raw.yaml', package = 'gsm')) -input_mapping <- yaml::read_yaml(system.file('mappings', 'PD_Map_Raw.yaml', package = 'gsm')) +input_spec <- yaml::read_yaml(system.file("specs", "PD_Map_Raw.yaml", package = "gsm")) +input_mapping <- yaml::read_yaml(system.file("mappings", "PD_Map_Raw.yaml", package = "gsm")) -output_spec <- yaml::read_yaml(system.file('specs', 'PD_Assess.yaml', package = 'gsm')) -output_mapping <- yaml::read_yaml(system.file('mappings', 'PD_Assess.yaml', package = 'gsm')) +output_spec <- yaml::read_yaml(system.file("specs", "PD_Assess.yaml", package = "gsm")) +output_mapping <- yaml::read_yaml(system.file("mappings", "PD_Assess.yaml", package = "gsm")) -test_that('metadata have not changed', { - expect_snapshot_value(input_spec, 'json2') - expect_snapshot_value(input_mapping, 'json2') +test_that("metadata have not changed", { + expect_snapshot_value(input_spec, "json2") + expect_snapshot_value(input_mapping, "json2") - expect_snapshot_value(output_spec, 'json2') - expect_snapshot_value(output_mapping, 'json2') + expect_snapshot_value(output_spec, "json2") + expect_snapshot_value(output_mapping, "json2") }) test_that("valid output is returned", { - test_valid_output( - map_function, - dfs, - output_spec, - output_mapping - ) + test_valid_output( + map_function, + dfs, + output_spec, + output_mapping + ) }) test_that("invalid data throw errors", { - test_invalid_data( - map_function, - dfs, - input_spec, - input_mapping - ) + test_invalid_data( + map_function, + dfs, + input_spec, + input_mapping + ) }) test_that("missing column throws errors", { - test_missing_column( - map_function, - dfs, - input_spec, - input_mapping - ) + test_missing_column( + map_function, + dfs, + input_spec, + input_mapping + ) }) test_that("missing value throws errors", { - test_missing_value( - map_function, - dfs, - input_spec, - input_mapping - ) + test_missing_value( + map_function, + dfs, + input_spec, + input_mapping + ) }) -test_that('duplicate subject ID is detected', { - test_duplicate_subject_id(map_function, dfs) +test_that("duplicate subject ID is detected", { + test_duplicate_subject_id(map_function, dfs) }) test_that("invalid mapping throws errors", { - test_invalid_mapping( - map_function, - dfs, - input_spec, - input_mapping - ) + test_invalid_mapping( + map_function, + dfs, + input_spec, + input_mapping + ) }) test_that("bQuiet and bReturnChecks work as intended", { - test_logical_parameters(map_function, dfs) + test_logical_parameters(map_function, dfs) }) diff --git a/tests/testthat/test_Study_Assess.R b/tests/testthat/test_Study_Assess.R index e79de9b76..8e5c748bf 100644 --- a/tests/testthat/test_Study_Assess.R +++ b/tests/testthat/test_Study_Assess.R @@ -220,13 +220,12 @@ test_that("lSubjFilters with 0 rows returns NULL", { }) test_that("correct bStatus is returned when workflow is missing", { - custom_assessments <- MakeAssessmentList() custom_assessments$ie$workflow <- NULL result <- Study_Assess( lData = lData, lAssessments = custom_assessments - ) + ) expect_false(result$ie$bStatus) }) diff --git a/tests/testthat/test_Study_AssessmentReport.R b/tests/testthat/test_Study_AssessmentReport.R index 500af586e..309360666 100644 --- a/tests/testthat/test_Study_AssessmentReport.R +++ b/tests/testthat/test_Study_AssessmentReport.R @@ -14,12 +14,12 @@ test_that("Assessment Report with all Valid assessments", { expect_true(is.data.frame(a$dfAllChecks)) expect_true(is.data.frame(a$dfSummary)) expect_equal( - names(a$dfAllChecks) %>% sort, - c('assessment', 'check', 'cols_are_unique', 'columns_have_empty_values', 'columns_have_na', 'domain', 'has_expected_columns', 'has_required_params', 'is_data_frame', 'mapping_is_list', 'mappings_are_character', 'notes', 'spec_is_list', 'step') + names(a$dfAllChecks) %>% sort(), + c("assessment", "check", "cols_are_unique", "columns_have_empty_values", "columns_have_na", "domain", "has_expected_columns", "has_required_params", "is_data_frame", "mapping_is_list", "mappings_are_character", "notes", "spec_is_list", "step") ) expect_equal( - names(a$dfSummary) %>% sort, - c('assessment', 'check', 'domain', 'notes', 'step') + names(a$dfSummary) %>% sort(), + c("assessment", "check", "domain", "notes", "step") ) }) @@ -62,22 +62,22 @@ test_that("correct messages show when data is not found", { report <- Study_AssessmentReport(lAssessments) expect_equal( - report$dfAllChecks %>% filter(domain == 'dfCONSENT') %>% pull(notes), + report$dfAllChecks %>% filter(domain == "dfCONSENT") %>% pull(notes), "Data not found for consent assessment" - ) + ) expect_equal( - report$dfAllChecks %>% filter(domain == 'dfIE') %>% pull(notes), + report$dfAllChecks %>% filter(domain == "dfIE") %>% pull(notes), "Data not found for ie assessment" ) expect_equal( - report$dfAllChecks %>% filter(domain == 'dfPD' & step == 'FilterDomain') %>% pull(notes), + report$dfAllChecks %>% filter(domain == "dfPD" & step == "FilterDomain") %>% pull(notes), "Data not found for importantpd assessment" ) expect_equal( - report$dfAllChecks %>% filter(assessment == 'pd' & domain == 'dfPD' & step == 'PD_Map_Raw') %>% pull(notes), + report$dfAllChecks %>% filter(assessment == "pd" & domain == "dfPD" & step == "PD_Map_Raw") %>% pull(notes), "Data not found for pd assessment" ) }) diff --git a/tests/testthat/test_Study_Table.R b/tests/testthat/test_Study_Table.R index f718185d0..453bf45da 100644 --- a/tests/testthat/test_Study_Table.R +++ b/tests/testthat/test_Study_Table.R @@ -62,10 +62,10 @@ test_that("bShowCounts works", { test_that("bShowSiteScore works", { expect_true( - 'Score' %in% Study_Table(dfFindings = results, bShowSiteScore = TRUE)$df_summary$Title + "Score" %in% Study_Table(dfFindings = results, bShowSiteScore = TRUE)$df_summary$Title ) expect_false( - 'Score' %in% Study_Table(dfFindings = results, bShowSiteScore = FALSE)$df_summary$Title + "Score" %in% Study_Table(dfFindings = results, bShowSiteScore = FALSE)$df_summary$Title ) }) diff --git a/tests/testthat/test_Summarize.R b/tests/testthat/test_Summarize.R index f005765dc..239d4ae24 100644 --- a/tests/testthat/test_Summarize.R +++ b/tests/testthat/test_Summarize.R @@ -33,23 +33,27 @@ test_that("invalid lTags throw error", { }) test_that("output is correctly sorted by Flag and Score", { - sim1 <- data.frame(SiteID = seq(1:100), - N = seq(1:100), - KRI = rep(NA, 100), - KRILabel = "cats", - Score = c(rep(0, 20), rep(1, 80)), - ScoreLabel = "dogs", - Flag = c(rep(-1, 9), rep(0, 91))) + sim1 <- data.frame( + SiteID = seq(1:100), + N = seq(1:100), + KRI = rep(NA, 100), + KRILabel = "cats", + Score = c(rep(0, 20), rep(1, 80)), + ScoreLabel = "dogs", + Flag = c(rep(-1, 9), rep(0, 91)) + ) expect_equal(Summarize(sim1)$Flag, c(rep(-1, 9), rep(0, 91))) - sim1 <- data.frame(SiteID = seq(1, 100), - N = seq(1, 100), - KRI = c(seq(1, 5), seq(6, 1), rep(11, 89)), - KRILabel = "fictitious things by general relativity", - Score = c(seq(1, 5), seq(6, 1), rep(11, 89)), - ScoreLabel = "homerun", - Flag = c(rep(-1, 9), rep(0, 91))) + sim1 <- data.frame( + SiteID = seq(1, 100), + N = seq(1, 100), + KRI = c(seq(1, 5), seq(6, 1), rep(11, 89)), + KRILabel = "fictitious things by general relativity", + Score = c(seq(1, 5), seq(6, 1), rep(11, 89)), + ScoreLabel = "homerun", + Flag = c(rep(-1, 9), rep(0, 91)) + ) expect_equal(Summarize(sim1)$Score, c(6, 5, 5, 4, 4, 3, 3, 2, 1, rep(11, 89), 2, 1)) }) diff --git a/tests/testthat/test_Transform_EventCount.R b/tests/testthat/test_Transform_EventCount.R index 3bab28de0..44a4e6edc 100644 --- a/tests/testthat/test_Transform_EventCount.R +++ b/tests/testthat/test_Transform_EventCount.R @@ -9,11 +9,11 @@ test_that("output created as expected and has correct structure", { expect_equal( names(Transform_EventCount(ae_input, strCountCol = "Count", strKRILabel = "Test Label")), c("SiteID", "N", "TotalCount", "KRI", "KRILabel") - ) + ) expect_equal( names(Transform_EventCount(ae_input, strCountCol = "Count", strExposureCol = "Exposure", strKRILabel = "Test Label")), c("SiteID", "N", "TotalCount", "TotalExposure", "KRI", "KRILabel") - ) + ) }) test_that("strCountCol works as expected", { @@ -30,11 +30,14 @@ test_that("strCountCol works as expected", { EventCount2 <- Transform_EventCount(sim2, strCountCol = "event", strKRILabel = "Test Label") expect_equal( EventCount2, - tibble(SiteID = c("site1", "site2", "site3"), - N = c(10, 8, 12), - TotalCount = c(5, 8, 22), - KRI = c(5, 8, 22), - KRILabel = "Test Label")) + tibble( + SiteID = c("site1", "site2", "site3"), + N = c(10, 8, 12), + TotalCount = c(5, 8, 22), + KRI = c(5, 8, 22), + KRILabel = "Test Label" + ) + ) }) test_that("strExposureCol works as expected", { @@ -45,13 +48,14 @@ test_that("strExposureCol works as expected", { ) EventCount3 <- Transform_EventCount(sim3, strCountCol = "event", strExposureCol = "ndays", strKRILabel = "Test Label") - expect_equal(EventCount3, - tibble::tribble( - ~SiteID, ~N, ~TotalCount, ~TotalExposure, ~KRI, ~KRILabel, - "site1", 11L, 5, 80, 0.0625, "Test Label", - "site2", 7L, 7, 70, 0.1, "Test Label", - "site3", 12L, 24, 120, 0.2, "Test Label" - ) + expect_equal( + EventCount3, + tibble::tribble( + ~SiteID, ~N, ~TotalCount, ~TotalExposure, ~KRI, ~KRILabel, + "site1", 11L, 5, 80, 0.0625, "Test Label", + "site2", 7L, 7, 70, 0.1, "Test Label", + "site3", 12L, 24, 120, 0.2, "Test Label" + ) ) }) @@ -88,8 +92,7 @@ test_that("NA in Exposure is removed ", { ae_input2 <- ae_input ae_input2[1, "Exposure"] <- NA expect_false(anyNA(suppressWarnings(Transform_EventCount(ae_input2, strCountCol = "Count", strExposureCol = "Exposure", strKRILabel = "Test Label")) %>% - pull(.data$TotalExposure)) - ) + pull(.data$TotalExposure))) }) test_that("NA in Count throws an error", { @@ -101,10 +104,10 @@ test_that("NA in Count throws an error", { expect_error( eventCount <- Transform_EventCount( - sim4, - strCountCol = "event", - strExposureCol = "ndays", - strKRILabel = "Test Label" + sim4, + strCountCol = "event", + strExposureCol = "ndays", + strKRILabel = "Test Label" ) ) }) diff --git a/tests/testthat/test_qual_T3_1.R b/tests/testthat/test_qual_T3_1.R index 117d590d7..fac19ca2f 100644 --- a/tests/testthat/test_qual_T3_1.R +++ b/tests/testthat/test_qual_T3_1.R @@ -17,7 +17,7 @@ test_that("IE assessment can return a correctly assessed data frame grouped by t mutate( Score = TotalCount, ScoreLabel = "# of Inclusion/Exclusion Issues" - ) + ) class(t3_1_analyzed) <- c("tbl_df", "tbl", "data.frame") @@ -39,7 +39,7 @@ test_that("IE assessment can return a correctly assessed data frame grouped by t mutate( Assessment = "IE" ) %>% - select(SiteID, N, KRI, KRILabel, Score, ScoreLabel,Flag, Assessment) %>% + select(SiteID, N, KRI, KRILabel, Score, ScoreLabel, Flag, Assessment) %>% arrange(desc(abs(KRI))) %>% arrange(match(Flag, c(1, -1, 0))) diff --git a/tests/testthat/test_qual_T3_2.R b/tests/testthat/test_qual_T3_2.R index 9450f988c..5711bebd9 100644 --- a/tests/testthat/test_qual_T3_2.R +++ b/tests/testthat/test_qual_T3_2.R @@ -39,7 +39,7 @@ test_that("IE assessment can return a correctly assessed data frame grouped by t mutate( Assessment = "IE" ) %>% - select(SiteID, N, KRI, KRILabel, Score, ScoreLabel,Flag, Assessment) %>% + select(SiteID, N, KRI, KRILabel, Score, ScoreLabel, Flag, Assessment) %>% arrange(desc(abs(KRI))) %>% arrange(match(Flag, c(1, -1, 0))) diff --git a/tests/testthat/test_qual_T4_1.R b/tests/testthat/test_qual_T4_1.R index 87e54caa9..03f37bb2a 100644 --- a/tests/testthat/test_qual_T4_1.R +++ b/tests/testthat/test_qual_T4_1.R @@ -39,7 +39,7 @@ test_that("Consent assessment can return a correctly assessed data frame grouped mutate( Assessment = "Consent" ) %>% - select(SiteID, N, KRI, KRILabel, Score, ScoreLabel,Flag, Assessment) %>% + select(SiteID, N, KRI, KRILabel, Score, ScoreLabel, Flag, Assessment) %>% arrange(desc(abs(KRI))) %>% arrange(match(Flag, c(1, -1, 0))) diff --git a/tests/testthat/test_qual_T4_2.R b/tests/testthat/test_qual_T4_2.R index 71c7e10a0..8915437e1 100644 --- a/tests/testthat/test_qual_T4_2.R +++ b/tests/testthat/test_qual_T4_2.R @@ -39,7 +39,7 @@ test_that("Consent assessment can return a correctly assessed data frame grouped mutate( Assessment = "Consent" ) %>% - select(SiteID, N, KRI, KRILabel, Score, ScoreLabel,Flag, Assessment) %>% + select(SiteID, N, KRI, KRILabel, Score, ScoreLabel, Flag, Assessment) %>% arrange(desc(abs(KRI))) %>% arrange(match(Flag, c(1, -1, 0))) diff --git a/tests/testthat/test_util-runAssessment.R b/tests/testthat/test_util-runAssessment.R index 7aca7d7ac..bc6ce9fae 100644 --- a/tests/testthat/test_util-runAssessment.R +++ b/tests/testthat/test_util-runAssessment.R @@ -38,8 +38,6 @@ test_that("Assessment correctly labeled as valid", { }) test_that("workflow with multiple FilterDomain steps is reported correctly", { - - dfAE <- data.frame( stringsAsFactors = FALSE, SubjectID = c("1234", "1234", "5678", "5678"), From 5b20866102ffdd5b492f8012f155e982ffd2ee88 Mon Sep 17 00:00:00 2001 From: Spencer Childress Date: Thu, 16 Jun 2022 19:59:01 -0400 Subject: [PATCH 85/87] update buildVignette action in .github/workflows/qualification-report.yaml --- .github/workflows/qualification-report.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/qualification-report.yaml b/.github/workflows/qualification-report.yaml index f72ccfc1a..076ab6e09 100644 --- a/.github/workflows/qualification-report.yaml +++ b/.github/workflows/qualification-report.yaml @@ -43,7 +43,7 @@ jobs: devtools::install(dependencies=TRUE) - name: build vignette - run: tools::buildVignette("./vignettes/Qualification.Rmd") + run: tools::buildVignette("./vignettes/articles/Qualification.Rmd") shell: Rscript {0} From ccd83ba2f031bee294479fa5c9213c11e1521d5d Mon Sep 17 00:00:00 2001 From: Spencer Childress Date: Fri, 17 Jun 2022 14:08:07 -0400 Subject: [PATCH 86/87] QC AE and PD assessments --- R/AE_Assess.R | 30 +++++++++------- R/AE_Map_Adam.R | 7 +++- R/AE_Map_Raw.R | 20 +++++++---- R/Analyze_Wilcoxon.R | 2 +- R/Consent_Map_Raw.R | 36 ++++++++++++-------- R/IE_Map_Raw.R | 30 +++++++++------- R/PD_Assess.R | 29 ++++++++++------ R/PD_Map_Raw.R | 18 ++++++---- man/AE_Assess.Rd | 22 +++++++----- man/AE_Map_Raw.Rd | 7 ++-- man/Analyze_Wilcoxon.Rd | 2 +- man/Consent_Map_Raw.Rd | 15 ++++---- man/IE_Map_Raw.Rd | 7 ++-- man/PD_Assess.Rd | 22 ++++++++---- man/PD_Map_Raw.Rd | 11 +++--- tests/testthat/_snaps/AE_Assess.md | 18 +++++----- tests/testthat/_snaps/PD_Assess.md | 10 +++--- vignettes/articles/ContributorGuidelines.Rmd | 26 +++++++------- 18 files changed, 186 insertions(+), 126 deletions(-) diff --git a/R/AE_Assess.R b/R/AE_Assess.R index 6e783aae7..03d14afde 100644 --- a/R/AE_Assess.R +++ b/R/AE_Assess.R @@ -1,25 +1,27 @@ #' Adverse Event Assessment #' #' @description -#' Flag sites that may be over- or under-reporting adverse events (AEs). +#' Evaluates adverse event (AE) rates to identify sites that may be over- or under-reporting AEs. #' #' @details #' The AE Assessment uses the standard [GSM data pipeline]( -#' https://github.com/Gilead-BioStats/gsm/wiki/Data-Pipeline-Vignette +#' https://silver-potato-cfe8c2fb.pages.github.io/articles/DataPipeline.html #' ) to flag possible outliers. Additional details regarding the data pipeline and statistical #' methods are described below. #' #' @param dfInput `data.frame` Input data, a data frame with one record per subject. #' @param vThreshold `numeric` Threshold specification, a vector of length 2 that defaults to -#' `c(-5, 5)` for `strMethod` = "poisson" and `c(.0001, NA)` for `strMethod` = "wilcoxon". -#' @param strMethod `character` Statistical model. Valid values include "poisson" (default) and -#' "wilcoxon". -#' @param strKRILabel `character` Describe the `KRI` column, a vector of length 1 that defaults to `AEs/Week` +#' `c(-5, 5)` for a Poisson model (`strMethod = "poisson"`) and `c(.0001, NA)` for a Wilcoxon +#' signed-rank test (`strMethod` = "wilcoxon"). +#' @param strMethod `character` Statistical method. Valid values: +#' - `"poisson"` (default) +#' - `"wilcoxon"` +#' @param strKRILabel `character` KRI description. Default: `"AEs/Week"` #' @param lTags `list` Assessment tags, a named list of tags describing the assessment that defaults -#' to `list(Assessment="AE")`. `lTags` is returned as part of the assessment (`lAssess$lTags`) and -#' each tag is added as a column in `lAssess$dfSummary`. +#' to `list(Assessment = "AE")`. `lTags` is returned as part of the assessment (`lAssess$lTags`) +#' and each tag is added as a column in `lAssess$dfSummary`. #' @param bChart `logical` Generate data visualization? Default: `TRUE` -#' @param bReturnChecks `logical` Return input checks from `is_mapping_valid`? Default: `FALSE` +#' @param bReturnChecks `logical` Return input checks from [gsm::is_mapping_valid()]? Default: `FALSE` #' @param bQuiet `logical` Suppress warning messages? Default: `TRUE` #' #' @return `list` Assessment, a named list with: @@ -61,17 +63,21 @@ AE_Assess <- function( ) { stopifnot( "dfInput is not a data.frame" = is.data.frame(dfInput), + "dfInput is missing one or more of these columns: SubjectID, SiteID, Count, Exposure, and Rate" = all(c("SubjectID", "SiteID", "Count", "Exposure", "Rate") %in% names(dfInput)), "strMethod is not 'poisson' or 'wilcoxon'" = strMethod %in% c("poisson", "wilcoxon"), - "One or more of these columns: SubjectID, SiteID, Count, Exposure, and Rate not found in dfInput" = all(c("SubjectID", "SiteID", "Count", "Exposure", "Rate") %in% names(dfInput)), "strMethod must be length 1" = length(strMethod) == 1, - "strKRILabel must be length 1" = length(strKRILabel) == 1 + "strKRILabel must be length 1" = length(strKRILabel) == 1, + "bChart must be logical" = is.logical(bChart), + "bReturnChecks must be logical" = is.logical(bReturnChecks), + "bQuiet must be logical" = is.logical(bQuiet) ) if (!is.null(lTags)) { stopifnot( "lTags is not named" = (!is.null(names(lTags))), "lTags has unnamed elements" = all(names(lTags) != ""), - "lTags cannot contain elements named: 'SiteID', 'N', 'Score', or 'Flag'" = !names(lTags) %in% c("SiteID", "N", "Score", "Flag") + "lTags cannot contain elements named: 'SiteID', 'N', 'KRI', 'KRILabel', 'Score', 'ScoreLabel', or 'Flag'" = !names(lTags) %in% c("SiteID", "N", "KRI", "KRILabel", "Score", "ScoreLabel", "Flag") + ) if (any(unname(purrr::map_dbl(lTags, ~ length(.))) > 1)) { diff --git a/R/AE_Map_Adam.R b/R/AE_Map_Adam.R index c9c988623..9ab5b79fd 100644 --- a/R/AE_Map_Adam.R +++ b/R/AE_Map_Adam.R @@ -46,7 +46,12 @@ AE_Map_Adam <- function( bReturnChecks = FALSE, bQuiet = TRUE ) { - checks <- gsm::CheckInputs( + stopifnot( + "bReturnChecks must be logical" = is.logical(bReturnChecks), + "bQuiet must be logical" = is.logical(bQuiet) + ) + + checks <- CheckInputs( context = "AE_Map_Adam", dfs = dfs, bQuiet = bQuiet, diff --git a/R/AE_Map_Raw.R b/R/AE_Map_Raw.R index d729e15de..5f2c66c11 100644 --- a/R/AE_Map_Raw.R +++ b/R/AE_Map_Raw.R @@ -12,9 +12,10 @@ #' AEs by passing filtered AE data to `dfAE`. #' #' @param dfs `list` Input data frames: -#' - `dfAE`: `data.frame` Event-level data with one record per AE. -#' - `dfSUBJ`: `data.frame` Subject-level data with one record per subject. -#' @param lMapping `list` Column metadata with structure `domain$key`, where `key` contains the name of the column. +#' - `dfAE`: `data.frame` Event-level data with one record per AE. +#' - `dfSUBJ`: `data.frame` Subject-level data with one record per subject. +#' @param lMapping `list` Column metadata with structure `domain$key`, where `key` contains the name +#' of the column. #' @param bReturnChecks `logical` Return input checks from [gsm::is_mapping_valid()]? Default: `FALSE` #' @param bQuiet `logical` Suppress warning messages? Default: `TRUE` #' @@ -26,14 +27,14 @@ #' @includeRmd ./man/md/AE_Map_Raw.md #' #' @examples -#' # Run with defaults +#' # Run with defaults. #' dfInput <- AE_Map_Raw() #' -#' # Run with error checking and message log +#' # Run with error checking and message log. #' dfInput <- AE_Map_Raw(bReturnChecks = TRUE, bQuiet = FALSE) #' -#' @import dplyr #' @importFrom cli cli_alert_success cli_alert_warning cli_h2 +#' @import dplyr #' #' @export @@ -46,7 +47,12 @@ AE_Map_Raw <- function( bReturnChecks = FALSE, bQuiet = TRUE ) { - checks <- gsm::CheckInputs( + stopifnot( + "bReturnChecks must be logical" = is.logical(bReturnChecks), + "bQuiet must be logical" = is.logical(bQuiet) + ) + + checks <- CheckInputs( context = "AE_Map_Raw", dfs = dfs, bQuiet = bQuiet, diff --git a/R/Analyze_Wilcoxon.R b/R/Analyze_Wilcoxon.R index 12e42abbe..02581fd8f 100644 --- a/R/Analyze_Wilcoxon.R +++ b/R/Analyze_Wilcoxon.R @@ -1,6 +1,6 @@ #' AE Wilcoxon Assessment - Analysis #' -#' Create analysis results data for event assessment using the Wilcoxon sign-ranked test. +#' Create analysis results data for event assessment using the Wilcoxon signed-rank test. #' #' @details #' Fits a Wilcoxon model to site-level data. diff --git a/R/Consent_Map_Raw.R b/R/Consent_Map_Raw.R index 2c9e8161b..90f7b9b2f 100644 --- a/R/Consent_Map_Raw.R +++ b/R/Consent_Map_Raw.R @@ -1,7 +1,8 @@ #' Consent Assessment - Raw Mapping #' #' @description -#' Convert from raw data format to needed input format for \code{\link{Consent_Assess}} +#' Convert raw informed consent data, typically processed case report from data, to formatted +#' input data to [gsm::Consent_Assess()]. #' #' @details #' `Consent_Map_Raw` combines consent data with subject-level data to create formatted input data @@ -13,27 +14,27 @@ #' @param dfs `list` Input data frames: #' - `dfCONSENT`: `data.frame` Consent type-level data with one record per subject per consent type. #' - `dfSUBJ`: `data.frame` Subject-level data with one record per subject. -#' @param lMapping `list` Column metadata with structure `domain$key`, where `key` contains the name of the column. +#' @param lMapping `list` Column metadata with structure `domain$key`, where `key` contains the name +#' of the column. #' @param bReturnChecks `logical` Return input checks from [gsm::is_mapping_valid()]? Default: `FALSE` #' @param bQuiet `logical` Suppress warning messages? Default: `TRUE` #' -#' @return `data.frame` Data frame with one record per subject, the input to -#' [gsm::Consent_Assess()]. If `bReturnChecks` is `TRUE` `Consent_Map_Raw` returns a named `list` -#' with: +#' @return `data.frame` Data frame with one record per subject, the input to [gsm::Consent_Assess()]. +#' If `bReturnChecks` is `TRUE` `Consent_Map_Raw` returns a named `list` with: #' - `df`: the data frame described above #' - `lChecks`: a named `list` of check results #' #' @includeRmd ./man/md/Consent_Map_Raw.md #' #' @examples -#' # Run with defaults +#' # Run with defaults. #' dfInput <- Consent_Map_Raw() #' -#' # Run with error checking and message log +#' # Run with error checking and message log. #' dfInput <- Consent_Map_Raw(bReturnChecks = TRUE, bQuiet = FALSE) #' -#' @import dplyr #' @importFrom cli cli_alert_success cli_alert_warning cli_h2 +#' @import dplyr #' #' @export @@ -46,6 +47,11 @@ Consent_Map_Raw <- function( bReturnChecks = FALSE, bQuiet = TRUE ) { + stopifnot( + "bReturnChecks must be logical" = is.logical(bReturnChecks), + "bQuiet must be logical" = is.logical(bQuiet) + ) + checks <- CheckInputs( context = "Consent_Map_Raw", dfs = dfs, @@ -57,13 +63,6 @@ Consent_Map_Raw <- function( if (!bQuiet) cli::cli_h2("Initializing {.fn Consent_Map_Raw}") # Standarize column names. - dfSUBJ_mapped <- dfs$dfSUBJ %>% - select( - SubjectID = lMapping[["dfSUBJ"]][["strIDCol"]], - SiteID = lMapping[["dfSUBJ"]][["strSiteCol"]], - RandDate = lMapping[["dfSUBJ"]][["strRandDateCol"]] - ) - dfCONSENT_mapped <- dfs$dfCONSENT %>% select( SubjectID = lMapping[["dfCONSENT"]][["strIDCol"]], @@ -72,6 +71,13 @@ Consent_Map_Raw <- function( ConsentDate = lMapping[["dfCONSENT"]][["strDateCol"]] ) + dfSUBJ_mapped <- dfs$dfSUBJ %>% + select( + SubjectID = lMapping[["dfSUBJ"]][["strIDCol"]], + SiteID = lMapping[["dfSUBJ"]][["strSiteCol"]], + RandDate = lMapping[["dfSUBJ"]][["strRandDateCol"]] + ) + if (!is.null(lMapping$dfCONSENT$strConsentTypeValue)) { dfCONSENT_mapped <- dfCONSENT_mapped %>% filter( diff --git a/R/IE_Map_Raw.R b/R/IE_Map_Raw.R index da8b26f37..b500c35a0 100644 --- a/R/IE_Map_Raw.R +++ b/R/IE_Map_Raw.R @@ -14,7 +14,8 @@ #' @param dfs `list` Input data frames: #' - `dfIE`: `data.frame` Criterion-level data with one record subject per criterion. #' - `dfSUBJ`: `data.frame` Subject-level data with one record per subject. -#' @param lMapping `list` Column metadata with structure `domain$key`, where `key` contains the name of the column. +#' @param lMapping `list` Column metadata with structure `domain$key`, where `key` contains the name +#' of the column. #' @param bReturnChecks `logical` Return input checks from [gsm::is_mapping_valid()]? Default: `FALSE` #' @param bQuiet `logical` Suppress warning messages? Default: `TRUE` #' @@ -26,14 +27,14 @@ #' @includeRmd ./man/md/IE_Map_Raw.md #' #' @examples -#' # Run with defaults +#' # Run with defaults. #' dfInput <- IE_Map_Raw() #' -#' # Run with error checking and message log +#' # Run with error checking and message log. #' dfInput <- IE_Map_Raw(bReturnChecks = TRUE, bQuiet = FALSE) #' -#' @import dplyr #' @importFrom cli cli_alert_success cli_alert_warning cli_h2 +#' @import dplyr #' #' @export @@ -46,6 +47,11 @@ IE_Map_Raw <- function( bReturnChecks = FALSE, bQuiet = TRUE ) { + stopifnot( + "bReturnChecks must be logical" = is.logical(bReturnChecks), + "bQuiet must be logical" = is.logical(bQuiet) + ) + checks <- CheckInputs( context = "IE_Map_Raw", dfs = dfs, @@ -57,21 +63,21 @@ IE_Map_Raw <- function( if (!bQuiet) cli::cli_h2("Initializing {.fn IE_Map_Raw}") # Standarize column names. - dfSUBJ_mapped <- dfs$dfSUBJ %>% - select( - SubjectID = lMapping[["dfSUBJ"]][["strIDCol"]], - SiteID = lMapping[["dfSUBJ"]][["strSiteCol"]] - ) - - dfIE_Subj <- dfs$dfIE %>% + dfIE_mapped <- dfs$dfIE %>% select( SubjectID = lMapping[["dfIE"]][["strIDCol"]], category = lMapping[["dfIE"]][["strCategoryCol"]], result = lMapping[["dfIE"]][["strValueCol"]] ) + dfSUBJ_mapped <- dfs$dfSUBJ %>% + select( + SubjectID = lMapping[["dfSUBJ"]][["strIDCol"]], + SiteID = lMapping[["dfSUBJ"]][["strSiteCol"]] + ) + # Create Subject Level IE Counts and merge Subj - dfInput <- dfIE_Subj %>% + dfInput <- dfIE_mapped %>% mutate( expected = ifelse( .data$category == lMapping$dfIE$vCategoryValues[1], diff --git a/R/PD_Assess.R b/R/PD_Assess.R index 950244f4c..9f68797f2 100644 --- a/R/PD_Assess.R +++ b/R/PD_Assess.R @@ -1,21 +1,27 @@ #' Protocol Deviation Assessment #' #' @description -#' Flag sites that may be over- or under-reporting protocol deviations (PDs). +#' Evaluates protocol deviation (PD) rates to identify sites that may be over- or under-reporting PDs. #' #' @details -#' The Protocol Deviation Assessment uses the standard [GSM data pipeline]( -#' https://github.com/Gilead-BioStats/gsm/wiki/Data-Pipeline-Vignette +#' The PD Assessment uses the standard [GSM data pipeline]( +#' https://silver-potato-cfe8c2fb.pages.github.io/articles/DataPipeline.html #' ) to flag possible outliers. Additional details regarding the data pipeline and statistical #' methods are described below. #' #' @param dfInput `data.frame` Input data, a data frame with one record per subject. -#' @param vThreshold `numeric` Threshold specification, a vector of length 2 that defaults to `c(-5, 5)` for `strMethod` = "poisson" and `c(.0001, NA)` for `strMethod` = "wilcoxon". -#' @param strMethod `character` Statistical model. Valid values include "poisson" (default) and "wilcoxon". -#' @param lTags `list` Assessment tags, a named list of tags describing the assessment that defaults to `list(Assessment="PD")`. `lTags` is returned as part of the assessment (`lAssess$lTags`) and each tag is added as a column in `lAssess$dfSummary`. -#' @param strKRILabel `character` Describe the `KRI` column, a vector of length 1 that defaults to `PDs/Week` +#' @param vThreshold `numeric` Threshold specification, a vector of length 2 that defaults to +#' `c(-5, 5)` for a Poisson model (`strMethod = "poisson"`) and `c(.0001, NA)` for a Wilcoxon +#' signed-rank test (`strMethod` = "wilcoxon"). +#' @param strMethod `character` Statistical method. Valid values: +#' - `"poisson"` (default) +#' - `"wilcoxon"` +#' @param strKRILabel `character` KRI description. Default: `"PDs/Week"` +#' @param lTags `list` Assessment tags, a named list of tags describing the assessment that defaults +#' to `list(Assessment = "PD")`. `lTags` is returned as part of the assessment (`lAssess$lTags`) +#' and each tag is added as a column in `lAssess$dfSummary`. #' @param bChart `logical` Generate data visualization? Default: `TRUE` -#' @param bReturnChecks `logical` Return input checks from `is_mapping_valid`? Default: `FALSE` +#' @param bReturnChecks `logical` Return input checks from [gsm::is_mapping_valid()]? Default: `FALSE` #' @param bQuiet `logical` Suppress warning messages? Default: `TRUE` #' #' @return `list` Assessment, a named list with: @@ -57,10 +63,13 @@ PD_Assess <- function( ) { stopifnot( "dfInput is not a data.frame" = is.data.frame(dfInput), + "dfInput is missing one or more of these columns: SubjectID, SiteID, Count, Exposure, and Rate" = all(c("SubjectID", "SiteID", "Count", "Exposure", "Rate") %in% names(dfInput)), "strMethod is not 'poisson' or 'wilcoxon'" = strMethod %in% c("poisson", "wilcoxon"), "strMethod must be length 1" = length(strMethod) == 1, - "One or more of these columns: SubjectID, SiteID, Count, Exposure, and Rate not found in dfInput" = all(c("SubjectID", "SiteID", "Count", "Exposure", "Rate") %in% names(dfInput)), - "strKRILabel must be length 1" = length(strKRILabel) == 1 + "strKRILabel must be length 1" = length(strKRILabel) == 1, + "bChart must be logical" = is.logical(bChart), + "bReturnChecks must be logical" = is.logical(bReturnChecks), + "bQuiet must be logical" = is.logical(bQuiet) ) if (!is.null(lTags)) { diff --git a/R/PD_Map_Raw.R b/R/PD_Map_Raw.R index 26f7b130a..e981b0471 100644 --- a/R/PD_Map_Raw.R +++ b/R/PD_Map_Raw.R @@ -5,7 +5,7 @@ #' input data to [gsm::PD_Assess()]. #' #' @details -#' `PD_Map_Raw` combines PD data with subject-level treatment exposure data to create formatted +#' `PD_Map_Raw` combines PD data with subject-level study duration data to create formatted #' input data to [gsm::PD_Assess()]. This function creates an input dataset for the PD Assessment #' ([gsm::PD_Assess()]) by binding subject-level PD counts (derived from `dfPD`) to subject-level #' data (from `dfSUBJ`). Note that the function can generate data summaries for specific types of @@ -14,8 +14,9 @@ #' @param dfs `list` Input data frames: #' - `dfPD`: `data.frame` Event-level data with one record per PD. #' - `dfSUBJ`: `data.frame` Subject-level data with one record per subject. -#' @param lMapping `list` Column metadata with structure `domain$key`, where `key contains the name of the column. -#' @param bReturnChecks `logical` Return input checks from `is_mapping_valid`? Default: `FALSE` +#' @param lMapping `list` Column metadata with structure `domain$key`, where `key` contains the name +#' of the column. +#' @param bReturnChecks `logical` Return input checks from [gsm::is_mapping_valid()]? Default: `FALSE` #' @param bQuiet `logical` Suppress warning messages? Default: `TRUE` #' #' @return `data.frame` Data frame with one record per subject, the input to [gsm::PD_Assess()]. If @@ -26,14 +27,14 @@ #' @includeRmd ./man/md/PD_Map_Raw.md #' #' @examples -#' # Run with defaults +#' # Run with defaults. #' dfInput <- PD_Map_Raw() #' -#' # Run with error checking and message log +#' # Run with error checking and message log. #' dfInput <- PD_Map_Raw(bReturnChecks = TRUE, bQuiet = FALSE) #' -#' @import dplyr #' @importFrom cli cli_alert_success cli_alert_warning cli_h2 +#' @import dplyr #' #' @export @@ -46,6 +47,11 @@ PD_Map_Raw <- function( bReturnChecks = FALSE, bQuiet = TRUE ) { + stopifnot( + "bReturnChecks must be logical" = is.logical(bReturnChecks), + "bQuiet must be logical" = is.logical(bQuiet) + ) + checks <- CheckInputs( context = "PD_Map_Raw", dfs = dfs, diff --git a/man/AE_Assess.Rd b/man/AE_Assess.Rd index 4eb14e3ed..92a0c91bf 100644 --- a/man/AE_Assess.Rd +++ b/man/AE_Assess.Rd @@ -19,20 +19,24 @@ AE_Assess( \item{dfInput}{\code{data.frame} Input data, a data frame with one record per subject.} \item{vThreshold}{\code{numeric} Threshold specification, a vector of length 2 that defaults to -\code{c(-5, 5)} for \code{strMethod} = "poisson" and \code{c(.0001, NA)} for \code{strMethod} = "wilcoxon".} +\code{c(-5, 5)} for a Poisson model (\code{strMethod = "poisson"}) and \code{c(.0001, NA)} for a Wilcoxon +signed-rank test (\code{strMethod} = "wilcoxon").} -\item{strMethod}{\code{character} Statistical model. Valid values include "poisson" (default) and -"wilcoxon".} +\item{strMethod}{\code{character} Statistical method. Valid values: +\itemize{ +\item \code{"poisson"} (default) +\item \code{"wilcoxon"} +}} -\item{strKRILabel}{\code{character} Describe the \code{KRI} column, a vector of length 1 that defaults to \code{AEs/Week}} +\item{strKRILabel}{\code{character} KRI description. Default: \code{"AEs/Week"}} \item{lTags}{\code{list} Assessment tags, a named list of tags describing the assessment that defaults -to \code{list(Assessment="AE")}. \code{lTags} is returned as part of the assessment (\code{lAssess$lTags}) and -each tag is added as a column in \code{lAssess$dfSummary}.} +to \code{list(Assessment = "AE")}. \code{lTags} is returned as part of the assessment (\code{lAssess$lTags}) +and each tag is added as a column in \code{lAssess$dfSummary}.} \item{bChart}{\code{logical} Generate data visualization? Default: \code{TRUE}} -\item{bReturnChecks}{\code{logical} Return input checks from \code{is_mapping_valid}? Default: \code{FALSE}} +\item{bReturnChecks}{\code{logical} Return input checks from \code{\link[=is_mapping_valid]{is_mapping_valid()}}? Default: \code{FALSE}} \item{bQuiet}{\code{logical} Suppress warning messages? Default: \code{TRUE}} } @@ -60,10 +64,10 @@ each tag is added as a column in \code{lAssess$dfSummary}.} } } \description{ -Flag sites that may be over- or under-reporting adverse events (AEs). +Evaluates adverse event (AE) rates to identify sites that may be over- or under-reporting AEs. } \details{ -The AE Assessment uses the standard \href{https://github.com/Gilead-BioStats/gsm/wiki/Data-Pipeline-Vignette}{GSM data pipeline} to flag possible outliers. Additional details regarding the data pipeline and statistical +The AE Assessment uses the standard \href{https://silver-potato-cfe8c2fb.pages.github.io/articles/DataPipeline.html}{GSM data pipeline} to flag possible outliers. Additional details regarding the data pipeline and statistical methods are described below. } \section{Data specification}{ diff --git a/man/AE_Map_Raw.Rd b/man/AE_Map_Raw.Rd index fd11c3864..1b964d185 100644 --- a/man/AE_Map_Raw.Rd +++ b/man/AE_Map_Raw.Rd @@ -18,7 +18,8 @@ AE_Map_Raw( \item \code{dfSUBJ}: \code{data.frame} Subject-level data with one record per subject. }} -\item{lMapping}{\code{list} Column metadata with structure \code{domain$key}, where \code{key} contains the name of the column.} +\item{lMapping}{\code{list} Column metadata with structure \code{domain$key}, where \code{key} contains the name +of the column.} \item{bReturnChecks}{\code{logical} Return input checks from \code{\link[=is_mapping_valid]{is_mapping_valid()}}? Default: \code{FALSE}} @@ -54,10 +55,10 @@ AEs by passing filtered AE data to \code{dfAE}. } \examples{ -# Run with defaults +# Run with defaults. dfInput <- AE_Map_Raw() -# Run with error checking and message log +# Run with error checking and message log. dfInput <- AE_Map_Raw(bReturnChecks = TRUE, bQuiet = FALSE) } diff --git a/man/Analyze_Wilcoxon.Rd b/man/Analyze_Wilcoxon.Rd index 0fc931c2d..26e69ab70 100644 --- a/man/Analyze_Wilcoxon.Rd +++ b/man/Analyze_Wilcoxon.Rd @@ -26,7 +26,7 @@ Default: \code{"SiteID"}} Estimate, PValue. } \description{ -Create analysis results data for event assessment using the Wilcoxon sign-ranked test. +Create analysis results data for event assessment using the Wilcoxon signed-rank test. } \details{ Fits a Wilcoxon model to site-level data. diff --git a/man/Consent_Map_Raw.Rd b/man/Consent_Map_Raw.Rd index cdc34d587..36e468da8 100644 --- a/man/Consent_Map_Raw.Rd +++ b/man/Consent_Map_Raw.Rd @@ -18,23 +18,24 @@ Consent_Map_Raw( \item \code{dfSUBJ}: \code{data.frame} Subject-level data with one record per subject. }} -\item{lMapping}{\code{list} Column metadata with structure \code{domain$key}, where \code{key} contains the name of the column.} +\item{lMapping}{\code{list} Column metadata with structure \code{domain$key}, where \code{key} contains the name +of the column.} \item{bReturnChecks}{\code{logical} Return input checks from \code{\link[=is_mapping_valid]{is_mapping_valid()}}? Default: \code{FALSE}} \item{bQuiet}{\code{logical} Suppress warning messages? Default: \code{TRUE}} } \value{ -\code{data.frame} Data frame with one record per subject, the input to -\code{\link[=Consent_Assess]{Consent_Assess()}}. If \code{bReturnChecks} is \code{TRUE} \code{Consent_Map_Raw} returns a named \code{list} -with: +\code{data.frame} Data frame with one record per subject, the input to \code{\link[=Consent_Assess]{Consent_Assess()}}. +If \code{bReturnChecks} is \code{TRUE} \code{Consent_Map_Raw} returns a named \code{list} with: \itemize{ \item \code{df}: the data frame described above \item \code{lChecks}: a named \code{list} of check results } } \description{ -Convert from raw data format to needed input format for \code{\link{Consent_Assess}} +Convert raw informed consent data, typically processed case report from data, to formatted +input data to \code{\link[=Consent_Assess]{Consent_Assess()}}. } \details{ \code{Consent_Map_Raw} combines consent data with subject-level data to create formatted input data @@ -57,10 +58,10 @@ types of consent by customizing \code{lMapping$dfCONSENT}. } \examples{ -# Run with defaults +# Run with defaults. dfInput <- Consent_Map_Raw() -# Run with error checking and message log +# Run with error checking and message log. dfInput <- Consent_Map_Raw(bReturnChecks = TRUE, bQuiet = FALSE) } diff --git a/man/IE_Map_Raw.Rd b/man/IE_Map_Raw.Rd index a01f39ee3..7676e0795 100644 --- a/man/IE_Map_Raw.Rd +++ b/man/IE_Map_Raw.Rd @@ -18,7 +18,8 @@ IE_Map_Raw( \item \code{dfSUBJ}: \code{data.frame} Subject-level data with one record per subject. }} -\item{lMapping}{\code{list} Column metadata with structure \code{domain$key}, where \code{key} contains the name of the column.} +\item{lMapping}{\code{list} Column metadata with structure \code{domain$key}, where \code{key} contains the name +of the column.} \item{bReturnChecks}{\code{logical} Return input checks from \code{\link[=is_mapping_valid]{is_mapping_valid()}}? Default: \code{FALSE}} @@ -55,10 +56,10 @@ specific types of IE criteria by passing filtered IE data to \code{dfIE}. } \examples{ -# Run with defaults +# Run with defaults. dfInput <- IE_Map_Raw() -# Run with error checking and message log +# Run with error checking and message log. dfInput <- IE_Map_Raw(bReturnChecks = TRUE, bQuiet = FALSE) } diff --git a/man/PD_Assess.Rd b/man/PD_Assess.Rd index a12d49bb1..010733935 100644 --- a/man/PD_Assess.Rd +++ b/man/PD_Assess.Rd @@ -18,17 +18,25 @@ PD_Assess( \arguments{ \item{dfInput}{\code{data.frame} Input data, a data frame with one record per subject.} -\item{vThreshold}{\code{numeric} Threshold specification, a vector of length 2 that defaults to \code{c(-5, 5)} for \code{strMethod} = "poisson" and \code{c(.0001, NA)} for \code{strMethod} = "wilcoxon".} +\item{vThreshold}{\code{numeric} Threshold specification, a vector of length 2 that defaults to +\code{c(-5, 5)} for a Poisson model (\code{strMethod = "poisson"}) and \code{c(.0001, NA)} for a Wilcoxon +signed-rank test (\code{strMethod} = "wilcoxon").} -\item{strMethod}{\code{character} Statistical model. Valid values include "poisson" (default) and "wilcoxon".} +\item{strMethod}{\code{character} Statistical method. Valid values: +\itemize{ +\item \code{"poisson"} (default) +\item \code{"wilcoxon"} +}} -\item{strKRILabel}{\code{character} Describe the \code{KRI} column, a vector of length 1 that defaults to \code{PDs/Week}} +\item{strKRILabel}{\code{character} KRI description. Default: \code{"PDs/Week"}} -\item{lTags}{\code{list} Assessment tags, a named list of tags describing the assessment that defaults to \code{list(Assessment="PD")}. \code{lTags} is returned as part of the assessment (\code{lAssess$lTags}) and each tag is added as a column in \code{lAssess$dfSummary}.} +\item{lTags}{\code{list} Assessment tags, a named list of tags describing the assessment that defaults +to \code{list(Assessment = "PD")}. \code{lTags} is returned as part of the assessment (\code{lAssess$lTags}) +and each tag is added as a column in \code{lAssess$dfSummary}.} \item{bChart}{\code{logical} Generate data visualization? Default: \code{TRUE}} -\item{bReturnChecks}{\code{logical} Return input checks from \code{is_mapping_valid}? Default: \code{FALSE}} +\item{bReturnChecks}{\code{logical} Return input checks from \code{\link[=is_mapping_valid]{is_mapping_valid()}}? Default: \code{FALSE}} \item{bQuiet}{\code{logical} Suppress warning messages? Default: \code{TRUE}} } @@ -56,10 +64,10 @@ PD_Assess( } } \description{ -Flag sites that may be over- or under-reporting protocol deviations (PDs). +Evaluates protocol deviation (PD) rates to identify sites that may be over- or under-reporting PDs. } \details{ -The Protocol Deviation Assessment uses the standard \href{https://github.com/Gilead-BioStats/gsm/wiki/Data-Pipeline-Vignette}{GSM data pipeline} to flag possible outliers. Additional details regarding the data pipeline and statistical +The PD Assessment uses the standard \href{https://silver-potato-cfe8c2fb.pages.github.io/articles/DataPipeline.html}{GSM data pipeline} to flag possible outliers. Additional details regarding the data pipeline and statistical methods are described below. } \section{Data specification}{ diff --git a/man/PD_Map_Raw.Rd b/man/PD_Map_Raw.Rd index 4f44259fd..3fb273e9b 100644 --- a/man/PD_Map_Raw.Rd +++ b/man/PD_Map_Raw.Rd @@ -18,9 +18,10 @@ PD_Map_Raw( \item \code{dfSUBJ}: \code{data.frame} Subject-level data with one record per subject. }} -\item{lMapping}{\code{list} Column metadata with structure \code{domain$key}, where `key contains the name of the column.} +\item{lMapping}{\code{list} Column metadata with structure \code{domain$key}, where \code{key} contains the name +of the column.} -\item{bReturnChecks}{\code{logical} Return input checks from \code{is_mapping_valid}? Default: \code{FALSE}} +\item{bReturnChecks}{\code{logical} Return input checks from \code{\link[=is_mapping_valid]{is_mapping_valid()}}? Default: \code{FALSE}} \item{bQuiet}{\code{logical} Suppress warning messages? Default: \code{TRUE}} } @@ -37,7 +38,7 @@ Convert raw protocol deviation (PD) data, typically processed case report form d input data to \code{\link[=PD_Assess]{PD_Assess()}}. } \details{ -\code{PD_Map_Raw} combines PD data with subject-level treatment exposure data to create formatted +\code{PD_Map_Raw} combines PD data with subject-level study duration data to create formatted input data to \code{\link[=PD_Assess]{PD_Assess()}}. This function creates an input dataset for the PD Assessment (\code{\link[=PD_Assess]{PD_Assess()}}) by binding subject-level PD counts (derived from \code{dfPD}) to subject-level data (from \code{dfSUBJ}). Note that the function can generate data summaries for specific types of @@ -54,10 +55,10 @@ PDs by passing filtered PD data to \code{dfPD}. } \examples{ -# Run with defaults +# Run with defaults. dfInput <- PD_Map_Raw() -# Run with error checking and message log +# Run with error checking and message log. dfInput <- PD_Map_Raw(bReturnChecks = TRUE, bQuiet = FALSE) } diff --git a/tests/testthat/_snaps/AE_Assess.md b/tests/testthat/_snaps/AE_Assess.md index 1068fbb8d..c58d4eb53 100644 --- a/tests/testthat/_snaps/AE_Assess.md +++ b/tests/testthat/_snaps/AE_Assess.md @@ -28,23 +28,23 @@ --- - One or more of these columns: SubjectID, SiteID, Count, Exposure, and Rate not found in dfInput + dfInput is missing one or more of these columns: SubjectID, SiteID, Count, Exposure, and Rate --- - One or more of these columns: SubjectID, SiteID, Count, Exposure, and Rate not found in dfInput + dfInput is missing one or more of these columns: SubjectID, SiteID, Count, Exposure, and Rate --- - One or more of these columns: SubjectID, SiteID, Count, Exposure, and Rate not found in dfInput + dfInput is missing one or more of these columns: SubjectID, SiteID, Count, Exposure, and Rate --- - One or more of these columns: SubjectID, SiteID, Count, Exposure, and Rate not found in dfInput + dfInput is missing one or more of these columns: SubjectID, SiteID, Count, Exposure, and Rate --- - One or more of these columns: SubjectID, SiteID, Count, Exposure, and Rate not found in dfInput + dfInput is missing one or more of these columns: SubjectID, SiteID, Count, Exposure, and Rate # incorrect lTags throw errors @@ -60,19 +60,19 @@ --- - lTags cannot contain elements named: 'SiteID', 'N', 'Score', or 'Flag' + lTags cannot contain elements named: 'SiteID', 'N', 'KRI', 'KRILabel', 'Score', 'ScoreLabel', or 'Flag' --- - lTags cannot contain elements named: 'SiteID', 'N', 'Score', or 'Flag' + lTags cannot contain elements named: 'SiteID', 'N', 'KRI', 'KRILabel', 'Score', 'ScoreLabel', or 'Flag' --- - lTags cannot contain elements named: 'SiteID', 'N', 'Score', or 'Flag' + lTags cannot contain elements named: 'SiteID', 'N', 'KRI', 'KRILabel', 'Score', 'ScoreLabel', or 'Flag' --- - lTags cannot contain elements named: 'SiteID', 'N', 'Score', or 'Flag' + lTags cannot contain elements named: 'SiteID', 'N', 'KRI', 'KRILabel', 'Score', 'ScoreLabel', or 'Flag' # NA in dfInput$Count results in Error for assess_function diff --git a/tests/testthat/_snaps/PD_Assess.md b/tests/testthat/_snaps/PD_Assess.md index dd9c85623..9f215c4e6 100644 --- a/tests/testthat/_snaps/PD_Assess.md +++ b/tests/testthat/_snaps/PD_Assess.md @@ -28,23 +28,23 @@ --- - One or more of these columns: SubjectID, SiteID, Count, Exposure, and Rate not found in dfInput + dfInput is missing one or more of these columns: SubjectID, SiteID, Count, Exposure, and Rate --- - One or more of these columns: SubjectID, SiteID, Count, Exposure, and Rate not found in dfInput + dfInput is missing one or more of these columns: SubjectID, SiteID, Count, Exposure, and Rate --- - One or more of these columns: SubjectID, SiteID, Count, Exposure, and Rate not found in dfInput + dfInput is missing one or more of these columns: SubjectID, SiteID, Count, Exposure, and Rate --- - One or more of these columns: SubjectID, SiteID, Count, Exposure, and Rate not found in dfInput + dfInput is missing one or more of these columns: SubjectID, SiteID, Count, Exposure, and Rate --- - One or more of these columns: SubjectID, SiteID, Count, Exposure, and Rate not found in dfInput + dfInput is missing one or more of these columns: SubjectID, SiteID, Count, Exposure, and Rate # NA in dfInput$Count results in Error for assess_function diff --git a/vignettes/articles/ContributorGuidelines.Rmd b/vignettes/articles/ContributorGuidelines.Rmd index 9c1944452..5cbd87854 100644 --- a/vignettes/articles/ContributorGuidelines.Rmd +++ b/vignettes/articles/ContributorGuidelines.Rmd @@ -138,21 +138,21 @@ styler::style_dir('tests', recursive = TRUE, transformers = double_indent_style) This QC checklist is used as part of the development and release workflows described above. When applied to an Assessment, confirm that each function meets the requirements described. - [ ] Documentation - - [ ] Function name captured in [Roxygen title](https://cran.r-project.org/web/packages/roxygen2/vignettes/rd.html#the-description-block)(e.g. "Adverse Event Assessment") - - [ ] Assessment Purpose captured in [Roxygen description](https://cran.r-project.org/web/packages/roxygen2/vignettes/rd.html#the-description-block) (e.g. "Evaluates site-level level Adverse Event Rates and flags rates that are abnormally high or low." - - [ ] Input Data Requirements are described in the the [Roxygen details](https://cran.r-project.org/web/packages/roxygen2/vignettes/rd.html#the-description-block) under a Data section (`#' @details # Data Requirements`). - - [ ] Statistical Assumptions - (Assess() and Analyze() only) List the statistical methods used and refer to detailed description in Analyze function in a the [Roxygen details](https://cran.r-project.org/web/packages/roxygen2/vignettes/rd.html#the-description-block) under a Statistics section (`#' @details # Statistical Assumptions`). - - [ ] Parameters have detailed documentation using `@param`. Each parameter should include: parameter name, brief description, usage details, the default value (if any), is it required, list of valid options (if applicable) - - [ ] All external dependencies are captured. Use `@importFrom` when importing 3 or fewer functions, and use `@import` otherwise. - - [ ] Output Data Standards are described under `@returns` - - [ ] At least 1 example is provided under `@examples` + - [ ] Function name captured in [Roxygen title](https://cran.r-project.org/web/packages/roxygen2/vignettes/rd.html#the-description-block) (e.g. "Adverse Event Assessment") + - [ ] Assessment purpose captured in [Roxygen description](https://cran.r-project.org/web/packages/roxygen2/vignettes/rd.html#the-description-block) (e.g. "Evaluates adverse event (AE) rates to identify sites that may be over- or under-reporting AEs") + - [ ] Input data requirements are captured in a dedicated [Roxygen details section](https://cran.r-project.org/web/packages/roxygen2/vignettes/rd.html#sections) under _Data specification_ (`#' @section Data specification` or _# Data specification_ if storing data specification in a .md file). + - [ ] Statistical methods and assumptions are captured in a dedicated [Roxygen details section](https://cran.r-project.org/web/packages/roxygen2/vignettes/rd.html#sections) under _Statistical assumptions_ (`#' @section Statistical assumptions` or _# Statistical assumptions_ if storing statistical assumptions in a .md file). This section should link to the relevant `Analyze_` function(s) for further details. + - [ ] All function parameters are described with a [`@param` tag](https://cran.r-project.org/web/packages/roxygen2/vignettes/rd.html#functions). Each parameter description should include its name, type, purpose, usage details, default value (if any), requirement, and valid options (if applicable). + - [ ] All external dependencies are captured. Use `@importFrom _package_ _function_` when importing five or fewer functions and `@import _package_` otherwise. + - [ ] Function output is captured with a [`@return` tag](https://cran.r-project.org/web/packages/roxygen2/vignettes/rd.html#functions), including output type, structure, and data specification, if applicable. + - [ ] At least one example is provided under [`@examples` tag](https://cran.r-project.org/web/packages/roxygen2/vignettes/rd.html#functions). - [ ] Error Checking - - [ ] Basic checks for all all parameters should be included using `stopifnot()` or similar logic. (e.g. `stopifnot("dfInput is not a dataframe"=is.data.frame(dfInput))`) + - [ ] Basic checks for all parameters should be included using `stopifnot()` or similar logic (e.g. `stopifnot("dfInput is not a data frame" = is.data.frame(dfInput))`) - [ ] Tests confirm that `stopifnot()` parameter checks are working as expected. - - [ ] Tests confirm that the input data has required columns (if any) - - [ ] Tests confirm that the output data has the expected columns - - [ ] Tests confirm intended functionality for each parameter - - [ ] Tests confirm that missing data in required columns is handled appropriately and errors/warnings are produced if needed. + - [ ] Tests confirm that the input data has required columns (if any). + - [ ] Tests confirm that the output data has expected columns. + - [ ] Tests confirm intended functionality for each parameter. + - [ ] Tests confirm that missing data in required columns is handled appropriately and errors/warnings are produced if needed. - [ ] Basic QC - [ ] Assessment has User Requirements + Qualification tests captured using {valtools} framework. Report is generating as expected and all checks are passing. - [ ] Code is well commented and easy to read From f79acb0f50f0e23395707f92c2abf3c72171723a Mon Sep 17 00:00:00 2001 From: Matt Roumaya Date: Fri, 17 Jun 2022 20:24:05 +0000 Subject: [PATCH 87/87] qc updates --- R/Consent_Assess.R | 19 +++++++++------- R/IE_Assess.R | 22 +++++++++--------- R/IE_Map_Raw.R | 2 +- R/PD_Assess.R | 2 +- README.md | 4 ++-- man/Consent_Assess.Rd | 10 ++++----- man/IE_Assess.Rd | 13 +++++------ man/IE_Map_Raw.Rd | 2 +- tests/testthat/_snaps/AE_Assess.md | 8 +++++++ tests/testthat/_snaps/Consent_Assess.md | 30 ++++++++++++++++++++++--- tests/testthat/_snaps/IE_Assess.md | 16 +++++++++---- tests/testthat/_snaps/PD_Assess.md | 24 ++++++++++++++++++++ tests/testthat/test_AE_Assess.R | 2 ++ tests/testthat/test_Consent_Assess.R | 10 +++++---- tests/testthat/test_IE_Assess.R | 2 ++ tests/testthat/test_PD_Assess.R | 10 +++++---- 16 files changed, 126 insertions(+), 50 deletions(-) diff --git a/R/Consent_Assess.R b/R/Consent_Assess.R index 8dc3a37d8..c382a257f 100644 --- a/R/Consent_Assess.R +++ b/R/Consent_Assess.R @@ -1,7 +1,7 @@ #' Consent Assessment #' #' @description -#' Flag sites where subject consent was: +#' Evaluates sites where subject consent was: #' - not given #' - never obtained #' - not followed by subject randomization @@ -9,7 +9,7 @@ #' #' @details #' The Consent Assessment uses the standard [GSM data pipeline]( -#' https://github.com/Gilead-BioStats/gsm/wiki/Data-Pipeline-Vignette +#' https://silver-potato-cfe8c2fb.pages.github.io/articles/DataPipeline.html #' ) to flag sites with consent issues. This assessment detects sites with subjects who participated #' in study activities before consent was finalized. The count returned in the summary represents #' the number of subjects at a given site for whom: @@ -23,10 +23,10 @@ #' #' @param dfInput `data.frame` Input data, a data frame with one record per subject. #' @param nThreshold `numeric` Threshold specification. Default: `0.5` -#' @param lTags `list` Assessment tags, a named list of tags describing the assessment that defaults to `list(Assessment="IE")`. `lTags` is returned as part of the assessment (`lAssess$lTags`) and each tag is added as a column in `lAssess$dfSummary`. -#' @param strKRILabel `character` Describe the `KRI` column, a vector of length 1 that defaults to `Total Number of Consent Issues` +#' @param lTags `list` Assessment tags, a named list of tags describing the assessment that defaults to `list(Assessment = "Consent")`. `lTags` is returned as part of the assessment (`lAssess$lTags`) and each tag is added as a column in `lAssess$dfSummary`. +#' @param strKRILabel `character` KRI description. Default: `"Total Number of Consent Issues"` #' @param bChart `logical` Generate data visualization? Default: `TRUE` -#' @param bReturnChecks `logical` Return input checks from `is_mapping_valid`? Default: `FALSE` +#' @param bReturnChecks `logical` Return input checks from [gsm::is_mapping_valid()]? Default: `FALSE` #' @param bQuiet `logical` Suppress warning messages? Default: `TRUE` #' #' @return `list` Assessment, a named list with: @@ -65,17 +65,20 @@ Consent_Assess <- function( ) { stopifnot( "dfInput is not a data.frame" = is.data.frame(dfInput), - "One or more of these columns: SubjectID, SiteID,and Count not found in dfInput" = all(c("SubjectID", "SiteID", "Count") %in% names(dfInput)), + "dfInput is missing one or more of these columns: SubjectID, SiteID, and Count" = all(c("SubjectID", "SiteID", "Count") %in% names(dfInput)), "nThreshold must be numeric" = is.numeric(nThreshold), "nThreshold must be length 1" = length(nThreshold) == 1, - "strKRILabel must be length 1" = length(strKRILabel) == 1 + "strKRILabel must be length 1" = length(strKRILabel) == 1, + "bChart must be logical" = is.logical(bChart), + "bReturnChecks must be logical" = is.logical(bReturnChecks), + "bQuiet must be logical" = is.logical(bQuiet) ) if (!is.null(lTags)) { stopifnot( "lTags is not named" = (!is.null(names(lTags))), "lTags has unnamed elements" = all(names(lTags) != ""), - "lTags cannot contain elements named: 'SiteID', 'N', 'Score', or 'Flag'" = !names(lTags) %in% c("SiteID", "N", "Score", "Flag") + "lTags cannot contain elements named: 'SiteID', 'N', 'KRI', 'KRILabel', 'Score', 'ScoreLabel', or 'Flag'" = !names(lTags) %in% c("SiteID", "N", "KRI", "KRILabel", "Score", "ScoreLabel", "Flag") ) if (any(unname(purrr::map_dbl(lTags, ~ length(.))) > 1)) { diff --git a/R/IE_Assess.R b/R/IE_Assess.R index c713e24d6..d53029a7b 100644 --- a/R/IE_Assess.R +++ b/R/IE_Assess.R @@ -1,22 +1,21 @@ #' Inclusion/Exclusion Assessment #' #' @description -#' Flag sites exhibiting aberrant or excessive rates of unmet or missing inclusion/exclusion (IE) criteria. +#' Evaluates sites exhibiting aberrant or excessive rates of unmet or missing inclusion/exclusion (IE) criteria. #' #' @details #' The IE Assessment uses the standard [GSM data pipeline]( -#' https://github.com/Gilead-BioStats/gsm/wiki/Data-Pipeline-Vignette +#' https://silver-potato-cfe8c2fb.pages.github.io/articles/DataPipeline.html #' ) to flag sites with IE issues. This assessment detects sites with excessive rates of unmet or #' missing IE criteria, as defined by `nThreshold`. The count returned in the summary represents the -#' number of subjects at a given site with at least one unmet or missing IE criterion. Additional -#' details regarding the data pipeline and statistical methods are described below. +#' number of subjects at a given site with at least one unmet or missing IE criterion. #' #' @param dfInput `data.frame` Input data, a data frame with one record per subject. #' @param nThreshold `numeric` Threshold specification. Default: `0.5` -#' @param lTags `list` Assessment tags, a named list of tags describing the assessment that defaults to `list(Assessment="IE")`. `lTags` is returned as part of the assessment (`lAssess$lTags`) and each tag is added as a column in `lAssess$dfSummary`. -#' @param strKRILabel `character` Describe the `KRI` column, a vector of length 1 that defaults to `# of Inclusion/Exclusion Issues` +#' @param lTags `list` Assessment tags, a named list of tags describing the assessment that defaults to `list(Assessment = "IE")`. `lTags` is returned as part of the assessment (`lAssess$lTags`) and each tag is added as a column in `lAssess$dfSummary`. +#' @param strKRILabel `character` KRI description. Default: `"# of Inclusion/Exclusion Issues"` #' @param bChart `logical` Generate data visualization? Default: `TRUE` -#' @param bReturnChecks `logical` Return input checks from `is_mapping_valid`? Default: `FALSE` +#' @param bReturnChecks `logical` Return input checks from [gsm::is_mapping_valid()]? Default: `FALSE` #' @param bQuiet `logical` Suppress warning messages? Default: `TRUE` #' #' @return `list` Assessment, a named list with: @@ -56,17 +55,20 @@ IE_Assess <- function( ) { stopifnot( "dfInput is not a data.frame" = is.data.frame(dfInput), - "One or more of these columns: SubjectID, SiteID, Count, Exposure, and Rate not found in dfInput" = all(c("SubjectID", "SiteID", "Count") %in% names(dfInput)), + "dfInput is missing one or more of these columns: SubjectID, SiteID, and Count" = all(c("SubjectID", "SiteID", "Count") %in% names(dfInput)), "nThreshold must be numeric" = is.numeric(nThreshold), "nThreshold must be length 1" = length(nThreshold) == 1, - "strKRILabel must be length 1" = length(strKRILabel) == 1 + "strKRILabel must be length 1" = length(strKRILabel) == 1, + "bChart must be logical" = is.logical(bChart), + "bReturnChecks must be logical" = is.logical(bReturnChecks), + "bQuiet must be logical" = is.logical(bQuiet) ) if (!is.null(lTags)) { stopifnot( "lTags is not named" = (!is.null(names(lTags))), "lTags has unnamed elements" = all(names(lTags) != ""), - "lTags cannot contain elements named: 'SiteID', 'N', 'Score', or 'Flag'" = !names(lTags) %in% c("SiteID", "N", "Score", "Flag") + "lTags cannot contain elements named: 'SiteID', 'N', 'KRI', 'KRILabel', 'Score', 'ScoreLabel', or 'Flag'" = !names(lTags) %in% c("SiteID", "N", "KRI", "KRILabel", "Score", "ScoreLabel", "Flag") ) if (any(unname(purrr::map_dbl(lTags, ~ length(.))) > 1)) { diff --git a/R/IE_Map_Raw.R b/R/IE_Map_Raw.R index b500c35a0..eb49eda42 100644 --- a/R/IE_Map_Raw.R +++ b/R/IE_Map_Raw.R @@ -7,7 +7,7 @@ #' @details #' `IE_Map_Raw` combines IE data with subject-level data to create formatted input data to #' [gsm::IE_Assess()]. This function creates an input dataset for the IE Assessment -#' ($[gsm::IE_Assess()]) by binding subject-level unmet IE criteria counts (derived from `dfIE`) to +#' ([gsm::IE_Assess()]) by binding subject-level unmet IE criteria counts (derived from `dfIE`) to #' subject-level data (from `dfSUBJ`). Note that the function can generate data summaries for #' specific types of IE criteria by passing filtered IE data to `dfIE`. #' diff --git a/R/PD_Assess.R b/R/PD_Assess.R index 9f68797f2..815461462 100644 --- a/R/PD_Assess.R +++ b/R/PD_Assess.R @@ -76,7 +76,7 @@ PD_Assess <- function( stopifnot( "lTags is not named" = (!is.null(names(lTags))), "lTags has unnamed elements" = all(names(lTags) != ""), - "lTags cannot contain elements named: 'SiteID', 'N', 'Score', or 'Flag'" = !names(lTags) %in% c("SiteID", "N", "Score", "Flag") + "lTags cannot contain elements named: 'SiteID', 'N', 'KRI', 'KRILabel', 'Score', 'ScoreLabel', or 'Flag'" = !names(lTags) %in% c("SiteID", "N", "KRI", "KRILabel", "Score", "ScoreLabel", "Flag") ) if (any(unname(purrr::map_dbl(lTags, ~ length(.))) > 1)) { diff --git a/README.md b/README.md index 411ec6e0d..104184096 100644 --- a/README.md +++ b/README.md @@ -44,9 +44,9 @@ Since {gsm} is designed for use in a [GCP](https://en.wikipedia.org/wiki/Good_cl - **Qualification Workflow** - All assessments have been Qualified as described in the Qualification Workflow Vignette. A Qualification Report Vignette is generated and attached to each release. - **Unit Tests** - Unit tests are written for all core functions. - **Contributor Guidelines** - Detailed contributor guidelines including step-by-step processes for code development and releases are provided as a vignette. -- **Data Model** - Vignettes providing detailed descriptions of the data mode. +- **Data Model** - Vignettes providing detailed descriptions of the data model. - **Code Examples** - The Cookbook Vignette provides a series of simple examples, and all functions include examples as part of Roxygen documentation. -- **Code Review** - Code review is conducted using GitHub Pull requests, and a log of all PRs is included in the Qualification Report Vignette. +- **Code Review** - Code review is conducted using GitHub Pull Requests (PRs), and a log of all PRs is included in the Qualification Report Vignette. - **Function Documentation** - Detailed documentation for each function is maintained with Roxygen. - **Package Checks** - Standard package checks are run using GitHub Actions and must be passing before PRs are merged. - **Data Specifications** - Machine-readable data specifications are maintained for all KRIs. Specifications are automatically added to relevant function documentation. diff --git a/man/Consent_Assess.Rd b/man/Consent_Assess.Rd index 98c340ba4..50b53d3be 100644 --- a/man/Consent_Assess.Rd +++ b/man/Consent_Assess.Rd @@ -19,13 +19,13 @@ Consent_Assess( \item{nThreshold}{\code{numeric} Threshold specification. Default: \code{0.5}} -\item{lTags}{\code{list} Assessment tags, a named list of tags describing the assessment that defaults to \code{list(Assessment="IE")}. \code{lTags} is returned as part of the assessment (\code{lAssess$lTags}) and each tag is added as a column in \code{lAssess$dfSummary}.} +\item{lTags}{\code{list} Assessment tags, a named list of tags describing the assessment that defaults to \code{list(Assessment = "Consent")}. \code{lTags} is returned as part of the assessment (\code{lAssess$lTags}) and each tag is added as a column in \code{lAssess$dfSummary}.} -\item{strKRILabel}{\code{character} Describe the \code{KRI} column, a vector of length 1 that defaults to \verb{Total Number of Consent Issues}} +\item{strKRILabel}{\code{character} KRI description. Default: \code{"Total Number of Consent Issues"}} \item{bChart}{\code{logical} Generate data visualization? Default: \code{TRUE}} -\item{bReturnChecks}{\code{logical} Return input checks from \code{is_mapping_valid}? Default: \code{FALSE}} +\item{bReturnChecks}{\code{logical} Return input checks from \code{\link[=is_mapping_valid]{is_mapping_valid()}}? Default: \code{FALSE}} \item{bQuiet}{\code{logical} Suppress warning messages? Default: \code{TRUE}} } @@ -53,7 +53,7 @@ Consent_Assess( } } \description{ -Flag sites where subject consent was: +Evaluates sites where subject consent was: \itemize{ \item not given \item never obtained @@ -62,7 +62,7 @@ Flag sites where subject consent was: } } \details{ -The Consent Assessment uses the standard \href{https://github.com/Gilead-BioStats/gsm/wiki/Data-Pipeline-Vignette}{GSM data pipeline} to flag sites with consent issues. This assessment detects sites with subjects who participated +The Consent Assessment uses the standard \href{https://silver-potato-cfe8c2fb.pages.github.io/articles/DataPipeline.html}{GSM data pipeline} to flag sites with consent issues. This assessment detects sites with subjects who participated in study activities before consent was finalized. The count returned in the summary represents the number of subjects at a given site for whom: \itemize{ diff --git a/man/IE_Assess.Rd b/man/IE_Assess.Rd index fb5b9380e..733199d42 100644 --- a/man/IE_Assess.Rd +++ b/man/IE_Assess.Rd @@ -19,13 +19,13 @@ IE_Assess( \item{nThreshold}{\code{numeric} Threshold specification. Default: \code{0.5}} -\item{lTags}{\code{list} Assessment tags, a named list of tags describing the assessment that defaults to \code{list(Assessment="IE")}. \code{lTags} is returned as part of the assessment (\code{lAssess$lTags}) and each tag is added as a column in \code{lAssess$dfSummary}.} +\item{lTags}{\code{list} Assessment tags, a named list of tags describing the assessment that defaults to \code{list(Assessment = "IE")}. \code{lTags} is returned as part of the assessment (\code{lAssess$lTags}) and each tag is added as a column in \code{lAssess$dfSummary}.} -\item{strKRILabel}{\code{character} Describe the \code{KRI} column, a vector of length 1 that defaults to \verb{# of Inclusion/Exclusion Issues}} +\item{strKRILabel}{\code{character} KRI description. Default: \code{"# of Inclusion/Exclusion Issues"}} \item{bChart}{\code{logical} Generate data visualization? Default: \code{TRUE}} -\item{bReturnChecks}{\code{logical} Return input checks from \code{is_mapping_valid}? Default: \code{FALSE}} +\item{bReturnChecks}{\code{logical} Return input checks from \code{\link[=is_mapping_valid]{is_mapping_valid()}}? Default: \code{FALSE}} \item{bQuiet}{\code{logical} Suppress warning messages? Default: \code{TRUE}} } @@ -53,13 +53,12 @@ IE_Assess( } } \description{ -Flag sites exhibiting aberrant or excessive rates of unmet or missing inclusion/exclusion (IE) criteria. +Evaluates sites exhibiting aberrant or excessive rates of unmet or missing inclusion/exclusion (IE) criteria. } \details{ -The IE Assessment uses the standard \href{https://github.com/Gilead-BioStats/gsm/wiki/Data-Pipeline-Vignette}{GSM data pipeline} to flag sites with IE issues. This assessment detects sites with excessive rates of unmet or +The IE Assessment uses the standard \href{https://silver-potato-cfe8c2fb.pages.github.io/articles/DataPipeline.html}{GSM data pipeline} to flag sites with IE issues. This assessment detects sites with excessive rates of unmet or missing IE criteria, as defined by \code{nThreshold}. The count returned in the summary represents the -number of subjects at a given site with at least one unmet or missing IE criterion. Additional -details regarding the data pipeline and statistical methods are described below. +number of subjects at a given site with at least one unmet or missing IE criterion. } \section{Data specification}{ \tabular{lllll}{ diff --git a/man/IE_Map_Raw.Rd b/man/IE_Map_Raw.Rd index 7676e0795..16353eea6 100644 --- a/man/IE_Map_Raw.Rd +++ b/man/IE_Map_Raw.Rd @@ -40,7 +40,7 @@ input data to \code{\link[=IE_Assess]{IE_Assess()}}. \details{ \code{IE_Map_Raw} combines IE data with subject-level data to create formatted input data to \code{\link[=IE_Assess]{IE_Assess()}}. This function creates an input dataset for the IE Assessment -($\code{\link[=IE_Assess]{IE_Assess()}}) by binding subject-level unmet IE criteria counts (derived from \code{dfIE}) to +(\code{\link[=IE_Assess]{IE_Assess()}}) by binding subject-level unmet IE criteria counts (derived from \code{dfIE}) to subject-level data (from \code{dfSUBJ}). Note that the function can generate data summaries for specific types of IE criteria by passing filtered IE data to \code{dfIE}. } diff --git a/tests/testthat/_snaps/AE_Assess.md b/tests/testthat/_snaps/AE_Assess.md index c58d4eb53..5599fc252 100644 --- a/tests/testthat/_snaps/AE_Assess.md +++ b/tests/testthat/_snaps/AE_Assess.md @@ -74,6 +74,14 @@ lTags cannot contain elements named: 'SiteID', 'N', 'KRI', 'KRILabel', 'Score', 'ScoreLabel', or 'Flag' +--- + + lTags cannot contain elements named: 'SiteID', 'N', 'KRI', 'KRILabel', 'Score', 'ScoreLabel', or 'Flag' + +--- + + lTags cannot contain elements named: 'SiteID', 'N', 'KRI', 'KRILabel', 'Score', 'ScoreLabel', or 'Flag' + # NA in dfInput$Count results in Error for assess_function Code diff --git a/tests/testthat/_snaps/Consent_Assess.md b/tests/testthat/_snaps/Consent_Assess.md index 58c180ee0..7ada97083 100644 --- a/tests/testthat/_snaps/Consent_Assess.md +++ b/tests/testthat/_snaps/Consent_Assess.md @@ -16,15 +16,15 @@ --- - One or more of these columns: SubjectID, SiteID,and Count not found in dfInput + dfInput is missing one or more of these columns: SubjectID, SiteID, and Count --- - One or more of these columns: SubjectID, SiteID,and Count not found in dfInput + dfInput is missing one or more of these columns: SubjectID, SiteID, and Count --- - One or more of these columns: SubjectID, SiteID,and Count not found in dfInput + dfInput is missing one or more of these columns: SubjectID, SiteID, and Count # incorrect lTags throw errors @@ -38,6 +38,30 @@ lTags has unnamed elements +--- + + lTags cannot contain elements named: 'SiteID', 'N', 'KRI', 'KRILabel', 'Score', 'ScoreLabel', or 'Flag' + +--- + + lTags cannot contain elements named: 'SiteID', 'N', 'KRI', 'KRILabel', 'Score', 'ScoreLabel', or 'Flag' + +--- + + lTags cannot contain elements named: 'SiteID', 'N', 'KRI', 'KRILabel', 'Score', 'ScoreLabel', or 'Flag' + +--- + + lTags cannot contain elements named: 'SiteID', 'N', 'KRI', 'KRILabel', 'Score', 'ScoreLabel', or 'Flag' + +--- + + lTags cannot contain elements named: 'SiteID', 'N', 'KRI', 'KRILabel', 'Score', 'ScoreLabel', or 'Flag' + +--- + + lTags cannot contain elements named: 'SiteID', 'N', 'KRI', 'KRILabel', 'Score', 'ScoreLabel', or 'Flag' + # bQuiet and bReturnChecks work as intended Code diff --git a/tests/testthat/_snaps/IE_Assess.md b/tests/testthat/_snaps/IE_Assess.md index 23f0c0206..49d4e8bef 100644 --- a/tests/testthat/_snaps/IE_Assess.md +++ b/tests/testthat/_snaps/IE_Assess.md @@ -1,18 +1,26 @@ # incorrect lTags throw errors - lTags cannot contain elements named: 'SiteID', 'N', 'Score', or 'Flag' + lTags cannot contain elements named: 'SiteID', 'N', 'KRI', 'KRILabel', 'Score', 'ScoreLabel', or 'Flag' --- - lTags cannot contain elements named: 'SiteID', 'N', 'Score', or 'Flag' + lTags cannot contain elements named: 'SiteID', 'N', 'KRI', 'KRILabel', 'Score', 'ScoreLabel', or 'Flag' --- - lTags cannot contain elements named: 'SiteID', 'N', 'Score', or 'Flag' + lTags cannot contain elements named: 'SiteID', 'N', 'KRI', 'KRILabel', 'Score', 'ScoreLabel', or 'Flag' --- - lTags cannot contain elements named: 'SiteID', 'N', 'Score', or 'Flag' + lTags cannot contain elements named: 'SiteID', 'N', 'KRI', 'KRILabel', 'Score', 'ScoreLabel', or 'Flag' + +--- + + lTags cannot contain elements named: 'SiteID', 'N', 'KRI', 'KRILabel', 'Score', 'ScoreLabel', or 'Flag' + +--- + + lTags cannot contain elements named: 'SiteID', 'N', 'KRI', 'KRILabel', 'Score', 'ScoreLabel', or 'Flag' # bQuiet and bReturnChecks work as intended diff --git a/tests/testthat/_snaps/PD_Assess.md b/tests/testthat/_snaps/PD_Assess.md index 9f215c4e6..1f0e1b0f2 100644 --- a/tests/testthat/_snaps/PD_Assess.md +++ b/tests/testthat/_snaps/PD_Assess.md @@ -46,6 +46,30 @@ dfInput is missing one or more of these columns: SubjectID, SiteID, Count, Exposure, and Rate +# incorrect lTags throw errors + + lTags cannot contain elements named: 'SiteID', 'N', 'KRI', 'KRILabel', 'Score', 'ScoreLabel', or 'Flag' + +--- + + lTags cannot contain elements named: 'SiteID', 'N', 'KRI', 'KRILabel', 'Score', 'ScoreLabel', or 'Flag' + +--- + + lTags cannot contain elements named: 'SiteID', 'N', 'KRI', 'KRILabel', 'Score', 'ScoreLabel', or 'Flag' + +--- + + lTags cannot contain elements named: 'SiteID', 'N', 'KRI', 'KRILabel', 'Score', 'ScoreLabel', or 'Flag' + +--- + + lTags cannot contain elements named: 'SiteID', 'N', 'KRI', 'KRILabel', 'Score', 'ScoreLabel', or 'Flag' + +--- + + lTags cannot contain elements named: 'SiteID', 'N', 'KRI', 'KRILabel', 'Score', 'ScoreLabel', or 'Flag' + # NA in dfInput$Count results in Error for assess_function Code diff --git a/tests/testthat/test_AE_Assess.R b/tests/testthat/test_AE_Assess.R index ee1d8bc56..4d3df9ab8 100644 --- a/tests/testthat/test_AE_Assess.R +++ b/tests/testthat/test_AE_Assess.R @@ -67,6 +67,8 @@ test_that("incorrect lTags throw errors", { expect_snapshot_error(assess_function(dfInput, lTags = list(N = ""))) expect_snapshot_error(assess_function(dfInput, lTags = list(Score = ""))) expect_snapshot_error(assess_function(dfInput, lTags = list(Flag = ""))) + expect_snapshot_error(assess_function(dfInput, lTags = list(KRI = ""))) + expect_snapshot_error(assess_function(dfInput, lTags = list(KRILabel = ""))) }) # custom tests ------------------------------------------------------------ diff --git a/tests/testthat/test_Consent_Assess.R b/tests/testthat/test_Consent_Assess.R index be3cd102c..251006a50 100644 --- a/tests/testthat/test_Consent_Assess.R +++ b/tests/testthat/test_Consent_Assess.R @@ -50,10 +50,12 @@ test_that("incorrect lTags throw errors", { expect_snapshot_error(assess_function(dfInput, lTags = list("hi", "mom"))) expect_snapshot_error(assess_function(dfInput, lTags = list(greeting = "hi", "mom"))) expect_silent(assess_function(dfInput, lTags = list(greeting = "hi", person = "mom"))) - expect_error(assess_function(dfInput, lTags = list(SiteID = ""))) - expect_error(assess_function(dfInput, lTags = list(N = ""))) - expect_error(assess_function(dfInput, lTags = list(Score = ""))) - expect_error(assess_function(dfInput, lTags = list(Flag = ""))) + expect_snapshot_error(assess_function(dfInput, lTags = list(SiteID = ""))) + expect_snapshot_error(assess_function(dfInput, lTags = list(N = ""))) + expect_snapshot_error(assess_function(dfInput, lTags = list(Score = ""))) + expect_snapshot_error(assess_function(dfInput, lTags = list(Flag = ""))) + expect_snapshot_error(assess_function(dfInput, lTags = list(KRI = ""))) + expect_snapshot_error(assess_function(dfInput, lTags = list(KRILabel = ""))) }) diff --git a/tests/testthat/test_IE_Assess.R b/tests/testthat/test_IE_Assess.R index 5cfb67301..72a7a89b4 100644 --- a/tests/testthat/test_IE_Assess.R +++ b/tests/testthat/test_IE_Assess.R @@ -52,6 +52,8 @@ test_that("incorrect lTags throw errors", { expect_snapshot_error(assess_function(dfInput, lTags = list(N = ""))) expect_snapshot_error(assess_function(dfInput, lTags = list(Score = ""))) expect_snapshot_error(assess_function(dfInput, lTags = list(Flag = ""))) + expect_snapshot_error(assess_function(dfInput, lTags = list(KRI = ""))) + expect_snapshot_error(assess_function(dfInput, lTags = list(KRILabel = ""))) }) # custom tests ------------------------------------------------------------ diff --git a/tests/testthat/test_PD_Assess.R b/tests/testthat/test_PD_Assess.R index 7a882b092..d4d297a34 100644 --- a/tests/testthat/test_PD_Assess.R +++ b/tests/testthat/test_PD_Assess.R @@ -63,10 +63,12 @@ test_that("incorrect lTags throw errors", { ) ) ) - expect_error(assess_function(dfInput, lTags = list(SiteID = ""))) - expect_error(assess_function(dfInput, lTags = list(N = ""))) - expect_error(assess_function(dfInput, lTags = list(Score = ""))) - expect_error(assess_function(dfInput, lTags = list(Flag = ""))) + expect_snapshot_error(assess_function(dfInput, lTags = list(SiteID = ""))) + expect_snapshot_error(assess_function(dfInput, lTags = list(N = ""))) + expect_snapshot_error(assess_function(dfInput, lTags = list(Score = ""))) + expect_snapshot_error(assess_function(dfInput, lTags = list(Flag = ""))) + expect_snapshot_error(assess_function(dfInput, lTags = list(KRI = ""))) + expect_snapshot_error(assess_function(dfInput, lTags = list(KRILabel = ""))) }) # custom tests ------------------------------------------------------------