From 9e80a3d9ac72848a7d1f5ff103f236cde8c740d6 Mon Sep 17 00:00:00 2001 From: Anthony Sena Date: Wed, 28 Aug 2024 09:54:07 -0400 Subject: [PATCH] Reactivate all tests --- tests/testthat/test-EvidenceSynthesisModule.R | 602 +++++++++--------- tests/testthat/test-Execution.R | 426 ++++++------- 2 files changed, 517 insertions(+), 511 deletions(-) diff --git a/tests/testthat/test-EvidenceSynthesisModule.R b/tests/testthat/test-EvidenceSynthesisModule.R index cf86eb17..6833e0c0 100644 --- a/tests/testthat/test-EvidenceSynthesisModule.R +++ b/tests/testthat/test-EvidenceSynthesisModule.R @@ -109,304 +109,310 @@ test_that("Run module", { expect_true("es_sccs_result.csv" %in% resultsFiles) expect_true("es_sccs_diagnostics_summary.csv" %in% resultsFiles) }) -# -# test_that("Skipped analyses as specified", { -# # We specified we didn't want cohort method analysis ID 2 in evidence synthesis ID 2: -# results <- CohortGenerator::readCsv(file.path(testResultsFolder, "es_cm_result.csv")) -# expect_false(any(results$evidenceSynthesisAnalysisId == 2 & results$analysisId == 2)) -# -# results <- CohortGenerator::readCsv(file.path(testResultsFolder, "es_sccs_result.csv")) -# expect_false(any(results$evidenceSynthesisAnalysisId == 2 & results$analysisId == 2)) -# }) -# -# getApproximation <- function(setting) { -# tibble( -# evidenceSynthesisAnalysisId = setting$evidenceSynthesisAnalysisId, -# likelihoodApproximation = setting$evidenceSynthesisSource$likelihoodApproximation -# ) %>% -# return() -# } -# -# getDatabaseIds <- function(setting, databaseIds) { -# if (!is.null(setting$evidenceSynthesisSource$databaseIds)) { -# databaseIds <- setting$evidenceSynthesisSource$databaseIds -# } -# tibble( -# evidenceSynthesisAnalysisId = setting$evidenceSynthesisAnalysisId, -# databaseId = databaseIds -# ) %>% -# return() -# } -# -# test_that("Include only allowed CM estimates in meta-analysis", { -# # Should only include estimates in meta-analysis that are -# # 1. Either unblinded or not outcome of interest -# # 2. Has a valid estimate (normal approx) or LL profile (adaptive grid) -# # 3. Is not excluded in createEvidenceSynthesisSource() -# connection <- DatabaseConnector::connect(esTestDataConnectionDetails) -# on.exit(DatabaseConnector::disconnect(connection)) -# -# # Determine if unblinded: -# sql <- " -# SELECT cm_target_comparator_outcome.target_id, -# cm_target_comparator_outcome.comparator_id, -# cm_target_comparator_outcome.outcome_id, -# analysis_id, -# database_id, -# unblind AS include_1 -# FROM main.cm_target_comparator_outcome -# LEFT JOIN main.cm_diagnostics_summary -# ON cm_diagnostics_summary.target_id = cm_target_comparator_outcome.target_id -# AND cm_diagnostics_summary.comparator_id = cm_target_comparator_outcome.comparator_id -# AND cm_diagnostics_summary.outcome_id = cm_target_comparator_outcome.outcome_id; -# " -# criterion1 <- DatabaseConnector::querySql(connection, sql, snakeCaseToCamelCase = TRUE) -# # Must have some blinded results for this test to work: -# expect_gt(sum(criterion1$include1 == 0), 0) -# -# # Determine if valid estimate or LL profile: -# approximations <- bind_rows(lapply(jobContext$settings$evidenceSynthesisAnalysisList, getApproximation)) -# sql <- " -# SELECT cm_result.target_id, -# cm_result.comparator_id, -# cm_result.outcome_id, -# cm_result.analysis_id, -# cm_result.database_id, -# CASE -# WHEN log_rr IS NOT NULL AND se_log_rr IS NOT NULL THEN 1 -# ELSE 0 -# END AS has_valid_estimate, -# CASE -# WHEN profiles.target_id IS NOT NULL THEN 1 -# ELSE 0 -# END AS has_ll_profile -# FROM main.cm_result -# LEFT JOIN ( -# SELECT DISTINCT target_id, -# comparator_id, -# outcome_id, -# analysis_id, -# database_id -# FROM main.cm_likelihood_profile -# ) profiles -# ON cm_result.target_id = profiles.target_id -# AND cm_result.comparator_id = profiles.comparator_id -# AND cm_result.outcome_id = profiles.outcome_id -# AND cm_result.analysis_id = profiles.analysis_id -# AND cm_result.database_id = profiles.database_id -# " -# criterion2 <- DatabaseConnector::querySql(connection, sql, snakeCaseToCamelCase = TRUE) %>% -# cross_join(approximations) %>% -# mutate(include2 = if_else(likelihoodApproximation == "normal", -# hasValidEstimate, -# hasLlProfile -# )) -# -# # Determine if database was excluded in createEvidenceSynthesisSource(): -# databaseIds <- unique(criterion2$databaseId) -# criterion3 <- bind_rows(lapply(jobContext$settings$evidenceSynthesisAnalysisList, getDatabaseIds, databaseIds = databaseIds)) %>% -# mutate(include3 = 1) -# -# # Combine all criteria, and check if agree with results: -# allowed <- criterion1 %>% -# inner_join(criterion2, -# by = join_by(targetId, comparatorId, outcomeId, analysisId, databaseId), -# relationship = "one-to-many" -# ) %>% -# inner_join(criterion3, by = join_by(databaseId, evidenceSynthesisAnalysisId)) %>% -# mutate(include = include1 & include2 & include3) %>% -# group_by(targetId, comparatorId, outcomeId, analysisId, evidenceSynthesisAnalysisId) %>% -# summarize(nAllowed = sum(include), .groups = "drop") -# -# results <- CohortGenerator::readCsv(file.path(testResultsFolder, "EvidenceSynthesisModule", "es_cm_result.csv")) -# results <- results %>% -# left_join(allowed, by = join_by(targetId, comparatorId, outcomeId, analysisId, evidenceSynthesisAnalysisId)) -# expect_true(all(results$nDatabases == results$nAllowed)) -# }) -# -# test_that("Include only allowed SCCS estimates in meta-analysis", { -# # Should only include estimates in meta-analysis that are -# # 1. Unblinded. -# # 2. Has a valid estimate (normal approx) or LL profile (adaptive grid) -# # 3. Is not excluded in createEvidenceSynthesisSource() -# connection <- DatabaseConnector::connect(esTestDataConnectionDetails) -# on.exit(DatabaseConnector::disconnect(connection)) -# -# # Determine if unblinded or true effect size is known: -# sql <- " -# SELECT sccs_diagnostics_summary.exposures_outcome_set_id, -# sccs_diagnostics_summary.covariate_id, -# sccs_diagnostics_summary.analysis_id, -# sccs_diagnostics_summary.database_id, -# unblind AS include_1 -# FROM main.sccs_exposure -# INNER JOIN main.sccs_diagnostics_summary -# ON sccs_exposure.exposures_outcome_set_id = sccs_diagnostics_summary.exposures_outcome_set_id -# INNER JOIN main.sccs_covariate -# ON sccs_exposure.era_id = sccs_covariate.era_id -# AND sccs_covariate.covariate_id = sccs_diagnostics_summary.covariate_id -# AND sccs_covariate.exposures_outcome_set_id = sccs_diagnostics_summary.exposures_outcome_set_id -# AND sccs_covariate.analysis_id = sccs_diagnostics_summary.analysis_id -# AND sccs_covariate.database_id = sccs_diagnostics_summary.database_id; -# " -# criterion1 <- DatabaseConnector::querySql(connection, sql, snakeCaseToCamelCase = TRUE) -# # Must have some blinded results for this test to work: -# expect_gt(sum(criterion1$include1 == 0), 0) -# -# # Determine if valid estimate or LL profile: -# approximations <- bind_rows(lapply(jobContext$settings$evidenceSynthesisAnalysisList, getApproximation)) -# sql <- " -# SELECT sccs_result.exposures_outcome_set_id, -# sccs_result.covariate_id, -# sccs_result.analysis_id, -# sccs_result.database_id, -# CASE -# WHEN log_rr IS NOT NULL AND se_log_rr IS NOT NULL THEN 1 -# ELSE 0 -# END AS has_valid_estimate, -# CASE -# WHEN profiles.exposures_outcome_set_id IS NOT NULL THEN 1 -# ELSE 0 -# END AS has_ll_profile -# FROM main.sccs_result -# LEFT JOIN ( -# SELECT DISTINCT exposures_outcome_set_id, -# covariate_id, -# analysis_id, -# database_id -# FROM main.sccs_likelihood_profile -# ) profiles -# ON sccs_result.exposures_outcome_set_id = profiles.exposures_outcome_set_id -# AND sccs_result.covariate_id = profiles.covariate_id -# AND sccs_result.analysis_id = profiles.analysis_id -# AND sccs_result.database_id = profiles.database_id -# " -# criterion2 <- DatabaseConnector::querySql(connection, sql, snakeCaseToCamelCase = TRUE) %>% -# cross_join(approximations) %>% -# mutate(include2 = if_else(likelihoodApproximation == "normal", -# hasValidEstimate, -# hasLlProfile -# )) -# -# # Determine if database was excluded in createEvidenceSynthesisSource(): -# databaseIds <- unique(criterion2$databaseId) -# criterion3 <- bind_rows(lapply(jobContext$settings$evidenceSynthesisAnalysisList, getDatabaseIds, databaseIds = databaseIds)) %>% -# mutate(include3 = 1) -# -# # Combine all criteria, and check if agree with results: -# allowed <- criterion1 %>% -# inner_join(criterion2, -# by = join_by(exposuresOutcomeSetId, covariateId, analysisId, databaseId), -# relationship = "one-to-many" -# ) %>% -# inner_join(criterion3, by = join_by(databaseId, evidenceSynthesisAnalysisId)) %>% -# mutate(include = include1 & include2 & include3) %>% -# group_by(exposuresOutcomeSetId, covariateId, analysisId, evidenceSynthesisAnalysisId) %>% -# summarize(nAllowed = sum(include), .groups = "drop") -# -# results <- CohortGenerator::readCsv(file.path(testResultsFolder, "EvidenceSynthesisModule", "es_sccs_result.csv")) -# results <- results %>% -# left_join(allowed, by = join_by(exposuresOutcomeSetId, covariateId, analysisId, evidenceSynthesisAnalysisId)) -# expect_true(all(results$nDatabases == results$nAllowed)) -# }) -# -# test_that("Output conforms to results model", { -# model <- CohortGenerator::readCsv(file.path(testResultsFolder, "EvidenceSynthesisModule", "resultsDataModelSpecification.csv")) -# tables <- unique(model$tableName) -# for (table in tables) { -# data <- readr::read_csv(file.path(testResultsFolder, "EvidenceSynthesisModule", sprintf("%s.csv", table)), show_col_types = FALSE) -# observed <- colnames(data) -# observed <- sort(observed) -# expected <- model$columnName[model$tableName == table] -# expected <- sort(expected) -# expect_equal(observed, expected) -# } -# }) -# -# test_that("Check MDRR values", { -# # CohortMethod -# results <- CohortGenerator::readCsv(file.path(testResultsFolder, "EvidenceSynthesisModule", "es_cm_result.csv")) -# diagnostics <- CohortGenerator::readCsv(file.path(testResultsFolder, "EvidenceSynthesisModule", "es_cm_diagnostics_summary.csv")) -# combined <- results %>% -# inner_join(diagnostics, by = join_by(targetId, comparatorId, outcomeId, analysisId, evidenceSynthesisAnalysisId)) -# noDbs <- combined %>% -# filter(nDatabases == 0) -# expect_true(all(is.infinite(noDbs$mdrr))) -# expect_true(all(noDbs$mdrrDiagnostic == "FAIL")) -# expect_true(all(noDbs$unblind == 0)) -# -# oneDb <- combined %>% -# filter(nDatabases == 1) -# # All per-DB MDRRs were set to 2 in simulation code: -# expect_true(all(oneDb$mdrr == 2)) -# expect_true(all(oneDb$mdrrDiagnostic == "PASS")) -# -# multiDbs <- combined %>% -# filter(nDatabases > 1, !is.na(seLogRr)) -# -# expect_true(all(!is.na(multiDbs$mdrr))) -# -# # SCCS -# results <- CohortGenerator::readCsv(file.path(testResultsFolder, "EvidenceSynthesisModule", "es_sccs_result.csv")) -# diagnostics <- CohortGenerator::readCsv(file.path(testResultsFolder, "EvidenceSynthesisModule", "es_sccs_diagnostics_summary.csv")) -# combined <- results %>% -# inner_join(diagnostics, by = join_by(analysisId, exposuresOutcomeSetId, covariateId, evidenceSynthesisAnalysisId)) -# noDbs <- combined %>% -# filter(nDatabases == 0) -# expect_true(all(is.infinite(noDbs$mdrr))) -# expect_true(all(noDbs$mdrrDiagnostic == "FAIL")) -# expect_true(all(noDbs$unblind == 0)) -# -# oneDb <- combined %>% -# filter(nDatabases == 1) -# # All per-DB MDRRs were set to 2 in simulation code: -# expect_true(all(oneDb$mdrr == 2)) -# expect_true(all(oneDb$mdrrDiagnostic == "PASS")) -# -# multiDbs <- combined %>% -# filter(nDatabases > 1, !is.na(seLogRr)) -# -# expect_true(all(!is.na(multiDbs$mdrr))) -# }) -# -# test_that("Don't error when no negative controls present", { -# # Create dataset without negative controls -# tempFile <- tempfile(fileext = ".sqlite") -# file.copy(system.file("testdata/esmodule/results.sqlite", package = "Strategus"), tempFile) -# on.exit(unlink(tempFile)) -# tempConnectionDetails <- DatabaseConnector::createConnectionDetails( -# dbms = "sqlite", -# server = tempFile -# ) -# connection <- DatabaseConnector::connect(tempConnectionDetails) -# DatabaseConnector::renderTranslateExecuteSql(connection, "UPDATE cm_target_comparator_outcome SET true_effect_size = NULL;") -# DatabaseConnector::disconnect(connection) -# -# # tempJobContext <- jobContext -# # tempJobContext$settings$evidenceSynthesisAnalysisList <- list(tempJobContext$settings$evidenceSynthesisAnalysisList[[1]]) -# # tempJobContext$moduleExecutionSettings$resultsConnectionDetails <- tempConnectionDetails -# # execute(tempJobContext) -# -# esAnalysisSpecifications <- createEsModuleSpecs() -# esAnalysisSpecifications$moduleSpecifications[[1]]$settings$evidenceSynthesisAnalysisList <- list(esAnalysisSpecifications$moduleSpecifications[[1]]$settings$evidenceSynthesisAnalysisList[[1]]) -# resultsExecutionSettings <- Strategus::createResultsExecutionSettings( -# resultsDatabaseSchema = "main", -# resultsFolder = testResultsFolder, -# workFolder = workFolder -# ) -# Strategus::execute( -# analysisSpecifications = esAnalysisSpecifications, -# executionSettings = resultsExecutionSettings, -# connectionDetails = tempConnectionDetails -# ) -# -# estimates <- readr::read_csv(file.path(testResultsFolder, "EvidenceSynthesisModule", "es_cm_result.csv"), show_col_types = FALSE) -# expect_gt(nrow(estimates), 0) -# expect_true(all(is.na(estimates$calibrated_rr))) -# }) -# -# -# # readr::write_csv(OhdsiRTools::createResultsSchemaStub(testResultsFolder), "resultsDataModelSpecification.csv") + +test_that("Skipped analyses as specified", { + # We specified we didn't want cohort method analysis ID 2 in evidence synthesis ID 2: + results <- CohortGenerator::readCsv(file.path(testResultsFolder, "es_cm_result.csv")) + expect_false(any(results$evidenceSynthesisAnalysisId == 2 & results$analysisId == 2)) + + results <- CohortGenerator::readCsv(file.path(testResultsFolder, "es_sccs_result.csv")) + expect_false(any(results$evidenceSynthesisAnalysisId == 2 & results$analysisId == 2)) +}) + +getApproximation <- function(setting) { + tibble( + evidenceSynthesisAnalysisId = setting$evidenceSynthesisAnalysisId, + likelihoodApproximation = setting$evidenceSynthesisSource$likelihoodApproximation + ) %>% + return() +} + +getDatabaseIds <- function(setting, databaseIds) { + if (!is.null(setting$evidenceSynthesisSource$databaseIds)) { + databaseIds <- setting$evidenceSynthesisSource$databaseIds + } + tibble( + evidenceSynthesisAnalysisId = setting$evidenceSynthesisAnalysisId, + databaseId = databaseIds + ) %>% + return() +} + +test_that("Include only allowed CM estimates in meta-analysis", { + # Should only include estimates in meta-analysis that are + # 1. Either unblinded or not outcome of interest + # 2. Has a valid estimate (normal approx) or LL profile (adaptive grid) + # 3. Is not excluded in createEvidenceSynthesisSource() + connection <- DatabaseConnector::connect(esTestDataConnectionDetails) + on.exit(DatabaseConnector::disconnect(connection)) + + esAnalysisSpecifications <- createEsModuleSpecs() + esSettings <- esAnalysisSpecifications$moduleSpecifications[[1]]$settings + + # Determine if unblinded: + sql <- " + SELECT cm_target_comparator_outcome.target_id, + cm_target_comparator_outcome.comparator_id, + cm_target_comparator_outcome.outcome_id, + analysis_id, + database_id, + unblind AS include_1 + FROM main.cm_target_comparator_outcome + LEFT JOIN main.cm_diagnostics_summary + ON cm_diagnostics_summary.target_id = cm_target_comparator_outcome.target_id + AND cm_diagnostics_summary.comparator_id = cm_target_comparator_outcome.comparator_id + AND cm_diagnostics_summary.outcome_id = cm_target_comparator_outcome.outcome_id; + " + criterion1 <- DatabaseConnector::querySql(connection, sql, snakeCaseToCamelCase = TRUE) + # Must have some blinded results for this test to work: + expect_gt(sum(criterion1$include1 == 0), 0) + + # Determine if valid estimate or LL profile: + approximations <- bind_rows(lapply(esSettings$evidenceSynthesisAnalysisList, getApproximation)) + sql <- " + SELECT cm_result.target_id, + cm_result.comparator_id, + cm_result.outcome_id, + cm_result.analysis_id, + cm_result.database_id, + CASE + WHEN log_rr IS NOT NULL AND se_log_rr IS NOT NULL THEN 1 + ELSE 0 + END AS has_valid_estimate, + CASE + WHEN profiles.target_id IS NOT NULL THEN 1 + ELSE 0 + END AS has_ll_profile + FROM main.cm_result + LEFT JOIN ( + SELECT DISTINCT target_id, + comparator_id, + outcome_id, + analysis_id, + database_id + FROM main.cm_likelihood_profile + ) profiles + ON cm_result.target_id = profiles.target_id + AND cm_result.comparator_id = profiles.comparator_id + AND cm_result.outcome_id = profiles.outcome_id + AND cm_result.analysis_id = profiles.analysis_id + AND cm_result.database_id = profiles.database_id + " + criterion2 <- DatabaseConnector::querySql(connection, sql, snakeCaseToCamelCase = TRUE) %>% + cross_join(approximations) %>% + mutate(include2 = if_else(likelihoodApproximation == "normal", + hasValidEstimate, + hasLlProfile + )) + + # Determine if database was excluded in createEvidenceSynthesisSource(): + databaseIds <- unique(criterion2$databaseId) + criterion3 <- bind_rows(lapply(esSettings$evidenceSynthesisAnalysisList, getDatabaseIds, databaseIds = databaseIds)) %>% + mutate(include3 = 1) + + # Combine all criteria, and check if agree with results: + allowed <- criterion1 %>% + inner_join(criterion2, + by = join_by(targetId, comparatorId, outcomeId, analysisId, databaseId), + relationship = "one-to-many" + ) %>% + inner_join(criterion3, by = join_by(databaseId, evidenceSynthesisAnalysisId)) %>% + mutate(include = include1 & include2 & include3) %>% + group_by(targetId, comparatorId, outcomeId, analysisId, evidenceSynthesisAnalysisId) %>% + summarize(nAllowed = sum(include), .groups = "drop") + + results <- CohortGenerator::readCsv(file.path(testResultsFolder, "EvidenceSynthesisModule", "es_cm_result.csv")) + results <- results %>% + left_join(allowed, by = join_by(targetId, comparatorId, outcomeId, analysisId, evidenceSynthesisAnalysisId)) + expect_true(all(results$nDatabases == results$nAllowed)) +}) + +test_that("Include only allowed SCCS estimates in meta-analysis", { + # Should only include estimates in meta-analysis that are + # 1. Unblinded. + # 2. Has a valid estimate (normal approx) or LL profile (adaptive grid) + # 3. Is not excluded in createEvidenceSynthesisSource() + connection <- DatabaseConnector::connect(esTestDataConnectionDetails) + on.exit(DatabaseConnector::disconnect(connection)) + + esAnalysisSpecifications <- createEsModuleSpecs() + esSettings <- esAnalysisSpecifications$moduleSpecifications[[1]]$settings + + # Determine if unblinded or true effect size is known: + sql <- " + SELECT sccs_diagnostics_summary.exposures_outcome_set_id, + sccs_diagnostics_summary.covariate_id, + sccs_diagnostics_summary.analysis_id, + sccs_diagnostics_summary.database_id, + unblind AS include_1 + FROM main.sccs_exposure + INNER JOIN main.sccs_diagnostics_summary + ON sccs_exposure.exposures_outcome_set_id = sccs_diagnostics_summary.exposures_outcome_set_id + INNER JOIN main.sccs_covariate + ON sccs_exposure.era_id = sccs_covariate.era_id + AND sccs_covariate.covariate_id = sccs_diagnostics_summary.covariate_id + AND sccs_covariate.exposures_outcome_set_id = sccs_diagnostics_summary.exposures_outcome_set_id + AND sccs_covariate.analysis_id = sccs_diagnostics_summary.analysis_id + AND sccs_covariate.database_id = sccs_diagnostics_summary.database_id; + " + criterion1 <- DatabaseConnector::querySql(connection, sql, snakeCaseToCamelCase = TRUE) + # Must have some blinded results for this test to work: + expect_gt(sum(criterion1$include1 == 0), 0) + + # Determine if valid estimate or LL profile: + approximations <- bind_rows(lapply(esSettings$evidenceSynthesisAnalysisList, getApproximation)) + sql <- " + SELECT sccs_result.exposures_outcome_set_id, + sccs_result.covariate_id, + sccs_result.analysis_id, + sccs_result.database_id, + CASE + WHEN log_rr IS NOT NULL AND se_log_rr IS NOT NULL THEN 1 + ELSE 0 + END AS has_valid_estimate, + CASE + WHEN profiles.exposures_outcome_set_id IS NOT NULL THEN 1 + ELSE 0 + END AS has_ll_profile + FROM main.sccs_result + LEFT JOIN ( + SELECT DISTINCT exposures_outcome_set_id, + covariate_id, + analysis_id, + database_id + FROM main.sccs_likelihood_profile + ) profiles + ON sccs_result.exposures_outcome_set_id = profiles.exposures_outcome_set_id + AND sccs_result.covariate_id = profiles.covariate_id + AND sccs_result.analysis_id = profiles.analysis_id + AND sccs_result.database_id = profiles.database_id + " + criterion2 <- DatabaseConnector::querySql(connection, sql, snakeCaseToCamelCase = TRUE) %>% + cross_join(approximations) %>% + mutate(include2 = if_else(likelihoodApproximation == "normal", + hasValidEstimate, + hasLlProfile + )) + + # Determine if database was excluded in createEvidenceSynthesisSource(): + databaseIds <- unique(criterion2$databaseId) + criterion3 <- bind_rows(lapply(esSettings$evidenceSynthesisAnalysisList, getDatabaseIds, databaseIds = databaseIds)) %>% + mutate(include3 = 1) + + # Combine all criteria, and check if agree with results: + allowed <- criterion1 %>% + inner_join(criterion2, + by = join_by(exposuresOutcomeSetId, covariateId, analysisId, databaseId), + relationship = "one-to-many" + ) %>% + inner_join(criterion3, by = join_by(databaseId, evidenceSynthesisAnalysisId)) %>% + mutate(include = include1 & include2 & include3) %>% + group_by(exposuresOutcomeSetId, covariateId, analysisId, evidenceSynthesisAnalysisId) %>% + summarize(nAllowed = sum(include), .groups = "drop") + + results <- CohortGenerator::readCsv(file.path(testResultsFolder, "EvidenceSynthesisModule", "es_sccs_result.csv")) + results <- results %>% + left_join(allowed, by = join_by(exposuresOutcomeSetId, covariateId, analysisId, evidenceSynthesisAnalysisId)) + expect_true(all(results$nDatabases == results$nAllowed)) +}) + +test_that("Output conforms to results model", { + model <- CohortGenerator::readCsv(file.path(testResultsFolder, "EvidenceSynthesisModule", "resultsDataModelSpecification.csv")) + tables <- unique(model$tableName) + for (table in tables) { + data <- readr::read_csv(file.path(testResultsFolder, "EvidenceSynthesisModule", sprintf("%s.csv", table)), show_col_types = FALSE) + observed <- colnames(data) + observed <- sort(observed) + expected <- model$columnName[model$tableName == table] + expected <- sort(expected) + expect_equal(observed, expected) + } +}) + +test_that("Check MDRR values", { + # CohortMethod + results <- CohortGenerator::readCsv(file.path(testResultsFolder, "EvidenceSynthesisModule", "es_cm_result.csv")) + diagnostics <- CohortGenerator::readCsv(file.path(testResultsFolder, "EvidenceSynthesisModule", "es_cm_diagnostics_summary.csv")) + combined <- results %>% + inner_join(diagnostics, by = join_by(targetId, comparatorId, outcomeId, analysisId, evidenceSynthesisAnalysisId)) + noDbs <- combined %>% + filter(nDatabases == 0) + expect_true(all(is.infinite(noDbs$mdrr))) + expect_true(all(noDbs$mdrrDiagnostic == "FAIL")) + expect_true(all(noDbs$unblind == 0)) + + oneDb <- combined %>% + filter(nDatabases == 1) + # All per-DB MDRRs were set to 2 in simulation code: + expect_true(all(oneDb$mdrr == 2)) + expect_true(all(oneDb$mdrrDiagnostic == "PASS")) + + multiDbs <- combined %>% + filter(nDatabases > 1, !is.na(seLogRr)) + + expect_true(all(!is.na(multiDbs$mdrr))) + + # SCCS + results <- CohortGenerator::readCsv(file.path(testResultsFolder, "EvidenceSynthesisModule", "es_sccs_result.csv")) + diagnostics <- CohortGenerator::readCsv(file.path(testResultsFolder, "EvidenceSynthesisModule", "es_sccs_diagnostics_summary.csv")) + combined <- results %>% + inner_join(diagnostics, by = join_by(analysisId, exposuresOutcomeSetId, covariateId, evidenceSynthesisAnalysisId)) + noDbs <- combined %>% + filter(nDatabases == 0) + expect_true(all(is.infinite(noDbs$mdrr))) + expect_true(all(noDbs$mdrrDiagnostic == "FAIL")) + expect_true(all(noDbs$unblind == 0)) + + oneDb <- combined %>% + filter(nDatabases == 1) + # All per-DB MDRRs were set to 2 in simulation code: + expect_true(all(oneDb$mdrr == 2)) + expect_true(all(oneDb$mdrrDiagnostic == "PASS")) + + multiDbs <- combined %>% + filter(nDatabases > 1, !is.na(seLogRr)) + + expect_true(all(!is.na(multiDbs$mdrr))) +}) + +test_that("Don't error when no negative controls present", { + # Create dataset without negative controls + tempFile <- tempfile(fileext = ".sqlite") + file.copy(system.file("testdata/esmodule/results.sqlite", package = "Strategus"), tempFile) + on.exit(unlink(tempFile)) + tempConnectionDetails <- DatabaseConnector::createConnectionDetails( + dbms = "sqlite", + server = tempFile + ) + connection <- DatabaseConnector::connect(tempConnectionDetails) + DatabaseConnector::renderTranslateExecuteSql(connection, "UPDATE cm_target_comparator_outcome SET true_effect_size = NULL;") + DatabaseConnector::disconnect(connection) + + # tempJobContext <- jobContext + # tempJobContext$settings$evidenceSynthesisAnalysisList <- list(tempJobContext$settings$evidenceSynthesisAnalysisList[[1]]) + # tempJobContext$moduleExecutionSettings$resultsConnectionDetails <- tempConnectionDetails + # execute(tempJobContext) + + esAnalysisSpecifications <- createEsModuleSpecs() + esAnalysisSpecifications$moduleSpecifications[[1]]$settings$evidenceSynthesisAnalysisList <- list(esAnalysisSpecifications$moduleSpecifications[[1]]$settings$evidenceSynthesisAnalysisList[[1]]) + resultsExecutionSettings <- Strategus::createResultsExecutionSettings( + resultsDatabaseSchema = "main", + resultsFolder = testResultsFolder, + workFolder = workFolder + ) + Strategus::execute( + analysisSpecifications = esAnalysisSpecifications, + executionSettings = resultsExecutionSettings, + connectionDetails = tempConnectionDetails + ) + + estimates <- readr::read_csv(file.path(testResultsFolder, "EvidenceSynthesisModule", "es_cm_result.csv"), show_col_types = FALSE) + expect_gt(nrow(estimates), 0) + expect_true(all(is.na(estimates$calibrated_rr))) +}) + + +# readr::write_csv(OhdsiRTools::createResultsSchemaStub(testResultsFolder), "resultsDataModelSpecification.csv") unlink(workFolder) unlink(testResultsFolder) diff --git a/tests/testthat/test-Execution.R b/tests/testthat/test-Execution.R index 0fc09237..64da5c65 100644 --- a/tests/testthat/test-Execution.R +++ b/tests/testthat/test-Execution.R @@ -1,213 +1,213 @@ -# test_that("Execute study, upload results, excute results modules and upload results", { -# analysisSpecifications <- ParallelLogger::loadSettingsFromJson( -# fileName = system.file("testdata/cdmModulesAnalysisSpecifications.json", -# package = "Strategus" -# ) -# ) -# studyRootFolder <- file.path(tempDir, "EunomiaTestStudy") -# workFolder <- file.path(studyRootFolder, "work_folder") -# resultsFolder <- file.path(studyRootFolder, "results_folder") -# if (!dir.exists(studyRootFolder)) { -# dir.create(studyRootFolder, recursive = TRUE) -# } -# -# withr::defer( -# { -# unlink(studyRootFolder, recursive = TRUE, force = TRUE) -# }, -# testthat::teardown_env() -# ) -# -# # Execute the study --------------------------- -# executionSettings <- createCdmExecutionSettings( -# workDatabaseSchema = workDatabaseSchema, -# cdmDatabaseSchema = cdmDatabaseSchema, -# cohortTableNames = CohortGenerator::getCohortTableNames(cohortTable = "unit_test"), -# workFolder = workFolder, -# resultsFolder = resultsFolder -# ) -# -# ParallelLogger::saveSettingsToJson( -# object = executionSettings, -# file.path(studyRootFolder, "eunomiaExecutionSettings.json") -# ) -# -# executionSettings <- ParallelLogger::loadSettingsFromJson( -# fileName = file.path(studyRootFolder, "eunomiaExecutionSettings.json") -# ) -# -# expect_warning( -# Strategus::execute( -# connectionDetails = connectionDetails, -# analysisSpecifications = analysisSpecifications, -# executionSettings = executionSettings -# ) -# ) -# -# # Create a results DB and upload results -# dbFilePath <- file.path(studyRootFolder, "testdm.sqlite") -# mydb <- dbConnect(RSQLite::SQLite(), dbFilePath) -# dbDisconnect(mydb) -# -# withr::defer( -# { -# unlink(dbFilePath, recursive = TRUE, force = TRUE) -# }, -# testthat::teardown_env() -# ) -# -# resultsConnectionDetails <- DatabaseConnector::createConnectionDetails( -# dbms = "sqlite", -# server = dbFilePath -# ) -# -# resultsDataModelSettings <- Strategus::createResultsDataModelSettings( -# resultsDatabaseSchema = "main", -# resultsFolder = executionSettings$resultsFolder -# ) -# -# # Create cdm modules results data model ------------------------- -# cdmModulesAnalysisSpecifications <- ParallelLogger::loadSettingsFromJson( -# fileName = system.file("testdata/cdmModulesAnalysisSpecifications.json", -# package = "Strategus" -# ) -# ) -# -# Strategus::createResultDataModel( -# analysisSpecifications = cdmModulesAnalysisSpecifications, -# resultsDataModelSettings = resultsDataModelSettings, -# resultsConnectionDetails = resultsConnectionDetails -# ) -# -# # Upload cdm related results -------------------- -# Strategus::uploadResults( -# analysisSpecifications = analysisSpecifications, -# resultsDataModelSettings = resultsDataModelSettings, -# resultsConnectionDetails = resultsConnectionDetails -# ) -# -# # Execute results modules ------------------------- -# resultsModulesAnalysisSpecifications <- ParallelLogger::loadSettingsFromJson( -# fileName = system.file("testdata/resultsModulesAnalysisSpecifications.json", -# package = "Strategus" -# ) -# ) -# -# resultsExecutionSettings <- Strategus::createResultsExecutionSettings( -# resultsDatabaseSchema = resultsDataModelSettings$resultsDatabaseSchema, -# workFolder = file.path(studyRootFolder, "results_modules", "work_folder"), -# resultsFolder = file.path(studyRootFolder, "results_modules", "results_folder") -# ) -# -# Strategus::execute( -# connectionDetails = resultsConnectionDetails, -# analysisSpecifications = resultsModulesAnalysisSpecifications, -# executionSettings = resultsExecutionSettings -# ) -# -# # Create the results data model ------ -# resultsDataModelSettings <- Strategus::createResultsDataModelSettings( -# resultsDatabaseSchema = "main", -# resultsFolder = resultsExecutionSettings$resultsFolder -# ) -# -# # NOTE: This will throw a warning since the database metadata -# # does not exist -# expect_warning( -# Strategus::createResultDataModel( -# analysisSpecifications = resultsModulesAnalysisSpecifications, -# resultsDataModelSettings = resultsDataModelSettings, -# resultsConnectionDetails = resultsConnectionDetails -# ) -# ) -# -# # Upload the results ------------- -# resultsDataModelSettings <- Strategus::createResultsDataModelSettings( -# resultsDatabaseSchema = resultsDataModelSettings$resultsDatabaseSchema, -# resultsFolder = resultsExecutionSettings$resultsFolder -# ) -# -# # NOTE: This will throw a warning since the database metadata -# # does not exist -# expect_warning( -# Strategus::uploadResults( -# analysisSpecifications = resultsModulesAnalysisSpecifications, -# resultsDataModelSettings = resultsDataModelSettings, -# resultsConnectionDetails = resultsConnectionDetails -# ) -# ) -# -# # Get a list of tables -# connection <- DatabaseConnector::connect(resultsConnectionDetails) -# on.exit(DatabaseConnector::disconnect(connection)) -# tableList <- DatabaseConnector::getTableNames( -# connection = connection, -# databaseSchema = resultsDataModelSettings$resultsDatabaseSchema -# ) -# -# expect_true(length(tableList) > 0) -# }) -# -# test_that("Execute on Oracle stops if table names exceed length limit", { -# sqlRenderTempEmulationSchema <- getOption("sqlRenderTempEmulationSchema", default = "") -# options(sqlRenderTempEmulationSchema = "some_schema") -# on.exit(options(sqlRenderTempEmulationSchema = sqlRenderTempEmulationSchema)) -# -# connectionDetails <- DatabaseConnector::createConnectionDetails( -# dbms = "oracle" -# ) -# executionSettings <- Strategus::createCdmExecutionSettings( -# workDatabaseSchema = "does_not_matter", -# cdmDatabaseSchema = "does_not_matter", -# cohortTableNames = CohortGenerator::getCohortTableNames("some_really_long_table_name_for_testing_that_oracle_throws_a_warning"), -# workFolder = file.path(tempDir, "work_folder"), -# resultsFolder = file.path(tempDir, "results_folder"), -# minCellCount = 5 -# ) -# -# analysisSpecifications <- ParallelLogger::loadSettingsFromJson( -# fileName = system.file("testdata/cdmModulesAnalysisSpecifications.json", -# package = "Strategus" -# ) -# ) -# -# expect_error( -# Strategus::execute( -# connectionDetails = connectionDetails, -# analysisSpecifications = analysisSpecifications, -# executionSettings = executionSettings -# ) -# ) -# }) -# -# test_that("Negative control outcomes are optional", { -# analysisSpecifications <- ParallelLogger::loadSettingsFromJson( -# fileName = system.file("testdata/cdmModulesAnalysisSpecifications.json", -# package = "Strategus" -# ) -# ) -# -# # Remove the nco section -# analysisSpecifications$sharedResources <- list(analysisSpecifications$sharedResources[[1]]) -# -# # Remove all but CG -# analysisSpecifications$moduleSpecifications <- list(analysisSpecifications$moduleSpecifications[[3]]) -# -# executionSettings <- createCdmExecutionSettings( -# workDatabaseSchema = workDatabaseSchema, -# cdmDatabaseSchema = cdmDatabaseSchema, -# cohortTableNames = CohortGenerator::getCohortTableNames(cohortTable = "unit_test"), -# workFolder = file.path(tempDir, "work_folder"), -# resultsFolder = file.path(tempDir, "results_folder") -# ) -# -# expect_output( -# Strategus::execute( -# connectionDetails = connectionDetails, -# analysisSpecifications = analysisSpecifications, -# executionSettings = executionSettings -# ), -# "Generating cohort set", -# ignore.case = TRUE -# ) -# }) +test_that("Execute study, upload results, excute results modules and upload results", { + analysisSpecifications <- ParallelLogger::loadSettingsFromJson( + fileName = system.file("testdata/cdmModulesAnalysisSpecifications.json", + package = "Strategus" + ) + ) + studyRootFolder <- file.path(tempDir, "EunomiaTestStudy") + workFolder <- file.path(studyRootFolder, "work_folder") + resultsFolder <- file.path(studyRootFolder, "results_folder") + if (!dir.exists(studyRootFolder)) { + dir.create(studyRootFolder, recursive = TRUE) + } + + withr::defer( + { + unlink(studyRootFolder, recursive = TRUE, force = TRUE) + }, + testthat::teardown_env() + ) + + # Execute the study --------------------------- + executionSettings <- createCdmExecutionSettings( + workDatabaseSchema = workDatabaseSchema, + cdmDatabaseSchema = cdmDatabaseSchema, + cohortTableNames = CohortGenerator::getCohortTableNames(cohortTable = "unit_test"), + workFolder = workFolder, + resultsFolder = resultsFolder + ) + + ParallelLogger::saveSettingsToJson( + object = executionSettings, + file.path(studyRootFolder, "eunomiaExecutionSettings.json") + ) + + executionSettings <- ParallelLogger::loadSettingsFromJson( + fileName = file.path(studyRootFolder, "eunomiaExecutionSettings.json") + ) + + expect_warning( + Strategus::execute( + connectionDetails = connectionDetails, + analysisSpecifications = analysisSpecifications, + executionSettings = executionSettings + ) + ) + + # Create a results DB and upload results + dbFilePath <- file.path(studyRootFolder, "testdm.sqlite") + mydb <- dbConnect(RSQLite::SQLite(), dbFilePath) + dbDisconnect(mydb) + + withr::defer( + { + unlink(dbFilePath, recursive = TRUE, force = TRUE) + }, + testthat::teardown_env() + ) + + resultsConnectionDetails <- DatabaseConnector::createConnectionDetails( + dbms = "sqlite", + server = dbFilePath + ) + + resultsDataModelSettings <- Strategus::createResultsDataModelSettings( + resultsDatabaseSchema = "main", + resultsFolder = executionSettings$resultsFolder + ) + + # Create cdm modules results data model ------------------------- + cdmModulesAnalysisSpecifications <- ParallelLogger::loadSettingsFromJson( + fileName = system.file("testdata/cdmModulesAnalysisSpecifications.json", + package = "Strategus" + ) + ) + + Strategus::createResultDataModel( + analysisSpecifications = cdmModulesAnalysisSpecifications, + resultsDataModelSettings = resultsDataModelSettings, + resultsConnectionDetails = resultsConnectionDetails + ) + + # Upload cdm related results -------------------- + Strategus::uploadResults( + analysisSpecifications = analysisSpecifications, + resultsDataModelSettings = resultsDataModelSettings, + resultsConnectionDetails = resultsConnectionDetails + ) + + # Execute results modules ------------------------- + resultsModulesAnalysisSpecifications <- ParallelLogger::loadSettingsFromJson( + fileName = system.file("testdata/resultsModulesAnalysisSpecifications.json", + package = "Strategus" + ) + ) + + resultsExecutionSettings <- Strategus::createResultsExecutionSettings( + resultsDatabaseSchema = resultsDataModelSettings$resultsDatabaseSchema, + workFolder = file.path(studyRootFolder, "results_modules", "work_folder"), + resultsFolder = file.path(studyRootFolder, "results_modules", "results_folder") + ) + + Strategus::execute( + connectionDetails = resultsConnectionDetails, + analysisSpecifications = resultsModulesAnalysisSpecifications, + executionSettings = resultsExecutionSettings + ) + + # Create the results data model ------ + resultsDataModelSettings <- Strategus::createResultsDataModelSettings( + resultsDatabaseSchema = "main", + resultsFolder = resultsExecutionSettings$resultsFolder + ) + + # NOTE: This will throw a warning since the database metadata + # does not exist + expect_warning( + Strategus::createResultDataModel( + analysisSpecifications = resultsModulesAnalysisSpecifications, + resultsDataModelSettings = resultsDataModelSettings, + resultsConnectionDetails = resultsConnectionDetails + ) + ) + + # Upload the results ------------- + resultsDataModelSettings <- Strategus::createResultsDataModelSettings( + resultsDatabaseSchema = resultsDataModelSettings$resultsDatabaseSchema, + resultsFolder = resultsExecutionSettings$resultsFolder + ) + + # NOTE: This will throw a warning since the database metadata + # does not exist + expect_warning( + Strategus::uploadResults( + analysisSpecifications = resultsModulesAnalysisSpecifications, + resultsDataModelSettings = resultsDataModelSettings, + resultsConnectionDetails = resultsConnectionDetails + ) + ) + + # Get a list of tables + connection <- DatabaseConnector::connect(resultsConnectionDetails) + on.exit(DatabaseConnector::disconnect(connection)) + tableList <- DatabaseConnector::getTableNames( + connection = connection, + databaseSchema = resultsDataModelSettings$resultsDatabaseSchema + ) + + expect_true(length(tableList) > 0) +}) + +test_that("Execute on Oracle stops if table names exceed length limit", { + sqlRenderTempEmulationSchema <- getOption("sqlRenderTempEmulationSchema", default = "") + options(sqlRenderTempEmulationSchema = "some_schema") + on.exit(options(sqlRenderTempEmulationSchema = sqlRenderTempEmulationSchema)) + + connectionDetails <- DatabaseConnector::createConnectionDetails( + dbms = "oracle" + ) + executionSettings <- Strategus::createCdmExecutionSettings( + workDatabaseSchema = "does_not_matter", + cdmDatabaseSchema = "does_not_matter", + cohortTableNames = CohortGenerator::getCohortTableNames("some_really_long_table_name_for_testing_that_oracle_throws_a_warning"), + workFolder = file.path(tempDir, "work_folder"), + resultsFolder = file.path(tempDir, "results_folder"), + minCellCount = 5 + ) + + analysisSpecifications <- ParallelLogger::loadSettingsFromJson( + fileName = system.file("testdata/cdmModulesAnalysisSpecifications.json", + package = "Strategus" + ) + ) + + expect_error( + Strategus::execute( + connectionDetails = connectionDetails, + analysisSpecifications = analysisSpecifications, + executionSettings = executionSettings + ) + ) +}) + +test_that("Negative control outcomes are optional", { + analysisSpecifications <- ParallelLogger::loadSettingsFromJson( + fileName = system.file("testdata/cdmModulesAnalysisSpecifications.json", + package = "Strategus" + ) + ) + + # Remove the nco section + analysisSpecifications$sharedResources <- list(analysisSpecifications$sharedResources[[1]]) + + # Remove all but CG + analysisSpecifications$moduleSpecifications <- list(analysisSpecifications$moduleSpecifications[[3]]) + + executionSettings <- createCdmExecutionSettings( + workDatabaseSchema = workDatabaseSchema, + cdmDatabaseSchema = cdmDatabaseSchema, + cohortTableNames = CohortGenerator::getCohortTableNames(cohortTable = "unit_test"), + workFolder = file.path(tempDir, "work_folder"), + resultsFolder = file.path(tempDir, "results_folder") + ) + + expect_output( + Strategus::execute( + connectionDetails = connectionDetails, + analysisSpecifications = analysisSpecifications, + executionSettings = executionSettings + ), + "Generating cohort set", + ignore.case = TRUE + ) +})