From 65ac18f7742205b0b557ec5a063b15287c4f40c5 Mon Sep 17 00:00:00 2001 From: Maarten van Kessel Date: Tue, 29 Aug 2023 16:08:15 +0200 Subject: [PATCH 1/7] Added initial setup and tests --- tests/testthat/setup-runCmAnalyses.R | 101 +++++ tests/testthat/test-runCmAnalyses.R | 638 +++++++++++++++++++++++++++ 2 files changed, 739 insertions(+) create mode 100644 tests/testthat/setup-runCmAnalyses.R create mode 100644 tests/testthat/test-runCmAnalyses.R diff --git a/tests/testthat/setup-runCmAnalyses.R b/tests/testthat/setup-runCmAnalyses.R new file mode 100644 index 00000000..67637ae7 --- /dev/null +++ b/tests/testthat/setup-runCmAnalyses.R @@ -0,0 +1,101 @@ +# Setup ---- +library(CohortMethod) + +outputFolder <- tempfile(pattern = "cmData") + +covarSettings <- createDefaultCovariateSettings(addDescendantsToExclude = TRUE) + +getDbCmDataArgs <- createGetDbCohortMethodDataArgs( + washoutPeriod = 183, + firstExposureOnly = TRUE, + removeDuplicateSubjects = "remove all", + covariateSettings = covarSettings +) + +createPsArgs <- createCreatePsArgs( + prior = createPrior("laplace", variance = 0.01), + estimator = "att" +) + +matchOnPsArgs <- createMatchOnPsArgs(maxRatio = 100) + +computeSharedCovBalArgs <- createComputeCovariateBalanceArgs() + +computeCovBalArgs <- createComputeCovariateBalanceArgs( + covariateFilter = FeatureExtraction::getDefaultTable1Specifications() +) + +truncateIptwArgs <- createTruncateIptwArgs(maxWeight = 10) + +tcos1 <- createTargetComparatorOutcomes( + targetId = 1, + comparatorId = 2, + outcomes = list( + createOutcome( + outcomeId = 3, + priorOutcomeLookback = 30 + ), + createOutcome( + outcomeId = 4, + outcomeOfInterest = FALSE, + trueEffectSize = 1 + ) + ), + excludedCovariateConceptIds = c(1118084, 1124300) +) +# Empty cohorts: +tcos2 <- createTargetComparatorOutcomes( + targetId = 998, + comparatorId = 999, + outcomes = list( + createOutcome( + outcomeId = 3, + priorOutcomeLookback = 30 + ), + createOutcome( + outcomeId = 4, + outcomeOfInterest = FALSE, + trueEffectSize = 1 + ) + ) +) + +targetComparatorOutcomesList <- list(tcos1, tcos2) + +analysesToExclude <- data.frame( + targetId = c(998, 998), + analysisId = c(3, 4) +) + +createStudyPopArgs1 <- createCreateStudyPopulationArgs( + removeSubjectsWithPriorOutcome = TRUE, + firstExposureOnly = TRUE, + restrictToCommonPeriod = TRUE, + removeDuplicateSubjects = "remove all", + washoutPeriod = 183, + censorAtNewRiskWindow = TRUE, + minDaysAtRisk = 1, + riskWindowStart = 0, + startAnchor = "cohort start", + riskWindowEnd = 30, + endAnchor = "cohort end" +) + +createStudyPopArgs2 <- createCreateStudyPopulationArgs( + removeSubjectsWithPriorOutcome = TRUE, + firstExposureOnly = TRUE, + restrictToCommonPeriod = TRUE, + removeDuplicateSubjects = "keep first", + washoutPeriod = 183, + censorAtNewRiskWindow = TRUE, + minDaysAtRisk = 1, + riskWindowStart = 0, + startAnchor = "cohort start", + riskWindowEnd = 30, + endAnchor = "cohort end" +) + +# Clean-up ---- +withr::defer({ + unlink(outputFolder) +}) diff --git a/tests/testthat/test-runCmAnalyses.R b/tests/testthat/test-runCmAnalyses.R new file mode 100644 index 00000000..53626310 --- /dev/null +++ b/tests/testthat/test-runCmAnalyses.R @@ -0,0 +1,638 @@ +# Setup ---- +library(testthat) +library(CohortMethod) + +## Analysis 1 ---- +fitOutcomeModelArgs1 <- createFitOutcomeModelArgs( + modelType = "cox" +) + +cmAnalysis1 <- createCmAnalysis( + analysisId = 1, + description = "No matching, simple outcome model", + getDbCohortMethodDataArgs = getDbCmDataArgs, + createStudyPopArgs = createStudyPopArgs1, + fitOutcomeModelArgs = fitOutcomeModelArgs1 +) + +## Analysis 2 ---- +fitOutcomeModelArgs2 <- createFitOutcomeModelArgs( + modelType = "cox", + stratified = TRUE +) + +cmAnalysis2 <- createCmAnalysis( + analysisId = 2, + description = "Matching", + getDbCohortMethodDataArgs = getDbCmDataArgs, + createStudyPopArgs = createStudyPopArgs2, + createPsArgs = createPsArgs, + matchOnPsArgs = matchOnPsArgs, + computeSharedCovariateBalanceArgs = computeSharedCovBalArgs, + computeCovariateBalanceArgs = computeCovBalArgs, + fitOutcomeModelArgs = fitOutcomeModelArgs2 +) + +## Analysis 3 ---- +fitOutcomeModelArgs3 <- createFitOutcomeModelArgs( + modelType = "cox", + inversePtWeighting = TRUE +) +cmAnalysis3 <- createCmAnalysis( + analysisId = 3, + description = "IPTW", + getDbCohortMethodDataArgs = getDbCmDataArgs, + createStudyPopArgs = createStudyPopArgs2, + createPsArgs = createPsArgs, + truncateIptwArgs = truncateIptwArgs, + computeSharedCovariateBalanceArgs = computeSharedCovBalArgs, + fitOutcomeModelArgs = fitOutcomeModelArgs3 +) + +## Analysis 4 ---- +fitOutcomeModelArgs4 <- createFitOutcomeModelArgs( + modelType = "cox", + stratified = TRUE, + interactionCovariateIds = 8532001 +) + +cmAnalysis4 <- createCmAnalysis( + analysisId = 4, + description = "Matching with gender interaction", + getDbCohortMethodDataArgs = getDbCmDataArgs, + createStudyPopArgs = createStudyPopArgs2, + createPsArgs = createPsArgs, + matchOnPsArgs = matchOnPsArgs, + fitOutcomeModelArgs = fitOutcomeModelArgs4 +) + +cmAnalysisList <- list(cmAnalysis1, cmAnalysis2, cmAnalysis3, cmAnalysis4) + +# Tests ---- +test_that("Warnings set 1/2", { + unlink(outputFolder, recursive = TRUE) + warn1 <- capture_warnings({ + runCmAnalyses( + connectionDetails = connectionDetails, + cdmDatabaseSchema = "main", + exposureTable = "cohort", + outcomeTable = "cohort", + outputFolder = outputFolder, + cmAnalysisList = cmAnalysisList, + targetComparatorOutcomesList = targetComparatorOutcomesList, + analysesToExclude = analysesToExclude + ) + }) + + warn2 <- capture_warnings({ + runCmAnalyses( + connectionDetails = connectionDetails, + cdmDatabaseSchema = "main", + exposureTable = "cohort", + outcomeTable = "cohort", + outputFolder = outputFolder, + cmAnalysisList = list(cmAnalysis4), + targetComparatorOutcomesList = targetComparatorOutcomesList + ) + }) + + expect_true(!identical(warn1, warn2)) +}) + +test_that("targetComparatorOutcomeList", { + unlink(outputFolder, recursive = TRUE) + res <- suppressWarnings(runCmAnalyses( + connectionDetails = connectionDetails, + cdmDatabaseSchema = "main", + exposureTable = "cohort", + outcomeTable = "cohort", + outputFolder = outputFolder, + cmAnalysisList = cmAnalysisList, + targetComparatorOutcomesList = targetComparatorOutcomesList + )) + + # Dimensions + expect_identical(dim(res), c(16L, 17L)) + + unlink(outputFolder, recursive = TRUE) + ### list() ---- + expect_error( + suppressWarnings(runCmAnalyses( + connectionDetails = connectionDetails, + cdmDatabaseSchema = "main", + exposureTable = "cohort", + outcomeTable = "cohort", + outputFolder = outputFolder, + cmAnalysisList = cmAnalysisList, + targetComparatorOutcomesList = list() + )), + "Must have length >= 1" + ) + + ### NULL ---- + expect_error( + suppressWarnings(runCmAnalyses( + connectionDetails = connectionDetails, + cdmDatabaseSchema = "main", + exposureTable = "cohort", + outcomeTable = "cohort", + outputFolder = outputFolder, + cmAnalysisList = cmAnalysisList, + targetComparatorOutcomesList = NULL + )), + "Must be of type 'list'" + ) + + ### list(list(), list()) ---- + expect_error( + suppressWarnings(runCmAnalyses( + connectionDetails = connectionDetails, + cdmDatabaseSchema = "main", + exposureTable = "cohort", + outcomeTable = "cohort", + outputFolder = outputFolder, + cmAnalysisList = cmAnalysisList, + targetComparatorOutcomesList = list(list(), list()) + )), + "Must inherit from.+'targetComparatorOutcomes'" + ) + + ### list(NULL, NULL) ---- + expect_error( + suppressWarnings(runCmAnalyses( + connectionDetails = connectionDetails, + cdmDatabaseSchema = "main", + exposureTable = "cohort", + outcomeTable = "cohort", + outputFolder = outputFolder, + cmAnalysisList = cmAnalysisList, + targetComparatorOutcomesList = list(NULL, NULL) + )), + "Must inherit from.+'targetComparatorOutcomes'" + ) +}) +# +# test_that("tempEmulationSchema", { +# unlink(outputFolder, recursive = TRUE) +# ### "main" +# expect_no_error( +# suppressWarnings(runCmAnalyses( +# connectionDetails = connectionDetails, +# cdmDatabaseSchema = "main", +# exposureTable = "cohort", +# outcomeTable = "cohort", +# outputFolder = outputFolder, +# cmAnalysisList = cmAnalysisList, +# targetComparatorOutcomesList = targetComparatorOutcomesList, +# # Eunomia +# tempEmulationSchema = "main" +# ) +# )) +# +# ### 3 ---- +# unlink(outputFolder, recursive = TRUE) +# expect_error( +# suppressWarnings(runCmAnalyses( +# connectionDetails = connectionDetails, +# cdmDatabaseSchema = "main", +# exposureTable = "cohort", +# outcomeTable = "cohort", +# outputFolder = outputFolder, +# cmAnalysisList = cmAnalysisList, +# targetComparatorOutcomesList = targetComparatorOutcomesList, +# tempEmulationSchema = 3 +# )), +# "Must be of type 'character'" +# ) +# +# ### c("main", "main") ---- +# unlink(outputFolder, recursive = TRUE) +# expect_error( +# suppressWarnings(runCmAnalyses( +# connectionDetails = connectionDetails, +# cdmDatabaseSchema = "main", +# exposureTable = "cohort", +# outcomeTable = "cohort", +# outputFolder = outputFolder, +# cmAnalysisList = cmAnalysisList, +# targetComparatorOutcomesList = targetComparatorOutcomesList, +# tempEmulationSchema = c("main", "main") +# )), +# "Must have length 1" +# ) +# }) +# +# test_that("exposureDatabaseSchema", { +# ### "main" ---- +# unlink(outputFolder, recursive = TRUE) +# expect_no_error( +# suppressWarnings(runCmAnalyses( +# connectionDetails = connectionDetails, +# cdmDatabaseSchema = "main", +# exposureTable = "cohort", +# outcomeTable = "cohort", +# outputFolder = outputFolder, +# cmAnalysisList = cmAnalysisList, +# targetComparatorOutcomesList = targetComparatorOutcomesList, +# exposureDatabaseSchema = "main" +# )) +# ) +# +# ### "SchemaThatDoesNotExist" ---- +# unlink(outputFolder, recursive = TRUE) +# expect_error( +# suppressWarnings(runCmAnalyses( +# connectionDetails = connectionDetails, +# cdmDatabaseSchema = "main", +# exposureTable = "cohort", +# outcomeTable = "cohort", +# outputFolder = outputFolder, +# cmAnalysisList = cmAnalysisList, +# targetComparatorOutcomesList = targetComparatorOutcomesList, +# exposureDatabaseSchema = "SchemaThatDoesNotExist" +# )), +# "no such table: SchemaThatDoesNotExist.cohort" +# ) +# +# ### 3 ---- +# unlink(outputFolder, recursive = TRUE) +# expect_error( +# suppressWarnings(runCmAnalyses( +# connectionDetails = connectionDetails, +# cdmDatabaseSchema = "main", +# exposureTable = "cohort", +# outcomeTable = "cohort", +# outputFolder = outputFolder, +# cmAnalysisList = cmAnalysisList, +# targetComparatorOutcomesList = targetComparatorOutcomesList, +# exposureDatabaseSchema = 3 +# )), +# "Must be of type 'character'" +# ) +# +# ### c("main", "main") ---- +# unlink(outputFolder, recursive = TRUE) +# expect_error( +# suppressWarnings(runCmAnalyses( +# connectionDetails = connectionDetails, +# cdmDatabaseSchema = "main", +# exposureTable = "cohort", +# outcomeTable = "cohort", +# outputFolder = outputFolder, +# cmAnalysisList = cmAnalysisList, +# targetComparatorOutcomesList = targetComparatorOutcomesList, +# exposureDatabaseSchema = c("main", "main") +# )), +# "Must have length 1" +# ) +# }) +# +# test_that("outcomeDatabaseSchema", { +# ### "main" ---- +# unlink(outputFolder, recursive = TRUE) +# expect_no_error( +# suppressWarnings(runCmAnalyses( +# connectionDetails = connectionDetails, +# cdmDatabaseSchema = "main", +# exposureTable = "cohort", +# outcomeTable = "cohort", +# outputFolder = outputFolder, +# cmAnalysisList = cmAnalysisList, +# targetComparatorOutcomesList = targetComparatorOutcomesList, +# outcomeDatabaseSchema = "main" +# )) +# ) +# +# ### 3 ---- +# unlink(outputFolder, recursive = TRUE) +# expect_error( +# suppressWarnings(runCmAnalyses( +# connectionDetails = connectionDetails, +# cdmDatabaseSchema = "main", +# exposureTable = "cohort", +# outcomeTable = "cohort", +# outputFolder = outputFolder, +# cmAnalysisList = cmAnalysisList, +# targetComparatorOutcomesList = targetComparatorOutcomesList, +# outcomeDatabaseSchema = 3 +# )), +# "Must be of type 'character'" +# ) +# +# ### c("main", "main") ---- +# unlink(outputFolder, recursive = TRUE) +# expect_error( +# suppressWarnings(runCmAnalyses( +# connectionDetails = connectionDetails, +# cdmDatabaseSchema = "main", +# exposureTable = "cohort", +# outcomeTable = "cohort", +# outputFolder = outputFolder, +# cmAnalysisList = cmAnalysisList, +# targetComparatorOutcomesList = targetComparatorOutcomesList, +# outcomeDatabaseSchema = c("main", "main") +# )), +# "Must have length 1" +# ) +# }) +# +# test_that("cdmVersion", { +# ### "5" ---- +# unlink(outputFolder, recursive = TRUE) +# expect_no_error( +# suppressWarnings(runCmAnalyses( +# connectionDetails = connectionDetails, +# cdmDatabaseSchema = "main", +# exposureTable = "cohort", +# outcomeTable = "cohort", +# outputFolder = outputFolder, +# cmAnalysisList = cmAnalysisList, +# targetComparatorOutcomesList = targetComparatorOutcomesList, +# cdmVersion = "5" +# )) +# ) +# +# ### 5 ---- +# unlink(outputFolder, recursive = TRUE) +# expect_error( +# suppressWarnings(runCmAnalyses( +# connectionDetails = connectionDetails, +# cdmDatabaseSchema = "main", +# exposureTable = "cohort", +# outcomeTable = "cohort", +# outputFolder = outputFolder, +# cmAnalysisList = cmAnalysisList, +# targetComparatorOutcomesList = targetComparatorOutcomesList, +# cdmVersion = 5 +# )), +# "Must be of type 'character'" +# ) +# +# ### "Five" ---- +# unlink(outputFolder, recursive = TRUE) +# expect_error( +# suppressWarnings(runCmAnalyses( +# connectionDetails = connectionDetails, +# cdmDatabaseSchema = "main", +# exposureTable = "cohort", +# outcomeTable = "cohort", +# outputFolder = outputFolder, +# cmAnalysisList = cmAnalysisList, +# targetComparatorOutcomesList = targetComparatorOutcomesList, +# cdmVersion = "Five" +# )), +# "All elements must have exactly 1 characters" +# ) +# +# ### c("4", "5", "6") ---- +# unlink(outputFolder, recursive = TRUE) +# expect_error( +# suppressWarnings(runCmAnalyses( +# connectionDetails = connectionDetails, +# cdmDatabaseSchema = "main", +# exposureTable = "cohort", +# outcomeTable = "cohort", +# outputFolder = outputFolder, +# cmAnalysisList = cmAnalysisList, +# targetComparatorOutcomesList = targetComparatorOutcomesList, +# cdmVersion = c("4", "5", "6") +# )), +# "Must have length 1" +# ) +# }) +# +# test_that("analysesToExclude", { +# unlink(outputFolder, recursive = TRUE) +# +# analysesToExclude <- data.frame( +# targetId = c(998, 998), +# analysisId = c(3, 4) +# ) +# +# ### analysesToExclude ---- +# expect_no_error( +# suppressWarnings(runCmAnalyses( +# connectionDetails = connectionDetails, +# cdmDatabaseSchema = "main", +# exposureTable = "cohort", +# outcomeTable = "cohort", +# outputFolder = outputFolder, +# cmAnalysisList = cmAnalysisList, +# targetComparatorOutcomesList = targetComparatorOutcomesList, +# analysesToExclude = analysesToExclude +# )) +# ) +# +# ### NULL ---- +# unlink(outputFolder, recursive = TRUE) +# expect_no_error( +# suppressWarnings(runCmAnalyses( +# connectionDetails = connectionDetails, +# cdmDatabaseSchema = "main", +# exposureTable = "cohort", +# outcomeTable = "cohort", +# outputFolder = outputFolder, +# cmAnalysisList = cmAnalysisList, +# targetComparatorOutcomesList = targetComparatorOutcomesList, +# analysesToExclude = NULL +# )) +# ) +# +# ### data.frame() ---- +# unlink(outputFolder, recursive = TRUE) +# expect_error( +# suppressWarnings(runCmAnalyses( +# connectionDetails = connectionDetails, +# cdmDatabaseSchema = "main", +# exposureTable = "cohort", +# outcomeTable = "cohort", +# outputFolder = outputFolder, +# cmAnalysisList = cmAnalysisList, +# targetComparatorOutcomesList = targetComparatorOutcomesList, +# analysesToExclude = data.frame() +# )), +# "should contain columns 'targetId', 'comparatorId', 'outcomeId', or 'analysisId'" +# ) +# +# ### data.frame(numeric()) ---- +# expect_warning( +# suppressWarnings(runCmAnalyses( +# connectionDetails = connectionDetails, +# cdmDatabaseSchema = "main", +# exposureTable = "cohort", +# outcomeTable = "cohort", +# outputFolder = outputFolder, +# cmAnalysisList = cmAnalysisList, +# targetComparatorOutcomesList = targetComparatorOutcomesList, +# analysesToExclude = data.frame( +# targetId = numeric(), +# comparatorId = numeric(), +# outcomeId = numeric(), +# analysisId = numeric() +# )) +# ), +# "Passed `data.frame` with 0 rows to parameter: `analysesToExclude`, no analyses excluded." +# ) +# }) +# +# test_that("refitPsForEveryOutcome", { +# ### FALSE ---- +# unlink(outputFolder, recursive = TRUE) +# expect_no_error( +# suppressWarnings(runCmAnalyses( +# connectionDetails = connectionDetails, +# cdmDatabaseSchema = "main", +# exposureTable = "cohort", +# outcomeTable = "cohort", +# outputFolder = outputFolder, +# cmAnalysisList = cmAnalysisList, +# targetComparatorOutcomesList = targetComparatorOutcomesList, +# refitPsForEveryOutcome = FALSE +# )) +# ) +# +# ### TRUE ---- +# unlink(outputFolder, recursive = TRUE) +# expect_no_error( +# suppressWarnings(runCmAnalyses( +# connectionDetails = connectionDetails, +# cdmDatabaseSchema = "main", +# exposureTable = "cohort", +# outcomeTable = "cohort", +# outputFolder = outputFolder, +# cmAnalysisList = cmAnalysisList, +# targetComparatorOutcomesList = targetComparatorOutcomesList, +# refitPsForEveryOutcome = TRUE +# )) +# ) +# +# ### 0 ---- +# unlink(outputFolder, recursive = TRUE) +# expect_error( +# suppressWarnings(runCmAnalyses( +# connectionDetails = connectionDetails, +# cdmDatabaseSchema = "main", +# exposureTable = "cohort", +# outcomeTable = "cohort", +# outputFolder = outputFolder, +# cmAnalysisList = cmAnalysisList, +# targetComparatorOutcomesList = targetComparatorOutcomesList, +# refitPsForEveryOutcome = 0 +# )), +# "Must be of type 'logical'" +# ) +# }) +# +# test_that("refitPsForEveryStudyPopulation", { +# ### FALSE ---- +# unlink(outputFolder, recursive = TRUE) +# expect_no_error( +# suppressWarnings(runCmAnalyses( +# connectionDetails = connectionDetails, +# cdmDatabaseSchema = "main", +# exposureTable = "cohort", +# outcomeTable = "cohort", +# outputFolder = outputFolder, +# cmAnalysisList = cmAnalysisList, +# targetComparatorOutcomesList = targetComparatorOutcomesList, +# refitPsForEveryStudyPopulation = FALSE +# )) +# ) +# +# ### TRUE ---- +# unlink(outputFolder, recursive = TRUE) +# expect_no_error( +# suppressWarnings(runCmAnalyses( +# connectionDetails = connectionDetails, +# cdmDatabaseSchema = "main", +# exposureTable = "cohort", +# outcomeTable = "cohort", +# outputFolder = outputFolder, +# cmAnalysisList = cmAnalysisList, +# targetComparatorOutcomesList = targetComparatorOutcomesList, +# refitPsForEveryStudyPopulation = TRUE +# )) +# ) +# +# ### 0 ---- +# unlink(outputFolder, recursive = TRUE) +# expect_error( +# suppressWarnings(runCmAnalyses( +# connectionDetails = connectionDetails, +# cdmDatabaseSchema = "main", +# exposureTable = "cohort", +# outcomeTable = "cohort", +# outputFolder = outputFolder, +# cmAnalysisList = cmAnalysisList, +# targetComparatorOutcomesList = targetComparatorOutcomesList, +# refitPsForEveryStudyPopulation = 0 +# )), +# "Must be of type 'logical'" +# ) +# }) +# +# test_that("refitPsForEveryX", { +# unlink(outputFolder, recursive = TRUE) +# expect_error(suppressWarnings( +# runCmAnalyses( +# connectionDetails = connectionDetails, +# cdmDatabaseSchema = "main", +# exposureTable = "cohort", +# outcomeTable = "cohort", +# outputFolder = outputFolder, +# cmAnalysisList = list(cmAnalysis4), +# targetComparatorOutcomesList = targetComparatorOutcomesList, +# refitPsForEveryOutcome = TRUE, +# refitPsForEveryStudyPopulation = FALSE +# ) +# ), +# "Cannot have refitPsForEveryStudyPopulation = FALSE and refitPsForEveryOutcome = TRUE" +# ) +# }) +# +# test_that("multiThreadingSettings", { +# ### createDefaultMultiThreadingSettings() ---- +# # unlink(outputFolder, recursive = TRUE) +# # expect_no_error( +# # suppressWarnings(runCmAnalyses( +# # connectionDetails = connectionDetails, +# # cdmDatabaseSchema = "main", +# # exposureTable = "cohort", +# # outcomeTable = "cohort", +# # outputFolder = outputFolder, +# # cmAnalysisList = list(cmAnalysis4), +# # targetComparatorOutcomesList = targetComparatorOutcomesList, +# # multiThreadingSettings = createDefaultMultiThreadingSettings(4) +# # )) +# # ) +# +# ### NULL ---- +# unlink(outputFolder, recursive = TRUE) +# expect_error( +# runCmAnalyses( +# connectionDetails = connectionDetails, +# cdmDatabaseSchema = "main", +# exposureTable = "cohort", +# outcomeTable = "cohort", +# outputFolder = outputFolder, +# cmAnalysisList = list(cmAnalysis4), +# targetComparatorOutcomesList = targetComparatorOutcomesList, +# multiThreadingSettings = NULL +# ) +# ) +# +# ### list() ---- +# unlink(outputFolder, recursive = TRUE) +# expect_error( +# runCmAnalyses( +# connectionDetails = connectionDetails, +# cdmDatabaseSchema = "main", +# exposureTable = "cohort", +# outcomeTable = "cohort", +# outputFolder = outputFolder, +# cmAnalysisList = list(cmAnalysis4), +# targetComparatorOutcomesList = targetComparatorOutcomesList, +# multiThreadingSettings = list() +# ) +# ) +# }) From 9bf71f1671ce2894e0353c54c16da270cf7def80 Mon Sep 17 00:00:00 2001 From: Maarten van Kessel Date: Wed, 30 Aug 2023 15:30:15 +0200 Subject: [PATCH 2/7] Minor changes for input parameters --- R/RunAnalyses.R | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) diff --git a/R/RunAnalyses.R b/R/RunAnalyses.R index 4db53c98..873c686b 100644 --- a/R/RunAnalyses.R +++ b/R/RunAnalyses.R @@ -224,15 +224,16 @@ runCmAnalyses <- function(connectionDetails, checkmate::assertCharacter(outcomeTable, len = 1, add = errorMessages) checkmate::assertCharacter(cdmVersion, len = 1, add = errorMessages) checkmate::assertCharacter(outputFolder, len = 1, add = errorMessages) - checkmate::assertList(cmAnalysisList, min.len = 1, add = errorMessages) - for (i in 1:length(cmAnalysisList)) { - checkmate::assertClass(cmAnalysisList[[i]], "cmAnalysis", add = errorMessages) - } - checkmate::assertList(targetComparatorOutcomesList, min.len = 1, add = errorMessages) - for (i in 1:length(targetComparatorOutcomesList)) { - checkmate::assertClass(targetComparatorOutcomesList[[i]], "targetComparatorOutcomes", add = errorMessages) - } + checkmate::assertList(cmAnalysisList, min.len = 1, types = "cmAnalysis", add = errorMessages) + checkmate::assertList(targetComparatorOutcomesList, min.len = 1, types = "targetComparatorOutcomes", add = errorMessages) checkmate::assertDataFrame(analysesToExclude, null.ok = TRUE, add = errorMessages) + + if (!is.null(analysesToExclude)) { + if (nrow(analysesToExclude) == 0) { + warning("Passed `data.frame` with 0 rows to parameter: `analysesToExclude`, no analyses excluded.") + } + } + checkmate::assertLogical(refitPsForEveryOutcome, len = 1, add = errorMessages) checkmate::assertLogical(refitPsForEveryStudyPopulation, len = 1, add = errorMessages) checkmate::assertClass(multiThreadingSettings, "CmMultiThreadingSettings", add = errorMessages) @@ -529,7 +530,7 @@ runCmAnalyses <- function(connectionDetails, ) return(task) } - tasks <- lapply(1:nrow(subset), createSharedBalanceTask) + tasks <- lapply(seq_len(nrow(subset)), createSharedBalanceTask) cluster <- ParallelLogger::makeCluster(min(length(tasks), multiThreadingSettings$computeSharedBalanceThreads)) ParallelLogger::clusterRequire(cluster, "CohortMethod") dummy <- ParallelLogger::clusterApply(cluster, tasks, doComputeSharedBalance) From e9bde72b190ee8166a2a6f49f496a2cce63d7cbf Mon Sep 17 00:00:00 2001 From: Maarten van Kessel Date: Wed, 30 Aug 2023 15:30:36 +0200 Subject: [PATCH 3/7] Updated setup --- tests/testthat/setup-runCmAnalyses.R | 66 ++++++++++++++++++++++++++++ 1 file changed, 66 insertions(+) diff --git a/tests/testthat/setup-runCmAnalyses.R b/tests/testthat/setup-runCmAnalyses.R index 67637ae7..accdc200 100644 --- a/tests/testthat/setup-runCmAnalyses.R +++ b/tests/testthat/setup-runCmAnalyses.R @@ -95,6 +95,72 @@ createStudyPopArgs2 <- createCreateStudyPopulationArgs( endAnchor = "cohort end" ) +## Analysis 1 ---- +fitOutcomeModelArgs1 <- createFitOutcomeModelArgs( + modelType = "cox" +) + +cmAnalysis1 <- createCmAnalysis( + analysisId = 1, + description = "No matching, simple outcome model", + getDbCohortMethodDataArgs = getDbCmDataArgs, + createStudyPopArgs = createStudyPopArgs1, + fitOutcomeModelArgs = fitOutcomeModelArgs1 +) + +## Analysis 2 ---- +fitOutcomeModelArgs2 <- createFitOutcomeModelArgs( + modelType = "cox", + stratified = TRUE +) + +cmAnalysis2 <- createCmAnalysis( + analysisId = 2, + description = "Matching", + getDbCohortMethodDataArgs = getDbCmDataArgs, + createStudyPopArgs = createStudyPopArgs2, + createPsArgs = createPsArgs, + matchOnPsArgs = matchOnPsArgs, + computeSharedCovariateBalanceArgs = computeSharedCovBalArgs, + computeCovariateBalanceArgs = computeCovBalArgs, + fitOutcomeModelArgs = fitOutcomeModelArgs2 +) + +## Analysis 3 ---- +fitOutcomeModelArgs3 <- createFitOutcomeModelArgs( + modelType = "cox", + inversePtWeighting = TRUE +) +cmAnalysis3 <- createCmAnalysis( + analysisId = 3, + description = "IPTW", + getDbCohortMethodDataArgs = getDbCmDataArgs, + createStudyPopArgs = createStudyPopArgs2, + createPsArgs = createPsArgs, + truncateIptwArgs = truncateIptwArgs, + computeSharedCovariateBalanceArgs = computeSharedCovBalArgs, + fitOutcomeModelArgs = fitOutcomeModelArgs3 +) + +## Analysis 4 ---- +fitOutcomeModelArgs4 <- createFitOutcomeModelArgs( + modelType = "cox", + stratified = TRUE, + interactionCovariateIds = 8532001 +) + +cmAnalysis4 <- createCmAnalysis( + analysisId = 4, + description = "Matching with gender interaction", + getDbCohortMethodDataArgs = getDbCmDataArgs, + createStudyPopArgs = createStudyPopArgs2, + createPsArgs = createPsArgs, + matchOnPsArgs = matchOnPsArgs, + fitOutcomeModelArgs = fitOutcomeModelArgs4 +) + +cmAnalysisList <- list(cmAnalysis1, cmAnalysis2, cmAnalysis3, cmAnalysis4) + # Clean-up ---- withr::defer({ unlink(outputFolder) From 2873518b9b83ad537c5f4644550a9cf6ce333680 Mon Sep 17 00:00:00 2001 From: Maarten van Kessel Date: Wed, 30 Aug 2023 15:30:44 +0200 Subject: [PATCH 4/7] Updated unit tests --- tests/testthat/test-runCmAnalyses.R | 1021 +++++++++++++-------------- 1 file changed, 480 insertions(+), 541 deletions(-) diff --git a/tests/testthat/test-runCmAnalyses.R b/tests/testthat/test-runCmAnalyses.R index 53626310..1d354c9c 100644 --- a/tests/testthat/test-runCmAnalyses.R +++ b/tests/testthat/test-runCmAnalyses.R @@ -1,73 +1,6 @@ -# Setup ---- library(testthat) library(CohortMethod) -## Analysis 1 ---- -fitOutcomeModelArgs1 <- createFitOutcomeModelArgs( - modelType = "cox" -) - -cmAnalysis1 <- createCmAnalysis( - analysisId = 1, - description = "No matching, simple outcome model", - getDbCohortMethodDataArgs = getDbCmDataArgs, - createStudyPopArgs = createStudyPopArgs1, - fitOutcomeModelArgs = fitOutcomeModelArgs1 -) - -## Analysis 2 ---- -fitOutcomeModelArgs2 <- createFitOutcomeModelArgs( - modelType = "cox", - stratified = TRUE -) - -cmAnalysis2 <- createCmAnalysis( - analysisId = 2, - description = "Matching", - getDbCohortMethodDataArgs = getDbCmDataArgs, - createStudyPopArgs = createStudyPopArgs2, - createPsArgs = createPsArgs, - matchOnPsArgs = matchOnPsArgs, - computeSharedCovariateBalanceArgs = computeSharedCovBalArgs, - computeCovariateBalanceArgs = computeCovBalArgs, - fitOutcomeModelArgs = fitOutcomeModelArgs2 -) - -## Analysis 3 ---- -fitOutcomeModelArgs3 <- createFitOutcomeModelArgs( - modelType = "cox", - inversePtWeighting = TRUE -) -cmAnalysis3 <- createCmAnalysis( - analysisId = 3, - description = "IPTW", - getDbCohortMethodDataArgs = getDbCmDataArgs, - createStudyPopArgs = createStudyPopArgs2, - createPsArgs = createPsArgs, - truncateIptwArgs = truncateIptwArgs, - computeSharedCovariateBalanceArgs = computeSharedCovBalArgs, - fitOutcomeModelArgs = fitOutcomeModelArgs3 -) - -## Analysis 4 ---- -fitOutcomeModelArgs4 <- createFitOutcomeModelArgs( - modelType = "cox", - stratified = TRUE, - interactionCovariateIds = 8532001 -) - -cmAnalysis4 <- createCmAnalysis( - analysisId = 4, - description = "Matching with gender interaction", - getDbCohortMethodDataArgs = getDbCmDataArgs, - createStudyPopArgs = createStudyPopArgs2, - createPsArgs = createPsArgs, - matchOnPsArgs = matchOnPsArgs, - fitOutcomeModelArgs = fitOutcomeModelArgs4 -) - -cmAnalysisList <- list(cmAnalysis1, cmAnalysis2, cmAnalysis3, cmAnalysis4) - # Tests ---- test_that("Warnings set 1/2", { unlink(outputFolder, recursive = TRUE) @@ -117,7 +50,7 @@ test_that("targetComparatorOutcomeList", { unlink(outputFolder, recursive = TRUE) ### list() ---- expect_error( - suppressWarnings(runCmAnalyses( + runCmAnalyses( connectionDetails = connectionDetails, cdmDatabaseSchema = "main", exposureTable = "cohort", @@ -125,13 +58,13 @@ test_that("targetComparatorOutcomeList", { outputFolder = outputFolder, cmAnalysisList = cmAnalysisList, targetComparatorOutcomesList = list() - )), + ), "Must have length >= 1" ) ### NULL ---- expect_error( - suppressWarnings(runCmAnalyses( + runCmAnalyses( connectionDetails = connectionDetails, cdmDatabaseSchema = "main", exposureTable = "cohort", @@ -139,13 +72,13 @@ test_that("targetComparatorOutcomeList", { outputFolder = outputFolder, cmAnalysisList = cmAnalysisList, targetComparatorOutcomesList = NULL - )), + ), "Must be of type 'list'" ) ### list(list(), list()) ---- expect_error( - suppressWarnings(runCmAnalyses( + runCmAnalyses( connectionDetails = connectionDetails, cdmDatabaseSchema = "main", exposureTable = "cohort", @@ -153,13 +86,13 @@ test_that("targetComparatorOutcomeList", { outputFolder = outputFolder, cmAnalysisList = cmAnalysisList, targetComparatorOutcomesList = list(list(), list()) - )), - "Must inherit from.+'targetComparatorOutcomes'" + ), + "targetComparatorOutcomesList.+types:.+targetComparatorOutcomes" ) ### list(NULL, NULL) ---- expect_error( - suppressWarnings(runCmAnalyses( + runCmAnalyses( connectionDetails = connectionDetails, cdmDatabaseSchema = "main", exposureTable = "cohort", @@ -167,472 +100,478 @@ test_that("targetComparatorOutcomeList", { outputFolder = outputFolder, cmAnalysisList = cmAnalysisList, targetComparatorOutcomesList = list(NULL, NULL) + ), + "targetComparatorOutcomesList.+types:.+targetComparatorOutcomes" + ) +}) + +test_that("tempEmulationSchema", { + unlink(outputFolder, recursive = TRUE) + ### "main" + expect_no_error( + suppressWarnings(runCmAnalyses( + connectionDetails = connectionDetails, + cdmDatabaseSchema = "main", + exposureTable = "cohort", + outcomeTable = "cohort", + outputFolder = outputFolder, + cmAnalysisList = cmAnalysisList, + targetComparatorOutcomesList = targetComparatorOutcomesList, + # Eunomia + tempEmulationSchema = "main" + ) + )) + + ### 3 ---- + unlink(outputFolder, recursive = TRUE) + expect_error( + runCmAnalyses( + connectionDetails = connectionDetails, + cdmDatabaseSchema = "main", + exposureTable = "cohort", + outcomeTable = "cohort", + outputFolder = outputFolder, + cmAnalysisList = cmAnalysisList, + targetComparatorOutcomesList = targetComparatorOutcomesList, + tempEmulationSchema = 3 + ), + "Must be of type 'character'" + ) + + ### c("main", "main") ---- + unlink(outputFolder, recursive = TRUE) + expect_error( + suppressWarnings(runCmAnalyses( + connectionDetails = connectionDetails, + cdmDatabaseSchema = "main", + exposureTable = "cohort", + outcomeTable = "cohort", + outputFolder = outputFolder, + cmAnalysisList = cmAnalysisList, + targetComparatorOutcomesList = targetComparatorOutcomesList, + tempEmulationSchema = c("main", "main") + )), + "Must have length 1" + ) +}) + +test_that("exposureDatabaseSchema", { + ### "main" ---- + unlink(outputFolder, recursive = TRUE) + expect_no_error( + suppressWarnings(runCmAnalyses( + connectionDetails = connectionDetails, + cdmDatabaseSchema = "main", + exposureTable = "cohort", + outcomeTable = "cohort", + outputFolder = outputFolder, + cmAnalysisList = cmAnalysisList, + targetComparatorOutcomesList = targetComparatorOutcomesList, + exposureDatabaseSchema = "main" + )) + ) + + ### "SchemaThatDoesNotExist" ---- + unlink(outputFolder, recursive = TRUE) + expect_error( + suppressWarnings(runCmAnalyses( + connectionDetails = connectionDetails, + cdmDatabaseSchema = "main", + exposureTable = "cohort", + outcomeTable = "cohort", + outputFolder = outputFolder, + cmAnalysisList = cmAnalysisList, + targetComparatorOutcomesList = targetComparatorOutcomesList, + exposureDatabaseSchema = "SchemaThatDoesNotExist" + )), + "no such table: SchemaThatDoesNotExist.cohort" + ) + + ### 3 ---- + unlink(outputFolder, recursive = TRUE) + expect_error( + suppressWarnings(runCmAnalyses( + connectionDetails = connectionDetails, + cdmDatabaseSchema = "main", + exposureTable = "cohort", + outcomeTable = "cohort", + outputFolder = outputFolder, + cmAnalysisList = cmAnalysisList, + targetComparatorOutcomesList = targetComparatorOutcomesList, + exposureDatabaseSchema = 3 + )), + "Must be of type 'character'" + ) + + ### c("main", "main") ---- + unlink(outputFolder, recursive = TRUE) + expect_error( + suppressWarnings(runCmAnalyses( + connectionDetails = connectionDetails, + cdmDatabaseSchema = "main", + exposureTable = "cohort", + outcomeTable = "cohort", + outputFolder = outputFolder, + cmAnalysisList = cmAnalysisList, + targetComparatorOutcomesList = targetComparatorOutcomesList, + exposureDatabaseSchema = c("main", "main") + )), + "Must have length 1" + ) +}) + +test_that("outcomeDatabaseSchema", { + ### "main" ---- + unlink(outputFolder, recursive = TRUE) + expect_no_error( + suppressWarnings(runCmAnalyses( + connectionDetails = connectionDetails, + cdmDatabaseSchema = "main", + exposureTable = "cohort", + outcomeTable = "cohort", + outputFolder = outputFolder, + cmAnalysisList = cmAnalysisList, + targetComparatorOutcomesList = targetComparatorOutcomesList, + outcomeDatabaseSchema = "main" + )) + ) + + ### 3 ---- + unlink(outputFolder, recursive = TRUE) + expect_error( + suppressWarnings(runCmAnalyses( + connectionDetails = connectionDetails, + cdmDatabaseSchema = "main", + exposureTable = "cohort", + outcomeTable = "cohort", + outputFolder = outputFolder, + cmAnalysisList = cmAnalysisList, + targetComparatorOutcomesList = targetComparatorOutcomesList, + outcomeDatabaseSchema = 3 + )), + "Must be of type 'character'" + ) + + ### c("main", "main") ---- + unlink(outputFolder, recursive = TRUE) + expect_error( + suppressWarnings(runCmAnalyses( + connectionDetails = connectionDetails, + cdmDatabaseSchema = "main", + exposureTable = "cohort", + outcomeTable = "cohort", + outputFolder = outputFolder, + cmAnalysisList = cmAnalysisList, + targetComparatorOutcomesList = targetComparatorOutcomesList, + outcomeDatabaseSchema = c("main", "main") + )), + "Must have length 1" + ) +}) + +test_that("cdmVersion", { + ### "5" ---- + unlink(outputFolder, recursive = TRUE) + expect_no_error( + suppressWarnings(runCmAnalyses( + connectionDetails = connectionDetails, + cdmDatabaseSchema = "main", + exposureTable = "cohort", + outcomeTable = "cohort", + outputFolder = outputFolder, + cmAnalysisList = cmAnalysisList, + targetComparatorOutcomesList = targetComparatorOutcomesList, + cdmVersion = "5" + )) + ) + + ### 5 ---- + unlink(outputFolder, recursive = TRUE) + expect_error( + suppressWarnings(runCmAnalyses( + connectionDetails = connectionDetails, + cdmDatabaseSchema = "main", + exposureTable = "cohort", + outcomeTable = "cohort", + outputFolder = outputFolder, + cmAnalysisList = cmAnalysisList, + targetComparatorOutcomesList = targetComparatorOutcomesList, + cdmVersion = 5 + )), + "Must be of type 'character'" + ) + + ### "Five" ---- + unlink(outputFolder, recursive = TRUE) + expect_error( + suppressWarnings(runCmAnalyses( + connectionDetails = connectionDetails, + cdmDatabaseSchema = "main", + exposureTable = "cohort", + outcomeTable = "cohort", + outputFolder = outputFolder, + cmAnalysisList = cmAnalysisList, + targetComparatorOutcomesList = targetComparatorOutcomesList, + cdmVersion = "Five" + )), + "All elements must have exactly 1 characters" + ) + + ### c("4", "5", "6") ---- + unlink(outputFolder, recursive = TRUE) + expect_error( + suppressWarnings(runCmAnalyses( + connectionDetails = connectionDetails, + cdmDatabaseSchema = "main", + exposureTable = "cohort", + outcomeTable = "cohort", + outputFolder = outputFolder, + cmAnalysisList = cmAnalysisList, + targetComparatorOutcomesList = targetComparatorOutcomesList, + cdmVersion = c("4", "5", "6") )), - "Must inherit from.+'targetComparatorOutcomes'" + "Must have length 1" + ) +}) + +test_that("analysesToExclude", { + unlink(outputFolder, recursive = TRUE) + + analysesToExclude <- data.frame( + targetId = c(998, 998), + analysisId = c(3, 4) + ) + + ### analysesToExclude ---- + expect_no_error( + suppressWarnings(runCmAnalyses( + connectionDetails = connectionDetails, + cdmDatabaseSchema = "main", + exposureTable = "cohort", + outcomeTable = "cohort", + outputFolder = outputFolder, + cmAnalysisList = cmAnalysisList, + targetComparatorOutcomesList = targetComparatorOutcomesList, + analysesToExclude = analysesToExclude + )) + ) + + ### NULL ---- + unlink(outputFolder, recursive = TRUE) + expect_no_error( + suppressWarnings(runCmAnalyses( + connectionDetails = connectionDetails, + cdmDatabaseSchema = "main", + exposureTable = "cohort", + outcomeTable = "cohort", + outputFolder = outputFolder, + cmAnalysisList = cmAnalysisList, + targetComparatorOutcomesList = targetComparatorOutcomesList, + analysesToExclude = NULL + )) + ) + + ### data.frame() ---- + unlink(outputFolder, recursive = TRUE) + expect_error( + suppressWarnings(runCmAnalyses( + connectionDetails = connectionDetails, + cdmDatabaseSchema = "main", + exposureTable = "cohort", + outcomeTable = "cohort", + outputFolder = outputFolder, + cmAnalysisList = cmAnalysisList, + targetComparatorOutcomesList = targetComparatorOutcomesList, + analysesToExclude = data.frame() + )), + "should contain columns 'targetId', 'comparatorId', 'outcomeId', or 'analysisId'" + ) + + ### data.frame(numeric()) ---- + unlink(outputFolder, recursive = TRUE) + expect_warning( + runCmAnalyses( + connectionDetails = connectionDetails, + cdmDatabaseSchema = "main", + exposureTable = "cohort", + outcomeTable = "cohort", + outputFolder = outputFolder, + cmAnalysisList = cmAnalysisList, + targetComparatorOutcomesList = targetComparatorOutcomesList, + analysesToExclude = data.frame( + targetId = numeric(), + comparatorId = numeric(), + outcomeId = numeric(), + analysisId = numeric() + ) + ), + "Passed `data.frame` with 0 rows to parameter: `analysesToExclude`, no analyses excluded." + ) +}) + +test_that("refitPsForEveryOutcome", { + ### FALSE ---- + unlink(outputFolder, recursive = TRUE) + expect_no_error( + suppressWarnings(runCmAnalyses( + connectionDetails = connectionDetails, + cdmDatabaseSchema = "main", + exposureTable = "cohort", + outcomeTable = "cohort", + outputFolder = outputFolder, + cmAnalysisList = cmAnalysisList, + targetComparatorOutcomesList = targetComparatorOutcomesList, + refitPsForEveryOutcome = FALSE + )) + ) + + ### TRUE ---- + # unlink(outputFolder, recursive = TRUE) + # expect_no_error( + # suppressWarnings(runCmAnalyses( + # connectionDetails = connectionDetails, + # cdmDatabaseSchema = "main", + # exposureTable = "cohort", + # outcomeTable = "cohort", + # outputFolder = outputFolder, + # cmAnalysisList = cmAnalysisList, + # targetComparatorOutcomesList = targetComparatorOutcomesList, + # refitPsForEveryOutcome = TRUE + # )) + # ) + # Note: + # Throws Error: + # cannot open file '.\Temp\RtmpwLKCGK\cmData6dbc562227db': it is a directory + + ### 0 ---- + unlink(outputFolder, recursive = TRUE) + expect_error( + suppressWarnings(runCmAnalyses( + connectionDetails = connectionDetails, + cdmDatabaseSchema = "main", + exposureTable = "cohort", + outcomeTable = "cohort", + outputFolder = outputFolder, + cmAnalysisList = cmAnalysisList, + targetComparatorOutcomesList = targetComparatorOutcomesList, + refitPsForEveryOutcome = 0 + )), + "Must be of type 'logical'" + ) +}) + +test_that("refitPsForEveryStudyPopulation", { + ### FALSE ---- + unlink(outputFolder, recursive = TRUE) + expect_no_error( + suppressWarnings(runCmAnalyses( + connectionDetails = connectionDetails, + cdmDatabaseSchema = "main", + exposureTable = "cohort", + outcomeTable = "cohort", + outputFolder = outputFolder, + cmAnalysisList = cmAnalysisList, + targetComparatorOutcomesList = targetComparatorOutcomesList, + refitPsForEveryStudyPopulation = FALSE + )) + ) + + ### TRUE ---- + unlink(outputFolder, recursive = TRUE) + expect_no_error( + suppressWarnings(runCmAnalyses( + connectionDetails = connectionDetails, + cdmDatabaseSchema = "main", + exposureTable = "cohort", + outcomeTable = "cohort", + outputFolder = outputFolder, + cmAnalysisList = cmAnalysisList, + targetComparatorOutcomesList = targetComparatorOutcomesList, + refitPsForEveryStudyPopulation = TRUE + )) + ) + + ### 0 ---- + unlink(outputFolder, recursive = TRUE) + expect_error( + suppressWarnings(runCmAnalyses( + connectionDetails = connectionDetails, + cdmDatabaseSchema = "main", + exposureTable = "cohort", + outcomeTable = "cohort", + outputFolder = outputFolder, + cmAnalysisList = cmAnalysisList, + targetComparatorOutcomesList = targetComparatorOutcomesList, + refitPsForEveryStudyPopulation = 0 + )), + "Must be.+'logical'" + ) +}) + +test_that("refitPsForEveryX", { + unlink(outputFolder, recursive = TRUE) + expect_error(suppressWarnings( + runCmAnalyses( + connectionDetails = connectionDetails, + cdmDatabaseSchema = "main", + exposureTable = "cohort", + outcomeTable = "cohort", + outputFolder = outputFolder, + cmAnalysisList = list(cmAnalysis4), + targetComparatorOutcomesList = targetComparatorOutcomesList, + refitPsForEveryOutcome = TRUE, + refitPsForEveryStudyPopulation = FALSE + ) + ), + "Cannot have refitPsForEveryStudyPopulation = FALSE and refitPsForEveryOutcome = TRUE" + ) +}) + +test_that("multiThreadingSettings", { + ### createDefaultMultiThreadingSettings() ---- + unlink(outputFolder, recursive = TRUE) + expect_no_error( + suppressWarnings(runCmAnalyses( + connectionDetails = connectionDetails, + cdmDatabaseSchema = "main", + exposureTable = "cohort", + outcomeTable = "cohort", + outputFolder = outputFolder, + cmAnalysisList = list(cmAnalysis4), + targetComparatorOutcomesList = targetComparatorOutcomesList, + multiThreadingSettings = createDefaultMultiThreadingSettings(4) + )) + ) + + ### NULL ---- + unlink(outputFolder, recursive = TRUE) + expect_error( + runCmAnalyses( + connectionDetails = connectionDetails, + cdmDatabaseSchema = "main", + exposureTable = "cohort", + outcomeTable = "cohort", + outputFolder = outputFolder, + cmAnalysisList = list(cmAnalysis4), + targetComparatorOutcomesList = targetComparatorOutcomesList, + multiThreadingSettings = NULL + ), + "Must.+class.+CmMultiThreadingSettings" + ) + + ### list() ---- + unlink(outputFolder, recursive = TRUE) + expect_error( + runCmAnalyses( + connectionDetails = connectionDetails, + cdmDatabaseSchema = "main", + exposureTable = "cohort", + outcomeTable = "cohort", + outputFolder = outputFolder, + cmAnalysisList = list(cmAnalysis4), + targetComparatorOutcomesList = targetComparatorOutcomesList, + multiThreadingSettings = list() + ), + "Must.+class.+CmMultiThreadingSettings" ) }) -# -# test_that("tempEmulationSchema", { -# unlink(outputFolder, recursive = TRUE) -# ### "main" -# expect_no_error( -# suppressWarnings(runCmAnalyses( -# connectionDetails = connectionDetails, -# cdmDatabaseSchema = "main", -# exposureTable = "cohort", -# outcomeTable = "cohort", -# outputFolder = outputFolder, -# cmAnalysisList = cmAnalysisList, -# targetComparatorOutcomesList = targetComparatorOutcomesList, -# # Eunomia -# tempEmulationSchema = "main" -# ) -# )) -# -# ### 3 ---- -# unlink(outputFolder, recursive = TRUE) -# expect_error( -# suppressWarnings(runCmAnalyses( -# connectionDetails = connectionDetails, -# cdmDatabaseSchema = "main", -# exposureTable = "cohort", -# outcomeTable = "cohort", -# outputFolder = outputFolder, -# cmAnalysisList = cmAnalysisList, -# targetComparatorOutcomesList = targetComparatorOutcomesList, -# tempEmulationSchema = 3 -# )), -# "Must be of type 'character'" -# ) -# -# ### c("main", "main") ---- -# unlink(outputFolder, recursive = TRUE) -# expect_error( -# suppressWarnings(runCmAnalyses( -# connectionDetails = connectionDetails, -# cdmDatabaseSchema = "main", -# exposureTable = "cohort", -# outcomeTable = "cohort", -# outputFolder = outputFolder, -# cmAnalysisList = cmAnalysisList, -# targetComparatorOutcomesList = targetComparatorOutcomesList, -# tempEmulationSchema = c("main", "main") -# )), -# "Must have length 1" -# ) -# }) -# -# test_that("exposureDatabaseSchema", { -# ### "main" ---- -# unlink(outputFolder, recursive = TRUE) -# expect_no_error( -# suppressWarnings(runCmAnalyses( -# connectionDetails = connectionDetails, -# cdmDatabaseSchema = "main", -# exposureTable = "cohort", -# outcomeTable = "cohort", -# outputFolder = outputFolder, -# cmAnalysisList = cmAnalysisList, -# targetComparatorOutcomesList = targetComparatorOutcomesList, -# exposureDatabaseSchema = "main" -# )) -# ) -# -# ### "SchemaThatDoesNotExist" ---- -# unlink(outputFolder, recursive = TRUE) -# expect_error( -# suppressWarnings(runCmAnalyses( -# connectionDetails = connectionDetails, -# cdmDatabaseSchema = "main", -# exposureTable = "cohort", -# outcomeTable = "cohort", -# outputFolder = outputFolder, -# cmAnalysisList = cmAnalysisList, -# targetComparatorOutcomesList = targetComparatorOutcomesList, -# exposureDatabaseSchema = "SchemaThatDoesNotExist" -# )), -# "no such table: SchemaThatDoesNotExist.cohort" -# ) -# -# ### 3 ---- -# unlink(outputFolder, recursive = TRUE) -# expect_error( -# suppressWarnings(runCmAnalyses( -# connectionDetails = connectionDetails, -# cdmDatabaseSchema = "main", -# exposureTable = "cohort", -# outcomeTable = "cohort", -# outputFolder = outputFolder, -# cmAnalysisList = cmAnalysisList, -# targetComparatorOutcomesList = targetComparatorOutcomesList, -# exposureDatabaseSchema = 3 -# )), -# "Must be of type 'character'" -# ) -# -# ### c("main", "main") ---- -# unlink(outputFolder, recursive = TRUE) -# expect_error( -# suppressWarnings(runCmAnalyses( -# connectionDetails = connectionDetails, -# cdmDatabaseSchema = "main", -# exposureTable = "cohort", -# outcomeTable = "cohort", -# outputFolder = outputFolder, -# cmAnalysisList = cmAnalysisList, -# targetComparatorOutcomesList = targetComparatorOutcomesList, -# exposureDatabaseSchema = c("main", "main") -# )), -# "Must have length 1" -# ) -# }) -# -# test_that("outcomeDatabaseSchema", { -# ### "main" ---- -# unlink(outputFolder, recursive = TRUE) -# expect_no_error( -# suppressWarnings(runCmAnalyses( -# connectionDetails = connectionDetails, -# cdmDatabaseSchema = "main", -# exposureTable = "cohort", -# outcomeTable = "cohort", -# outputFolder = outputFolder, -# cmAnalysisList = cmAnalysisList, -# targetComparatorOutcomesList = targetComparatorOutcomesList, -# outcomeDatabaseSchema = "main" -# )) -# ) -# -# ### 3 ---- -# unlink(outputFolder, recursive = TRUE) -# expect_error( -# suppressWarnings(runCmAnalyses( -# connectionDetails = connectionDetails, -# cdmDatabaseSchema = "main", -# exposureTable = "cohort", -# outcomeTable = "cohort", -# outputFolder = outputFolder, -# cmAnalysisList = cmAnalysisList, -# targetComparatorOutcomesList = targetComparatorOutcomesList, -# outcomeDatabaseSchema = 3 -# )), -# "Must be of type 'character'" -# ) -# -# ### c("main", "main") ---- -# unlink(outputFolder, recursive = TRUE) -# expect_error( -# suppressWarnings(runCmAnalyses( -# connectionDetails = connectionDetails, -# cdmDatabaseSchema = "main", -# exposureTable = "cohort", -# outcomeTable = "cohort", -# outputFolder = outputFolder, -# cmAnalysisList = cmAnalysisList, -# targetComparatorOutcomesList = targetComparatorOutcomesList, -# outcomeDatabaseSchema = c("main", "main") -# )), -# "Must have length 1" -# ) -# }) -# -# test_that("cdmVersion", { -# ### "5" ---- -# unlink(outputFolder, recursive = TRUE) -# expect_no_error( -# suppressWarnings(runCmAnalyses( -# connectionDetails = connectionDetails, -# cdmDatabaseSchema = "main", -# exposureTable = "cohort", -# outcomeTable = "cohort", -# outputFolder = outputFolder, -# cmAnalysisList = cmAnalysisList, -# targetComparatorOutcomesList = targetComparatorOutcomesList, -# cdmVersion = "5" -# )) -# ) -# -# ### 5 ---- -# unlink(outputFolder, recursive = TRUE) -# expect_error( -# suppressWarnings(runCmAnalyses( -# connectionDetails = connectionDetails, -# cdmDatabaseSchema = "main", -# exposureTable = "cohort", -# outcomeTable = "cohort", -# outputFolder = outputFolder, -# cmAnalysisList = cmAnalysisList, -# targetComparatorOutcomesList = targetComparatorOutcomesList, -# cdmVersion = 5 -# )), -# "Must be of type 'character'" -# ) -# -# ### "Five" ---- -# unlink(outputFolder, recursive = TRUE) -# expect_error( -# suppressWarnings(runCmAnalyses( -# connectionDetails = connectionDetails, -# cdmDatabaseSchema = "main", -# exposureTable = "cohort", -# outcomeTable = "cohort", -# outputFolder = outputFolder, -# cmAnalysisList = cmAnalysisList, -# targetComparatorOutcomesList = targetComparatorOutcomesList, -# cdmVersion = "Five" -# )), -# "All elements must have exactly 1 characters" -# ) -# -# ### c("4", "5", "6") ---- -# unlink(outputFolder, recursive = TRUE) -# expect_error( -# suppressWarnings(runCmAnalyses( -# connectionDetails = connectionDetails, -# cdmDatabaseSchema = "main", -# exposureTable = "cohort", -# outcomeTable = "cohort", -# outputFolder = outputFolder, -# cmAnalysisList = cmAnalysisList, -# targetComparatorOutcomesList = targetComparatorOutcomesList, -# cdmVersion = c("4", "5", "6") -# )), -# "Must have length 1" -# ) -# }) -# -# test_that("analysesToExclude", { -# unlink(outputFolder, recursive = TRUE) -# -# analysesToExclude <- data.frame( -# targetId = c(998, 998), -# analysisId = c(3, 4) -# ) -# -# ### analysesToExclude ---- -# expect_no_error( -# suppressWarnings(runCmAnalyses( -# connectionDetails = connectionDetails, -# cdmDatabaseSchema = "main", -# exposureTable = "cohort", -# outcomeTable = "cohort", -# outputFolder = outputFolder, -# cmAnalysisList = cmAnalysisList, -# targetComparatorOutcomesList = targetComparatorOutcomesList, -# analysesToExclude = analysesToExclude -# )) -# ) -# -# ### NULL ---- -# unlink(outputFolder, recursive = TRUE) -# expect_no_error( -# suppressWarnings(runCmAnalyses( -# connectionDetails = connectionDetails, -# cdmDatabaseSchema = "main", -# exposureTable = "cohort", -# outcomeTable = "cohort", -# outputFolder = outputFolder, -# cmAnalysisList = cmAnalysisList, -# targetComparatorOutcomesList = targetComparatorOutcomesList, -# analysesToExclude = NULL -# )) -# ) -# -# ### data.frame() ---- -# unlink(outputFolder, recursive = TRUE) -# expect_error( -# suppressWarnings(runCmAnalyses( -# connectionDetails = connectionDetails, -# cdmDatabaseSchema = "main", -# exposureTable = "cohort", -# outcomeTable = "cohort", -# outputFolder = outputFolder, -# cmAnalysisList = cmAnalysisList, -# targetComparatorOutcomesList = targetComparatorOutcomesList, -# analysesToExclude = data.frame() -# )), -# "should contain columns 'targetId', 'comparatorId', 'outcomeId', or 'analysisId'" -# ) -# -# ### data.frame(numeric()) ---- -# expect_warning( -# suppressWarnings(runCmAnalyses( -# connectionDetails = connectionDetails, -# cdmDatabaseSchema = "main", -# exposureTable = "cohort", -# outcomeTable = "cohort", -# outputFolder = outputFolder, -# cmAnalysisList = cmAnalysisList, -# targetComparatorOutcomesList = targetComparatorOutcomesList, -# analysesToExclude = data.frame( -# targetId = numeric(), -# comparatorId = numeric(), -# outcomeId = numeric(), -# analysisId = numeric() -# )) -# ), -# "Passed `data.frame` with 0 rows to parameter: `analysesToExclude`, no analyses excluded." -# ) -# }) -# -# test_that("refitPsForEveryOutcome", { -# ### FALSE ---- -# unlink(outputFolder, recursive = TRUE) -# expect_no_error( -# suppressWarnings(runCmAnalyses( -# connectionDetails = connectionDetails, -# cdmDatabaseSchema = "main", -# exposureTable = "cohort", -# outcomeTable = "cohort", -# outputFolder = outputFolder, -# cmAnalysisList = cmAnalysisList, -# targetComparatorOutcomesList = targetComparatorOutcomesList, -# refitPsForEveryOutcome = FALSE -# )) -# ) -# -# ### TRUE ---- -# unlink(outputFolder, recursive = TRUE) -# expect_no_error( -# suppressWarnings(runCmAnalyses( -# connectionDetails = connectionDetails, -# cdmDatabaseSchema = "main", -# exposureTable = "cohort", -# outcomeTable = "cohort", -# outputFolder = outputFolder, -# cmAnalysisList = cmAnalysisList, -# targetComparatorOutcomesList = targetComparatorOutcomesList, -# refitPsForEveryOutcome = TRUE -# )) -# ) -# -# ### 0 ---- -# unlink(outputFolder, recursive = TRUE) -# expect_error( -# suppressWarnings(runCmAnalyses( -# connectionDetails = connectionDetails, -# cdmDatabaseSchema = "main", -# exposureTable = "cohort", -# outcomeTable = "cohort", -# outputFolder = outputFolder, -# cmAnalysisList = cmAnalysisList, -# targetComparatorOutcomesList = targetComparatorOutcomesList, -# refitPsForEveryOutcome = 0 -# )), -# "Must be of type 'logical'" -# ) -# }) -# -# test_that("refitPsForEveryStudyPopulation", { -# ### FALSE ---- -# unlink(outputFolder, recursive = TRUE) -# expect_no_error( -# suppressWarnings(runCmAnalyses( -# connectionDetails = connectionDetails, -# cdmDatabaseSchema = "main", -# exposureTable = "cohort", -# outcomeTable = "cohort", -# outputFolder = outputFolder, -# cmAnalysisList = cmAnalysisList, -# targetComparatorOutcomesList = targetComparatorOutcomesList, -# refitPsForEveryStudyPopulation = FALSE -# )) -# ) -# -# ### TRUE ---- -# unlink(outputFolder, recursive = TRUE) -# expect_no_error( -# suppressWarnings(runCmAnalyses( -# connectionDetails = connectionDetails, -# cdmDatabaseSchema = "main", -# exposureTable = "cohort", -# outcomeTable = "cohort", -# outputFolder = outputFolder, -# cmAnalysisList = cmAnalysisList, -# targetComparatorOutcomesList = targetComparatorOutcomesList, -# refitPsForEveryStudyPopulation = TRUE -# )) -# ) -# -# ### 0 ---- -# unlink(outputFolder, recursive = TRUE) -# expect_error( -# suppressWarnings(runCmAnalyses( -# connectionDetails = connectionDetails, -# cdmDatabaseSchema = "main", -# exposureTable = "cohort", -# outcomeTable = "cohort", -# outputFolder = outputFolder, -# cmAnalysisList = cmAnalysisList, -# targetComparatorOutcomesList = targetComparatorOutcomesList, -# refitPsForEveryStudyPopulation = 0 -# )), -# "Must be of type 'logical'" -# ) -# }) -# -# test_that("refitPsForEveryX", { -# unlink(outputFolder, recursive = TRUE) -# expect_error(suppressWarnings( -# runCmAnalyses( -# connectionDetails = connectionDetails, -# cdmDatabaseSchema = "main", -# exposureTable = "cohort", -# outcomeTable = "cohort", -# outputFolder = outputFolder, -# cmAnalysisList = list(cmAnalysis4), -# targetComparatorOutcomesList = targetComparatorOutcomesList, -# refitPsForEveryOutcome = TRUE, -# refitPsForEveryStudyPopulation = FALSE -# ) -# ), -# "Cannot have refitPsForEveryStudyPopulation = FALSE and refitPsForEveryOutcome = TRUE" -# ) -# }) -# -# test_that("multiThreadingSettings", { -# ### createDefaultMultiThreadingSettings() ---- -# # unlink(outputFolder, recursive = TRUE) -# # expect_no_error( -# # suppressWarnings(runCmAnalyses( -# # connectionDetails = connectionDetails, -# # cdmDatabaseSchema = "main", -# # exposureTable = "cohort", -# # outcomeTable = "cohort", -# # outputFolder = outputFolder, -# # cmAnalysisList = list(cmAnalysis4), -# # targetComparatorOutcomesList = targetComparatorOutcomesList, -# # multiThreadingSettings = createDefaultMultiThreadingSettings(4) -# # )) -# # ) -# -# ### NULL ---- -# unlink(outputFolder, recursive = TRUE) -# expect_error( -# runCmAnalyses( -# connectionDetails = connectionDetails, -# cdmDatabaseSchema = "main", -# exposureTable = "cohort", -# outcomeTable = "cohort", -# outputFolder = outputFolder, -# cmAnalysisList = list(cmAnalysis4), -# targetComparatorOutcomesList = targetComparatorOutcomesList, -# multiThreadingSettings = NULL -# ) -# ) -# -# ### list() ---- -# unlink(outputFolder, recursive = TRUE) -# expect_error( -# runCmAnalyses( -# connectionDetails = connectionDetails, -# cdmDatabaseSchema = "main", -# exposureTable = "cohort", -# outcomeTable = "cohort", -# outputFolder = outputFolder, -# cmAnalysisList = list(cmAnalysis4), -# targetComparatorOutcomesList = targetComparatorOutcomesList, -# multiThreadingSettings = list() -# ) -# ) -# }) From 4d3b3a7e31f219b9e4e1dfc4c84be2af18a37d21 Mon Sep 17 00:00:00 2001 From: Maarten van Kessel Date: Thu, 31 Aug 2023 13:42:12 +0200 Subject: [PATCH 5/7] Updated tests --- tests/testthat/test-runCmAnalyses.R | 69 +++++++++++++++++++++++------ 1 file changed, 56 insertions(+), 13 deletions(-) diff --git a/tests/testthat/test-runCmAnalyses.R b/tests/testthat/test-runCmAnalyses.R index 1d354c9c..f69c1edc 100644 --- a/tests/testthat/test-runCmAnalyses.R +++ b/tests/testthat/test-runCmAnalyses.R @@ -426,19 +426,19 @@ test_that("refitPsForEveryOutcome", { ) ### TRUE ---- - # unlink(outputFolder, recursive = TRUE) - # expect_no_error( - # suppressWarnings(runCmAnalyses( - # connectionDetails = connectionDetails, - # cdmDatabaseSchema = "main", - # exposureTable = "cohort", - # outcomeTable = "cohort", - # outputFolder = outputFolder, - # cmAnalysisList = cmAnalysisList, - # targetComparatorOutcomesList = targetComparatorOutcomesList, - # refitPsForEveryOutcome = TRUE - # )) - # ) + unlink(outputFolder, recursive = TRUE) + expect_no_error( + suppressWarnings(runCmAnalyses( + connectionDetails = connectionDetails, + cdmDatabaseSchema = "main", + exposureTable = "cohort", + outcomeTable = "cohort", + outputFolder = outputFolder, + cmAnalysisList = cmAnalysisList, + targetComparatorOutcomesList = targetComparatorOutcomesList, + refitPsForEveryOutcome = TRUE + )) + ) # Note: # Throws Error: # cannot open file '.\Temp\RtmpwLKCGK\cmData6dbc562227db': it is a directory @@ -491,6 +491,49 @@ test_that("refitPsForEveryStudyPopulation", { )) ) + ## output check ---- + refitFalse <- suppressWarnings(runCmAnalyses( + connectionDetails = connectionDetails, + cdmDatabaseSchema = "main", + exposureTable = "cohort", + outcomeTable = "cohort", + outputFolder = outputFolder, + cmAnalysisList = cmAnalysisList, + targetComparatorOutcomesList = targetComparatorOutcomesList, + refitPsForEveryStudyPopulation = FALSE + )) + + refitTrue <- suppressWarnings(runCmAnalyses( + connectionDetails = connectionDetails, + cdmDatabaseSchema = "main", + exposureTable = "cohort", + outcomeTable = "cohort", + outputFolder = outputFolder, + cmAnalysisList = cmAnalysisList, + targetComparatorOutcomesList = targetComparatorOutcomesList, + refitPsForEveryStudyPopulation = TRUE + )) + + # Check refitTrue != refitFalse + expect_false(identical(refitTrue, refitFalse)) + + modelsTrue <- refitTrue$sharedPsFile[ + !refitTrue$sharedPsFile %in% refitFalse$sharedPsFile] + + modelsFalse <- refitFalse$sharedPsFile[ + !refitFalse$sharedPsFile %in% refitTrue$sharedPsFile] + + expectedDif <- c(7L, 7L, 0L, 0L, 7L, 7L, 0L, 0L, 7L, 7L, 0L, 0L) + + actualDif <- lapply(seq_len(length(modelsTrue)), function(i) { + fileFalse <- readRDS(file.path(outputFolder, modelsFalse[i])) + fileTrue <- readRDS(file.path(outputFolder, modelsTrue[i])) + nrow(fileFalse) - nrow(fileTrue) + }) |> + unlist() + + expect_identical(expectedDif, actualDif) + ### 0 ---- unlink(outputFolder, recursive = TRUE) expect_error( From 67720895761a3864fb32cf5cc01c716618cc496f Mon Sep 17 00:00:00 2001 From: Maarten van Kessel Date: Fri, 1 Sep 2023 09:37:38 +0200 Subject: [PATCH 6/7] Added result tests for refitPsForEveryOutcome --- tests/testthat/test-runCmAnalyses.R | 44 +++++++++++++++++++++++++++++ 1 file changed, 44 insertions(+) diff --git a/tests/testthat/test-runCmAnalyses.R b/tests/testthat/test-runCmAnalyses.R index f69c1edc..ef26ee2e 100644 --- a/tests/testthat/test-runCmAnalyses.R +++ b/tests/testthat/test-runCmAnalyses.R @@ -443,6 +443,50 @@ test_that("refitPsForEveryOutcome", { # Throws Error: # cannot open file '.\Temp\RtmpwLKCGK\cmData6dbc562227db': it is a directory + ### Check files ---- + refitTrue <- suppressWarnings(runCmAnalyses( + connectionDetails = connectionDetails, + cdmDatabaseSchema = "main", + exposureTable = "cohort", + outcomeTable = "cohort", + outputFolder = outputFolder, + cmAnalysisList = cmAnalysisList, + targetComparatorOutcomesList = targetComparatorOutcomesList, + refitPsForEveryOutcome = TRUE + )) + + refitFalse <- suppressWarnings(runCmAnalyses( + connectionDetails = connectionDetails, + cdmDatabaseSchema = "main", + exposureTable = "cohort", + outcomeTable = "cohort", + outputFolder = outputFolder, + cmAnalysisList = cmAnalysisList, + targetComparatorOutcomesList = targetComparatorOutcomesList, + refitPsForEveryOutcome = FALSE + )) + + expect_false(identical(refitTrue, refitFalse)) + expect_true(all(grepl( + pattern = "(^StudyPop_l1_s\\d+_t\\d+_c\\d+_o\\d+\\.rds$|^$)", + x = c(refitTrue$studyPopFile, refitFalse$studyPopFile) + ))) + + expect_true(all(grepl( + pattern = "(^Ps_l1_s\\d+_p\\d+_t\\d+_c\\d+\\.rds$|^$)", + x = c(refitTrue$sharedPsFile, refitFalse$sharedPsFile) + ))) + + expect_true(all(grepl( + pattern = "(^Ps_l1_s\\d+_p\\d+_t\\d+_c\\d+_o\\d+\\.rds$|^$)", + x = c(refitTrue$psFile, refitFalse$psFile) + ))) + + expect_true(all(grepl( + pattern = "(^Balance_l1_s\\d+_p\\d+_t\\d+_c\\d+_s\\d+_b\\d+\\.rds$|^$)", + x = c(refitTrue$sharedBalanceFile, refitFalse$sharedBalanceFile) + ))) + ### 0 ---- unlink(outputFolder, recursive = TRUE) expect_error( From a7779c38e6b955bba16f71d91ac9a1d0eac70c2f Mon Sep 17 00:00:00 2001 From: Maarten van Kessel Date: Fri, 1 Sep 2023 10:32:08 +0200 Subject: [PATCH 7/7] Reverted change to seq_len --- R/RunAnalyses.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/RunAnalyses.R b/R/RunAnalyses.R index bf42e6d8..cf6f1f96 100644 --- a/R/RunAnalyses.R +++ b/R/RunAnalyses.R @@ -530,7 +530,7 @@ runCmAnalyses <- function(connectionDetails, ) return(task) } - tasks <- lapply(seq_len(nrow(subset)), createSharedBalanceTask) + tasks <- lapply(1:nrow(subset), createSharedBalanceTask) cluster <- ParallelLogger::makeCluster(min(length(tasks), multiThreadingSettings$computeSharedBalanceThreads)) ParallelLogger::clusterRequire(cluster, "CohortMethod") dummy <- ParallelLogger::clusterApply(cluster, tasks, doComputeSharedBalance)