diff --git a/NAMESPACE b/NAMESPACE index 50e1747b..cdfe1d3f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -30,6 +30,7 @@ export(createResultsDataModelSettings) export(createResultsExecutionSettings) export(execute) export(getCdmDatabaseMetaData) +export(partitionModule) export(uploadResults) export(zipResults) import(CohortGenerator) diff --git a/R/Module-Characterization.R b/R/Module-Characterization.R index f5f8afb4..42488b55 100644 --- a/R/Module-Characterization.R +++ b/R/Module-Characterization.R @@ -263,7 +263,130 @@ CharacterizationModule <- R6::R6Class( ) ) return(specifications) - } + }, + #' @description Summarize the uploaded results for the module + #' @template resultsConnectionDetails + #' @template resultsDataModelSettings + summarizeResults = function(resultsConnectionDetails, resultsDataModelSettings) { + # initialize checks + + schema <- resultsDataModelSettings$resultsDatabaseSchema + prefix <- self$tablePrefix + + checks <- c() + + # connect to resultsConnectionDetails + connectionHandler <- ResultModelManager::ConnectionHandler$new( + connectionDetails = resultsConnectionDetails + ) + + # get time to event database count + result <- connectionHandler$queryDb( + "select count(distinct database_id) as N from @schema.@prefixtime_to_event", + schema = schema, + prefix = prefix + ) + checks <- rbind(checks, data.frame(table = 'time_to_event',database = '-', check = 'database count', value = result$n)) + + # get dechall-rechall database count + result <- connectionHandler$queryDb( + "select count(distinct database_id) as N from @schema.@prefixdechallenge_rechallenge", + schema = schema, + prefix = prefix + ) + checks <- rbind(checks, data.frame(table = 'dechallenge_rechallenge',database = '-', check = 'database count', value = result$n)) + + # get covariates database count + result <- connectionHandler$queryDb( + "select count(distinct database_id) as N from @schema.@prefixcohort_counts", + schema = schema, + prefix = prefix + ) + checks <- rbind(checks, data.frame(table = 'covariates',database = '-', check = 'database count', value = result$n)) + + # check target and outcomes cohorts per database + result <- connectionHandler$queryDb( + 'select database_id, + count(distinct target_cohort_definition_id) as t_n, + count(distinct outcome_cohort_definition_id) as o_n + + from @schema.@prefixtime_to_event + group by database_id;', + schema = schema, + prefix = prefix) + checks <- rbind(checks, data.frame(table = 'time_to_event',database = result$databaseId, check = 'target count', value = result$tN)) + checks <- rbind(checks, data.frame(table = 'time_to_event',database = result$databaseId, check = 'outcome count', value = result$oN)) + + # check target and outcomes cohorts per database + result <- connectionHandler$queryDb( + 'select database_id, + count(distinct target_cohort_definition_id) as t_n, + count(distinct outcome_cohort_definition_id) as o_n + + from @schema.@prefixdechallenge_rechallenge + group by database_id;', + schema = schema, + prefix = prefix) + checks <- rbind(checks, data.frame(table = 'dechallenge_rechallenge',database = result$databaseId, check = 'target count', value = result$tN)) + checks <- rbind(checks, data.frame(table = 'dechallenge_rechallenge',database = result$databaseId, check = 'outcome count', value = result$oN)) + + # check target and outcomes cohorts per database + result <- connectionHandler$queryDb( + 'select database_id, + count(distinct target_cohort_id) as t_n, + count(distinct outcome_cohort_id) as o_n + from @schema.@prefixcohort_counts + group by database_id;', + schema = schema, + prefix = prefix) + checks <- rbind(checks, data.frame(table = 'covariates',database = result$databaseId, check = 'target count', value = result$tN)) + checks <- rbind(checks, data.frame(table = 'covariates',database = result$databaseId, check = 'outcome count', value = result$oN)) + + message('Characterization uploaded result summary:') + # print out the checksprint(checks) + + return(checks) + }, +#' @description Partions the module specifications into smaller jobs +#' @template analysisSpecifications +#' @param specificationFolder A directory where the partitioned jsons will be saved to +partitionModuleSpecifications = function(analysisSpecifications, specificationFolder) { + + moduleVector <- unlist(lapply(analysisSpecifications$moduleSpecifications, function(ms) ms$module)) + selfInd <- which(moduleVector == self$moduleName) + if(sum(selfInd) == 0){ + message(paste0('No specification found for ',self$moduleName)) + invisible(return(FALSE)) + } + selfSpecification <- analysisSpecifications$moduleSpecifications[[selfInd]] + + # save the full spec as it is because we do not need to split + # create base setting with just shared resources and self spec + baseSettings <- list( + sharedResources = analysisSpecifications$sharedResources, + moduleSpecifications = list(selfSpecification) + ) + + specHashId <- digest::digest2int( + x = as.character(ParallelLogger::convertSettingsToJson(selfSpecification)) + ) + + # now save the fill json spec + if(!dir.exists(specificationFolder)){ + dir.create(specificationFolder, recursive = T) + } + + # save as spec_1.json - same name for each module but will be + # in a different folder + ParallelLogger::saveSettingsToJson( + object = baseSettings, + fileName = file.path(specificationFolder, paste0('spec_',specHashId,'.json')) + ) + + # TODO: could return the parititioned modelDesigns or the list of tempSettings + # or a status/message + invisible(return(file.path(specificationFolder, paste0('spec_',specHashId,'.json')))) +} ), private = list( .getResultsDataModelSpecification = function(tablePrefix = self$tablePrefix) { diff --git a/R/Module-CohortDiagnostics.R b/R/Module-CohortDiagnostics.R index 916f3369..19cd0091 100644 --- a/R/Module-CohortDiagnostics.R +++ b/R/Module-CohortDiagnostics.R @@ -169,6 +169,46 @@ CohortDiagnosticsModule <- R6::R6Class( super$validateModuleSpecifications( moduleSpecifications = moduleSpecifications ) + }, + #' @description Paritions the module specifications into smaller jobs + #' @template analysisSpecifications + #' @param specificationFolder A directory where the partitioned jsons will be saved to + partitionModuleSpecifications = function(analysisSpecifications, specificationFolder) { + + moduleVector <- unlist(lapply(analysisSpecifications$moduleSpecifications, function(ms) ms$module)) + selfInd <- which(moduleVector == self$moduleName) + if(sum(selfInd) == 0){ + message(paste0('No specification found for ',self$moduleName)) + invisible(return(FALSE)) + } + selfSpecification <- analysisSpecifications$moduleSpecifications[[selfInd]] + + # save the full spec as it is because we do not need to split + # create base setting with just shared resources and self spec + baseSettings <- list( + sharedResources = analysisSpecifications$sharedResources, + moduleSpecifications = selfSpecification + ) + + specHashId <- digest::digest2int( + x = as.character(ParallelLogger::convertSettingsToJson(selfSpecification)) + ) + + # now save the fill json spec + if(!dir.exists(specificationFolder)){ + dir.create(specificationFolder, recursive = T) + } + + # save as spec_1.json - same name for each module but will be + # in a different folder + ParallelLogger::saveSettingsToJson( + object = baseSettings, + fileName = file.path(specificationFolder, paste0('spec_',specHashId,'.json')) + ) + + # TODO: could return the parititioned modelDesigns or the list of tempSettings + # or a status/message + invisible(return(file.path(specificationFolder, paste0('spec_',specHashId,'.json')))) } ), private = list( diff --git a/R/Module-CohortGenerator.R b/R/Module-CohortGenerator.R index a5373ee5..8f001712 100644 --- a/R/Module-CohortGenerator.R +++ b/R/Module-CohortGenerator.R @@ -205,6 +205,47 @@ CohortGeneratorModule <- R6::R6Class( className = self$negativeControlOutcomeSharedResourcesClassName, sharedResourcesSpecifications = negativeControlOutcomeCohortSharedResourceSpecifications ) + }, + #' @description Partitions the module specifications into smaller jobs + #' @template analysisSpecifications + #' @param specificationFolder A directory where the partitioned jsons will be saved to + partitionModuleSpecifications = function(analysisSpecifications, specificationFolder) { + + moduleVector <- unlist(lapply(analysisSpecifications$moduleSpecifications, function(ms) ms$module)) + selfInd <- moduleVector == self$moduleName + if(sum(selfInd) == 0){ + message(paste0('No specification found for ',self$moduleName)) + invisible(return(FALSE)) + } + selfSpecification <- analysisSpecifications$moduleSpecifications[selfInd] + + specHashId <- digest::digest2int( + x = as.character(ParallelLogger::convertSettingsToJson(selfSpecification)) + ) + + # save the CohortGenerator as it is because we do not need to split + # create base setting with just shared resources and self spec + baseSettings <- list( + sharedResources = analysisSpecifications$sharedResources, + moduleSpecifications = selfSpecification + ) + + # now save the cohort generator json spec + if(!dir.exists(specificationFolder)){ + dir.create(specificationFolder, recursive = T) + } + + # save as spec_1.json - same name for each module but will be + # in a different folder + ParallelLogger::saveSettingsToJson( + object = baseSettings, + fileName = file.path(specificationFolder, paste0('spec_',specHashId,'.json')) + ) + + + # TODO: could return the parititioned modelDesigns or the list of tempSettings + # or a status/message + invisible(return(file.path(specificationFolder, paste0('spec_',specHashId,'.json')))) } ), private = list( diff --git a/R/Module-CohortIncidence.R b/R/Module-CohortIncidence.R index a0b3fb0b..eaadff39 100644 --- a/R/Module-CohortIncidence.R +++ b/R/Module-CohortIncidence.R @@ -175,6 +175,47 @@ CohortIncidenceModule <- R6::R6Class( designJson <- rJava::J("org.ohdsi.analysis.cohortincidence.design.CohortIncidence")$fromJson(as.character(irDesign$asJSON())) invisible(designJson) + }, + #' @description Partitions the module specifications into smaller jobs + #' @template analysisSpecifications + #' @param specificationFolder A directory where the partitioned jsons will be saved to + partitionModuleSpecifications = function(analysisSpecifications, specificationFolder) { + + moduleVector <- unlist(lapply(analysisSpecifications$moduleSpecifications, function(ms) ms$module)) + selfInd <- moduleVector == self$moduleName + if(sum(selfInd) == 0){ + message(paste0('No specification found for ',self$moduleName)) + invisible(return(FALSE)) + } + selfSpecification <- analysisSpecifications$moduleSpecifications[selfInd] + + specHashId <- digest::digest2int( + x = as.character(ParallelLogger::convertSettingsToJson(selfSpecification)) + ) + + # save the CohortGenerator as it is because we do not need to split + # create base setting with just shared resources and self spec + baseSettings <- list( + sharedResources = analysisSpecifications$sharedResources, + moduleSpecifications = selfSpecification + ) + + # now save the cohort generator json spec + if(!dir.exists(specificationFolder)){ + dir.create(specificationFolder, recursive = T) + } + + # save as spec_1.json - same name for each module but will be + # in a different folder + ParallelLogger::saveSettingsToJson( + object = baseSettings, + fileName = file.path(specificationFolder, paste0('spec_',specHashId,'.json')) + ) + + + # TODO: could return the parititioned modelDesigns or the list of tempSettings + # or a status/message + invisible(return(file.path(specificationFolder, paste0('spec_',specHashId,'.json')))) } ), private = list( diff --git a/R/Module-CohortMethod.R b/R/Module-CohortMethod.R index f6521b55..523aa7be 100644 --- a/R/Module-CohortMethod.R +++ b/R/Module-CohortMethod.R @@ -190,6 +190,69 @@ CohortMethodModule <- R6::R6Class( super$validateModuleSpecifications( moduleSpecifications = moduleSpecifications ) + }, + #' @description Partitions the module specifications into smaller jobs + #' @template analysisSpecifications + #' @param specificationFolder A directory where the partitioned jsons will be saved to + partitionModuleSpecifications = function(analysisSpecifications, specificationFolder) { + + moduleVector <- unlist(lapply(analysisSpecifications$moduleSpecifications, function(ms) ms$module)) + selfInd <- which(moduleVector == self$moduleName) + if(length(selfInd) == 0){ + message(paste0('No specification found for ',self$moduleName)) + invisible(return(FALSE)) + } + selfSpecification <- analysisSpecifications$moduleSpecifications[[selfInd]] + + # selfSpecification$settings$targetComparatorOutcomesList + # cmAnalysisList + # refitPsForEveryOutcome + # refitPsForEveryStudyPopulation + # cmDiagnosticThresholds + + targetIds <- unlist(lapply(selfSpecification$settings$targetComparatorOutcomesList, function(tco) tco$targetId)) + + # split up selfSpecification$settings$targetComparatorOutcomesList + + # for each uniqueTargetIds extract out the targetComparatorOutcomesList + # for the targetId + listOfTCO <- lapply( + X = unique(targetIds), + FUN = function(tId){ + selfSpecification$settings$targetComparatorOutcomesList[which(tId == targetIds)] + }) + + # create base setting with just shared resources and self spec + baseSettings <- list( + sharedResources = analysisSpecifications$sharedResources, + moduleSpecifications = list(selfSpecification) + ) + + # now save each json spec + if(!dir.exists(specificationFolder)){ + dir.create(specificationFolder, recursive = T) + } + + fileVector <- c() + for(i in 1:length(listOfTCO)){ + tempSettings <- baseSettings + tempSettings$moduleSpecifications[[1]]$settings$targetComparatorOutcomesList <- listOfTCO[[i]] + + specHashId <- digest::digest2int( + x = as.character(ParallelLogger::convertSettingsToJson(tempSettings$moduleSpecifications)) + ) + tempFilePath <- file.path(specificationFolder, paste0('spec_',unique(targetIds)[i],'_',specHashId,'.json')) + + fileVector <- c(fileVector,tempFilePath) + # save as spec_i.json - same name for each module but will be + # in a different folder + ParallelLogger::saveSettingsToJson( + object = tempSettings, + fileName = tempFilePath + ) + } + + invisible(return(fileVector)) } ) ) diff --git a/R/Module-PatientLevelPrediction.R b/R/Module-PatientLevelPrediction.R index f7080e01..e51efd5a 100644 --- a/R/Module-PatientLevelPrediction.R +++ b/R/Module-PatientLevelPrediction.R @@ -153,6 +153,224 @@ PatientLevelPredictionModule <- R6::R6Class( super$validateModuleSpecifications( moduleSpecifications = moduleSpecifications ) + }, + #' @description Summarize the uploaded results for the module + #' @template resultsConnectionDetails + #' @template resultsDataModelSettings + summarizeResults = function(resultsConnectionDetails, resultsDataModelSettings) { + # initialize checks + + schema <- resultsDataModelSettings$resultsDatabaseSchema + prefix <- self$tablePrefix + + checks <- c() + + # connect to resultsConnectionDetails + connectionHandler <- ResultModelManager::ConnectionHandler$new( + connectionDetails = resultsConnectionDetails + ) + + # get cohort count + result <- connectionHandler$queryDb( + "select count(distinct cohort_id) as N from @schema.@prefixcohorts", + schema = schema, + prefix = prefix + ) + checks <- rbind(checks, data.frame(table = 'cohorts',database = '-', check = 'count count', value = result$n)) + + # get database count + result <- connectionHandler$queryDb( + "select count(distinct database_id) as N from @schema.@prefixdatabase_meta_data", + schema = schema, + prefix = prefix + ) + checks <- rbind(checks, data.frame(table = 'database_meta_data',database = '-', check = 'database count', value = result$n)) + + # get tar count + result <- connectionHandler$queryDb( + "select count(distinct tar_id) as N from @schema.@prefixtars", + schema = schema, + prefix = prefix + ) + checks <- rbind(checks, data.frame(table = 'tars',database = '-', check = 'tar count', value = result$n)) + + # get population count + result <- connectionHandler$queryDb( + "select count(distinct population_setting_id) as N from @schema.@prefixpopulation_settings", + schema = schema, + prefix = prefix + ) + checks <- rbind(checks, data.frame(table = 'population_settings',database = '-', check = 'population count', value = result$n)) + + # get covariate count + result <- connectionHandler$queryDb( + "select count(distinct covariate_setting_id) as N from @schema.@prefixcovariate_settings", + schema = schema, + prefix = prefix + ) + checks <- rbind(checks, data.frame(table = 'covariate_settings',database = '-', check = 'covariate count', value = result$n)) + + # get model count + result <- connectionHandler$queryDb( + "select count(distinct model_setting_id) as N from @schema.@prefixmodel_settings", + schema = schema, + prefix = prefix + ) + checks <- rbind(checks, data.frame(table = 'model_settings',database = '-', check = 'model count', value = result$n)) + + # get split count + result <- connectionHandler$queryDb( + "select count(distinct split_setting_id) as N from @schema.@prefixsplit_settings", + schema = schema, + prefix = prefix + ) + checks <- rbind(checks, data.frame(table = 'split_settings',database = '-', check = 'split count', value = result$n)) + + # get plp_data_settings count + result <- connectionHandler$queryDb( + "select count(distinct plp_data_setting_id) as N from @schema.@prefixplp_data_settings", + schema = schema, + prefix = prefix + ) + checks <- rbind(checks, data.frame(table = 'plp_data_settings',database = '-', check = 'data setting count', value = result$n)) + + # get tidy_covariates_setting count + result <- connectionHandler$queryDb( + "select count(distinct tidy_covariates_setting_id) as N from @schema.@prefixtidy_covariates_settings", + schema = schema, + prefix = prefix + ) + checks <- rbind(checks, data.frame(table = 'tidy_covariates_settings',database = '-', check = 'tidy covariates count', value = result$n)) + + # get sample_settings count + result <- connectionHandler$queryDb( + "select count(distinct sample_setting_id) as N from @schema.@prefixsample_settings", + schema = schema, + prefix = prefix + ) + checks <- rbind(checks, data.frame(table = 'sample_settings',database = '-', check = 'sample setting count', value = result$n)) + + + # get model_designs count + result <- connectionHandler$queryDb( + "select count(distinct model_design_id) as N from @schema.@prefixmodel_designs", + schema = schema, + prefix = prefix + ) + checks <- rbind(checks, data.frame(table = 'model_designs',database = '-', check = 'model design count', value = result$n)) + + # get diagnostic count of cohorts per database + result <- connectionHandler$queryDb( + "select + dd.database_meta_data_id as database_id, + count(distinct md.target_id) as t_n, + count(distinct md.outcome_id) as o_n + from @schema.@prefixdiagnostics d + inner join + @schema.@prefixmodel_designs md + on + md.model_design_id = d.model_design_id + inner join + @schema.@prefixdatabase_details dd + on d.database_id = dd.database_id + group by dd.database_id;", + schema = schema, + prefix = prefix + ) + if(nrow(result)>0){ + checks <- rbind(checks, data.frame(table = 'diagnostic',database = result$databaseId, check = 'target count', value = result$tN)) + checks <- rbind(checks, data.frame(table = 'diagnostic',database = result$databaseId, check = 'outcome count', value = result$oN)) + } + + + # get performance count of cohorts per database + result <- connectionHandler$queryDb( + "select + dd.database_meta_data_id as database_id, + count(distinct p.target_id) as t_n, + count(distinct p.outcome_id) as o_n + from @schema.@prefixperformances p + inner join + @schema.@prefixdatabase_details dd + on p.development_database_id = dd.database_id + group by dd.database_id;", + schema = schema, + prefix = prefix + ) + if(nrow(result)>0){ + checks <- rbind(checks, data.frame(table = 'performance',database = result$databaseId, check = 'target count', value = result$tN)) + checks <- rbind(checks, data.frame(table = 'performance',database = result$databaseId, check = 'outcome count', value = result$oN)) + } + + message('PatientLevelPrediction uploaded result summary:') + # print out the checksprint(checks) + + return(checks) + }, + #' @description Paritions the module specifications into smaller jobs + #' @template analysisSpecifications + #' @param specificationFolder A directory where the partitioned jsons will be saved to + partitionModuleSpecifications = function(analysisSpecifications, specificationFolder) { + + moduleVector <- unlist(lapply(analysisSpecifications$moduleSpecifications, function(ms) ms$module)) + selfInd <- which(moduleVector == self$moduleName) + + if(length(selfInd) == 0){ + message(paste0('No specification found for ',self$moduleName)) + invisible(return(FALSE)) + } + selfSpecification <- analysisSpecifications$moduleSpecifications[[selfInd]] + + modelDesignList <- selfSpecification$settings$modelDesignList + #TODO can modelDesignList be a single modelDesign? If so, check and cast to list + + # split the modelDesign list by targetId + targetIds <- unlist(lapply(modelDesignList, function(md){md$targetId})) + + # for each targetId create a seperate modelDesignList + listOfmodelDesignList <- lapply( + X = unique(targetIds), + FUN = function(tId){ + modelDesignList[which(tId == targetIds)] + }) + + # create base setting with just shared resources and self spec + baseSettings <- list( + sharedResources = analysisSpecifications$sharedResources, + moduleSpecifications = list(selfSpecification) + ) + + # now save each json spec + if(!dir.exists(specificationFolder)){ + dir.create(specificationFolder, recursive = T) + } + + fileVector <- c() + for(i in 1:length(listOfmodelDesignList)){ + # replace complete modelList with the small modelList + # for each partition of modelList + # TODO: could also reduce the sharedResources cohort definitions to just + # those needed for the partition + tempSettings <- baseSettings + tempSettings$moduleSpecifications[[1]]$settings$modelDesignList <- listOfmodelDesignList[[i]] + + specHashId <- digest::digest2int( + x = as.character(ParallelLogger::convertSettingsToJson(tempSettings$moduleSpecifications)) + ) + tempFilePath <- file.path(specificationFolder, paste0('spec_',unique(targetIds)[i],'_',specHashId,'.json')) + fileVector <- c(fileVector,tempFilePath) + + # save as spec_i.json - same name for each module but will be + # in a different folder + ParallelLogger::saveSettingsToJson( + object = tempSettings, + fileName = tempFilePath + ) + } + + # TODO: could return the parititioned modelDesigns or the list of tempSettings + # or a status/message + invisible(return(fileVector)) } ), private = list( diff --git a/R/Module-SelfControlledCaseSeries.R b/R/Module-SelfControlledCaseSeries.R index fda82d3a..25103a43 100644 --- a/R/Module-SelfControlledCaseSeries.R +++ b/R/Module-SelfControlledCaseSeries.R @@ -161,6 +161,121 @@ SelfControlledCaseSeriesModule <- R6::R6Class( super$validateModuleSpecifications( moduleSpecifications = moduleSpecifications ) + }, + #' @description Partitions the module specifications into smaller jobs + #' @template analysisSpecifications + #' @param specificationFolder A directory where the partitioned jsons will be saved to + partitionModuleSpecifications = function(analysisSpecifications, specificationFolder) { + + moduleVector <- unlist(lapply(analysisSpecifications$moduleSpecifications, function(ms) ms$module)) + selfInd <- which(moduleVector == self$moduleName) + if(length(selfInd) == 0){ + message(paste0('No specification found for ',self$moduleName)) + invisible(return(FALSE)) + } + selfSpecification <- analysisSpecifications$moduleSpecifications[[selfInd]] + + + #outcomeId, nestingCohortId, exposure:exposureId/exposureIdRef/trueEffectSize + + # Split by nestingCohortId and exposureId or by outcomeId + + eoComponents <- .extractExposuresOutcomeComponents(selfSpecification$settings$exposuresOutcomeList) + + convertNulls <- function(x){ + if(x == 'null'){ + return(NULL) + } + return(as.double(x)) + } + + # create partition list for each exposure and outcome + exposureOI <- unique(eoComponents$exposureId) + listOfEO <- list() + for(i in 1:length(exposureOI)){ + subset <- eoComponents[eoComponents$exposureId== exposureOI[i],] + mainComps <- unique(subset[,c('outcomeId','nestingCohortId')]) + + tempList <- list() + for(j in 1:nrow(mainComps)){ + + ind <- which(subset$outcomeId == mainComps$outcomeId[j] & subset$nestingCohortId == mainComps$nestingCohortId[j]) + + tempList[[j]] <- list( + outcomeId = mainComps$outcomeId[j], + nestingCohortId = convertNulls(mainComps$nestingCohortId[j]), + exposures = lapply(ind, function(k){ + res <- list( + exposureId = subset$exposureId[k], + exposureIdRef = subset$exposureIdRef[k], + trueEffectSize = convertNulls(subset$trueEffectSize[k]) + ) + class(res) <- 'Exposure' + return(res) + } + ) + ) + } + listOfEO[[length(listOfEO) + 1]] <- tempList + } + + + # create base setting with just shared resources and self spec + baseSettings <- list( + sharedResources = analysisSpecifications$sharedResources, + moduleSpecifications = list(selfSpecification) + ) + + # now save each json spec + if(!dir.exists(specificationFolder)){ + dir.create(specificationFolder, recursive = T) + } + + fileVector <- c() + for(i in 1:length(listOfEO)){ + tempSettings <- baseSettings + tempSettings$moduleSpecifications[[1]]$settings$exposuresOutcomeList <- listOfEO[[i]] + + specHashId <- digest::digest2int( + x = as.character(ParallelLogger::convertSettingsToJson(tempSettings$moduleSpecifications)) + ) + tempFilePath <- file.path(specificationFolder, paste0('spec_',exposureOI[i],'_',specHashId,'.json')) + + fileVector <- c(fileVector,tempFilePath) + + # save as spec_i.json - same name for each module but will be + # in a different folder + ParallelLogger::saveSettingsToJson( + object = tempSettings, + fileName = tempFilePath + ) + } + + # TODO: could return the parititioned modelDesigns or the list of tempSettings + # or a status/message + invisible(return(fileVector)) + + } ) ) + + +.extractExposuresOutcomeComponents <- function(exposuresOutcomeList){ + do.call('rbind', lapply(exposuresOutcomeList, function(eol){ + merge( + data.frame( + outcomeId = eol$outcomeId, + nestingCohortId = ifelse(is.null(eol$nestingCohortId), 'null', eol$nestingCohortId) + ), + do.call('rbind', lapply(eol$exposures, + function(x) data.frame( + exposureId = x$exposureId, + exposureIdRef = x$exposureIdRef, + trueEffectSize = ifelse(is.null(x$trueEffectSize), 'null', x$trueEffectSize)) + )) + ) + } + )) +} + diff --git a/R/Module-TreatmentPatterns.R b/R/Module-TreatmentPatterns.R index c17deed4..024251cf 100644 --- a/R/Module-TreatmentPatterns.R +++ b/R/Module-TreatmentPatterns.R @@ -251,6 +251,47 @@ TreatmentPatternsModule <- R6::R6Class( super$validateModuleSpecifications( moduleSpecifications = moduleSpecifications ) + }, + #' @description Partitions the module specifications into smaller jobs + #' @template analysisSpecifications + #' @param specificationFolder A directory where the partitioned jsons will be saved to + partitionModuleSpecifications = function(analysisSpecifications, specificationFolder) { + + moduleVector <- unlist(lapply(analysisSpecifications$moduleSpecifications, function(ms) ms$module)) + selfInd <- moduleVector == self$moduleName + if(sum(selfInd) == 0){ + message(paste0('No specification found for ',self$moduleName)) + invisible(return(FALSE)) + } + selfSpecification <- analysisSpecifications$moduleSpecifications[selfInd] + + specHashId <- digest::digest2int( + x = as.character(ParallelLogger::convertSettingsToJson(selfSpecification)) + ) + + # save the CohortGenerator as it is because we do not need to split + # create base setting with just shared resources and self spec + baseSettings <- list( + sharedResources = analysisSpecifications$sharedResources, + moduleSpecifications = selfSpecification + ) + + # now save the cohort generator json spec + if(!dir.exists(specificationFolder)){ + dir.create(specificationFolder, recursive = T) + } + + # save as spec_1.json - same name for each module but will be + # in a different folder + ParallelLogger::saveSettingsToJson( + object = baseSettings, + fileName = file.path(specificationFolder, paste0('spec_',specHashId,'.json')) + ) + + + # TODO: could return the parititioned modelDesigns or the list of tempSettings + # or a status/message + invisible(return(file.path(specificationFolder, paste0('spec_',specHashId,'.json')))) } ), private = list( diff --git a/R/Partition.R b/R/Partition.R new file mode 100644 index 00000000..cc6e3f3a --- /dev/null +++ b/R/Partition.R @@ -0,0 +1,48 @@ +#' Partition big json into smaller ones +#' +#' @template AnalysisSpecifications +#' @param specificationFolder A folder to save the modules' partitioned jsons to +#' +#' @return +#' Nothing but in specificationFolder there will be a folder per module in analysisSpecifications +#' that contains json files with the partitioned analysis +#' +#' @export +partitionModule <- function(analysisSpecifications, specificationFolder) { + + errorMessages <- checkmate::makeAssertCollection() + checkmate::assertClass(analysisSpecifications, "AnalysisSpecifications", add = errorMessages) + checkmate::assertClass(specificationFolder, "character" , add = errorMessages) + checkmate::reportAssertions(collection = errorMessages) + + modulePartitionFiles <- list() + for (i in 1:length(analysisSpecifications$moduleSpecifications)) { + moduleName <- analysisSpecifications$moduleSpecifications[[i]]$module + modulePartitionFiles[[i]] <- .partitionModule( + moduleName = moduleName, + analysisSpecifications = analysisSpecifications, + specificationFolder = specificationFolder + ) + } + + names(modulePartitionFiles) <- unlist(lapply(analysisSpecifications$moduleSpecifications, function(x) x$module)) + + return(modulePartitionFiles) +} + +.partitionModule <- function(moduleName, analysisSpecifications, specificationFolder) { + + moduleObject <- get(moduleName)$new() + + # save partitioned jsons per module into specificationFolder with each + # moduleName as a subfolder and then spec_i.jsons in those + partitionResult <- moduleObject$partitionModuleSpecifications( + analysisSpecifications = analysisSpecifications, + specificationFolder = file.path(specificationFolder, moduleName) + ) + + #if (executionResult$status == "FAILED") { + # .printErrorMessage(executionResult$error$message) + #} + invisible(return(partitionResult)) +} diff --git a/man/CharacterizationModule.Rd b/man/CharacterizationModule.Rd index 09120dbd..34ef96de 100644 --- a/man/CharacterizationModule.Rd +++ b/man/CharacterizationModule.Rd @@ -26,6 +26,8 @@ the OMOP Common Data Model \item \href{#method-CharacterizationModule-getResultsDataModelSpecification}{\code{CharacterizationModule$getResultsDataModelSpecification()}} \item \href{#method-CharacterizationModule-uploadResults}{\code{CharacterizationModule$uploadResults()}} \item \href{#method-CharacterizationModule-createModuleSpecifications}{\code{CharacterizationModule$createModuleSpecifications()}} +\item \href{#method-CharacterizationModule-summarizeResults}{\code{CharacterizationModule$summarizeResults()}} +\item \href{#method-CharacterizationModule-partitionModuleSpecifications}{\code{CharacterizationModule$partitionModuleSpecifications()}} \item \href{#method-CharacterizationModule-clone}{\code{CharacterizationModule$clone()}} } } @@ -73,6 +75,9 @@ by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecifici \item{\code{analysisSpecifications}}{An object of type \code{AnalysisSpecifications} as created by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} +\item{\code{analysisSpecifications}}{An object of type \code{AnalysisSpecifications} as created +by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} + \item{\code{executionSettings}}{An object of type \code{ExecutionSettings} as created by \code{\link[=createCdmExecutionSettings]{createCdmExecutionSettings()}} or \code{\link[=createResultsExecutionSettings]{createResultsExecutionSettings()}}.} } @@ -103,6 +108,10 @@ is an object of class \code{connectionDetails} as created by the is an object of class \code{connectionDetails} as created by the \code{\link[DatabaseConnector:createConnectionDetails]{DatabaseConnector::createConnectionDetails()}} function.} +\item{\code{resultsConnectionDetails}}{The connection details to the results database which +is an object of class \code{connectionDetails} as created by the +\code{\link[DatabaseConnector:createConnectionDetails]{DatabaseConnector::createConnectionDetails()}} function.} + \item{\code{resultsDatabaseSchema}}{The schema in the results database that holds the results data model.} \item{\code{tablePrefix}}{A prefix to apply to the database table names (optional).} @@ -155,12 +164,21 @@ is an object of class \code{connectionDetails} as created by the is an object of class \code{connectionDetails} as created by the \code{\link[DatabaseConnector:createConnectionDetails]{DatabaseConnector::createConnectionDetails()}} function.} +\item{\code{resultsConnectionDetails}}{The connection details to the results database which +is an object of class \code{connectionDetails} as created by the +\code{\link[DatabaseConnector:createConnectionDetails]{DatabaseConnector::createConnectionDetails()}} function.} + +\item{\code{analysisSpecifications}}{An object of type \code{AnalysisSpecifications} as created +by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} + \item{\code{analysisSpecifications}}{An object of type \code{AnalysisSpecifications} as created by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} \item{\code{analysisSpecifications}}{An object of type \code{AnalysisSpecifications} as created by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} +\item{\code{resultsDataModelSettings}}{The results data model settings as created using [@seealso \code{\link[=createResultsDataModelSettings]{createResultsDataModelSettings()}}]} + \item{\code{resultsDataModelSettings}}{The results data model settings as created using [@seealso \code{\link[=createResultsDataModelSettings]{createResultsDataModelSettings()}}]} } \if{html}{\out{}} @@ -245,6 +263,69 @@ Creates the CharacterizationModule Specifications } } \if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-CharacterizationModule-summarizeResults}{}}} +\subsection{Method \code{summarizeResults()}}{ +Summarize the uploaded results for the module +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{CharacterizationModule$summarizeResults( + resultsConnectionDetails, + resultsDataModelSettings +)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{resultsConnectionDetails}}{The connection details to the results database which +is an object of class \code{connectionDetails} as created by the +\code{\link[DatabaseConnector:createConnectionDetails]{DatabaseConnector::createConnectionDetails()}} function.} + +\item{\code{resultsConnectionDetails}}{The connection details to the results database which +is an object of class \code{connectionDetails} as created by the +\code{\link[DatabaseConnector:createConnectionDetails]{DatabaseConnector::createConnectionDetails()}} function.} + +\item{\code{resultsConnectionDetails}}{The connection details to the results database which +is an object of class \code{connectionDetails} as created by the +\code{\link[DatabaseConnector:createConnectionDetails]{DatabaseConnector::createConnectionDetails()}} function.} + +\item{\code{resultsDataModelSettings}}{The results data model settings as created using [@seealso \code{\link[=createResultsDataModelSettings]{createResultsDataModelSettings()}}]} + +\item{\code{resultsDataModelSettings}}{The results data model settings as created using [@seealso \code{\link[=createResultsDataModelSettings]{createResultsDataModelSettings()}}]} +} +\if{html}{\out{
}} +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-CharacterizationModule-partitionModuleSpecifications}{}}} +\subsection{Method \code{partitionModuleSpecifications()}}{ +Partions the module specifications into smaller jobs +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{CharacterizationModule$partitionModuleSpecifications( + analysisSpecifications, + specificationFolder +)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{analysisSpecifications}}{An object of type \code{AnalysisSpecifications} as created +by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} + +\item{\code{analysisSpecifications}}{An object of type \code{AnalysisSpecifications} as created +by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} + +\item{\code{analysisSpecifications}}{An object of type \code{AnalysisSpecifications} as created +by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} + +\item{\code{specificationFolder}}{A directory where the partitioned jsons will be saved to} +} +\if{html}{\out{
}} +} +} +\if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-CharacterizationModule-clone}{}}} \subsection{Method \code{clone()}}{ diff --git a/man/CohortDiagnosticsModule.Rd b/man/CohortDiagnosticsModule.Rd index 13ba507d..b9057294 100644 --- a/man/CohortDiagnosticsModule.Rd +++ b/man/CohortDiagnosticsModule.Rd @@ -27,6 +27,7 @@ against the OMOP Common Data Model. \item \href{#method-CohortDiagnosticsModule-uploadResults}{\code{CohortDiagnosticsModule$uploadResults()}} \item \href{#method-CohortDiagnosticsModule-createModuleSpecifications}{\code{CohortDiagnosticsModule$createModuleSpecifications()}} \item \href{#method-CohortDiagnosticsModule-validateModuleSpecifications}{\code{CohortDiagnosticsModule$validateModuleSpecifications()}} +\item \href{#method-CohortDiagnosticsModule-partitionModuleSpecifications}{\code{CohortDiagnosticsModule$partitionModuleSpecifications()}} \item \href{#method-CohortDiagnosticsModule-clone}{\code{CohortDiagnosticsModule$clone()}} } } @@ -73,6 +74,9 @@ by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecifici \item{\code{analysisSpecifications}}{An object of type \code{AnalysisSpecifications} as created by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} +\item{\code{analysisSpecifications}}{An object of type \code{AnalysisSpecifications} as created +by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} + \item{\code{executionSettings}}{An object of type \code{ExecutionSettings} as created by \code{\link[=createCdmExecutionSettings]{createCdmExecutionSettings()}} or \code{\link[=createResultsExecutionSettings]{createResultsExecutionSettings()}}.} } @@ -161,6 +165,9 @@ by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecifici \item{\code{analysisSpecifications}}{An object of type \code{AnalysisSpecifications} as created by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} +\item{\code{analysisSpecifications}}{An object of type \code{AnalysisSpecifications} as created +by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} + \item{\code{resultsDataModelSettings}}{The results data model settings as created using [@seealso \code{\link[=createResultsDataModelSettings]{createResultsDataModelSettings()}}]} } \if{html}{\out{}} @@ -247,6 +254,35 @@ Validate the module specifications } } \if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-CohortDiagnosticsModule-partitionModuleSpecifications}{}}} +\subsection{Method \code{partitionModuleSpecifications()}}{ +Paritions the module specifications into smaller jobs +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{CohortDiagnosticsModule$partitionModuleSpecifications( + analysisSpecifications, + specificationFolder +)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{analysisSpecifications}}{An object of type \code{AnalysisSpecifications} as created +by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} + +\item{\code{analysisSpecifications}}{An object of type \code{AnalysisSpecifications} as created +by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} + +\item{\code{analysisSpecifications}}{An object of type \code{AnalysisSpecifications} as created +by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} + +\item{\code{specificationFolder}}{A directory where the partitioned jsons will be saved to} +} +\if{html}{\out{
}} +} +} +\if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-CohortDiagnosticsModule-clone}{}}} \subsection{Method \code{clone()}}{ diff --git a/man/CohortGeneratorModule.Rd b/man/CohortGeneratorModule.Rd index 9d9c25f7..07f80c5f 100644 --- a/man/CohortGeneratorModule.Rd +++ b/man/CohortGeneratorModule.Rd @@ -36,6 +36,7 @@ analysis specification} \item \href{#method-CohortGeneratorModule-validateModuleSpecifications}{\code{CohortGeneratorModule$validateModuleSpecifications()}} \item \href{#method-CohortGeneratorModule-validateCohortSharedResourceSpecifications}{\code{CohortGeneratorModule$validateCohortSharedResourceSpecifications()}} \item \href{#method-CohortGeneratorModule-validateNegativeControlOutcomeCohortSharedResourceSpecifications}{\code{CohortGeneratorModule$validateNegativeControlOutcomeCohortSharedResourceSpecifications()}} +\item \href{#method-CohortGeneratorModule-partitionModuleSpecifications}{\code{CohortGeneratorModule$partitionModuleSpecifications()}} \item \href{#method-CohortGeneratorModule-clone}{\code{CohortGeneratorModule$clone()}} } } @@ -82,6 +83,9 @@ by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecifici \item{\code{analysisSpecifications}}{An object of type \code{AnalysisSpecifications} as created by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} +\item{\code{analysisSpecifications}}{An object of type \code{AnalysisSpecifications} as created +by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} + \item{\code{executionSettings}}{An object of type \code{ExecutionSettings} as created by \code{\link[=createCdmExecutionSettings]{createCdmExecutionSettings()}} or \code{\link[=createResultsExecutionSettings]{createResultsExecutionSettings()}}.} } @@ -170,6 +174,9 @@ by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecifici \item{\code{analysisSpecifications}}{An object of type \code{AnalysisSpecifications} as created by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} +\item{\code{analysisSpecifications}}{An object of type \code{AnalysisSpecifications} as created +by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} + \item{\code{resultsDataModelSettings}}{The results data model settings as created using [@seealso \code{\link[=createResultsDataModelSettings]{createResultsDataModelSettings()}}]} } \if{html}{\out{}} @@ -299,6 +306,35 @@ Validate the cohort shared resource specifications } } \if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-CohortGeneratorModule-partitionModuleSpecifications}{}}} +\subsection{Method \code{partitionModuleSpecifications()}}{ +Partitions the module specifications into smaller jobs +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{CohortGeneratorModule$partitionModuleSpecifications( + analysisSpecifications, + specificationFolder +)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{analysisSpecifications}}{An object of type \code{AnalysisSpecifications} as created +by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} + +\item{\code{analysisSpecifications}}{An object of type \code{AnalysisSpecifications} as created +by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} + +\item{\code{analysisSpecifications}}{An object of type \code{AnalysisSpecifications} as created +by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} + +\item{\code{specificationFolder}}{A directory where the partitioned jsons will be saved to} +} +\if{html}{\out{
}} +} +} +\if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-CohortGeneratorModule-clone}{}}} \subsection{Method \code{clone()}}{ diff --git a/man/CohortIncidenceModule.Rd b/man/CohortIncidenceModule.Rd index e286310c..fff28e0b 100644 --- a/man/CohortIncidenceModule.Rd +++ b/man/CohortIncidenceModule.Rd @@ -26,6 +26,7 @@ Computes incidence rates for cohorts against the OMOP Common Data Model \item \href{#method-CohortIncidenceModule-uploadResults}{\code{CohortIncidenceModule$uploadResults()}} \item \href{#method-CohortIncidenceModule-createModuleSpecifications}{\code{CohortIncidenceModule$createModuleSpecifications()}} \item \href{#method-CohortIncidenceModule-validateModuleSpecifications}{\code{CohortIncidenceModule$validateModuleSpecifications()}} +\item \href{#method-CohortIncidenceModule-partitionModuleSpecifications}{\code{CohortIncidenceModule$partitionModuleSpecifications()}} \item \href{#method-CohortIncidenceModule-clone}{\code{CohortIncidenceModule$clone()}} } } @@ -72,6 +73,9 @@ by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecifici \item{\code{analysisSpecifications}}{An object of type \code{AnalysisSpecifications} as created by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} +\item{\code{analysisSpecifications}}{An object of type \code{AnalysisSpecifications} as created +by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} + \item{\code{executionSettings}}{An object of type \code{ExecutionSettings} as created by \code{\link[=createCdmExecutionSettings]{createCdmExecutionSettings()}} or \code{\link[=createResultsExecutionSettings]{createResultsExecutionSettings()}}.} } @@ -160,6 +164,9 @@ by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecifici \item{\code{analysisSpecifications}}{An object of type \code{AnalysisSpecifications} as created by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} +\item{\code{analysisSpecifications}}{An object of type \code{AnalysisSpecifications} as created +by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} + \item{\code{resultsDataModelSettings}}{The results data model settings as created using [@seealso \code{\link[=createResultsDataModelSettings]{createResultsDataModelSettings()}}]} } \if{html}{\out{}} @@ -201,6 +208,35 @@ Validate the module specifications } } \if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-CohortIncidenceModule-partitionModuleSpecifications}{}}} +\subsection{Method \code{partitionModuleSpecifications()}}{ +Partitions the module specifications into smaller jobs +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{CohortIncidenceModule$partitionModuleSpecifications( + analysisSpecifications, + specificationFolder +)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{analysisSpecifications}}{An object of type \code{AnalysisSpecifications} as created +by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} + +\item{\code{analysisSpecifications}}{An object of type \code{AnalysisSpecifications} as created +by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} + +\item{\code{analysisSpecifications}}{An object of type \code{AnalysisSpecifications} as created +by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} + +\item{\code{specificationFolder}}{A directory where the partitioned jsons will be saved to} +} +\if{html}{\out{
}} +} +} +\if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-CohortIncidenceModule-clone}{}}} \subsection{Method \code{clone()}}{ diff --git a/man/CohortMethodModule.Rd b/man/CohortMethodModule.Rd index 6b3b7c7c..4b7821d4 100644 --- a/man/CohortMethodModule.Rd +++ b/man/CohortMethodModule.Rd @@ -20,6 +20,7 @@ the OMOP Common Data Model \item \href{#method-CohortMethodModule-uploadResults}{\code{CohortMethodModule$uploadResults()}} \item \href{#method-CohortMethodModule-createModuleSpecifications}{\code{CohortMethodModule$createModuleSpecifications()}} \item \href{#method-CohortMethodModule-validateModuleSpecifications}{\code{CohortMethodModule$validateModuleSpecifications()}} +\item \href{#method-CohortMethodModule-partitionModuleSpecifications}{\code{CohortMethodModule$partitionModuleSpecifications()}} \item \href{#method-CohortMethodModule-clone}{\code{CohortMethodModule$clone()}} } } @@ -147,6 +148,9 @@ is an object of class \code{connectionDetails} as created by the \item{\code{analysisSpecifications}}{An object of type \code{AnalysisSpecifications} as created by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} +\item{\code{analysisSpecifications}}{An object of type \code{AnalysisSpecifications} as created +by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} + \item{\code{resultsDataModelSettings}}{The results data model settings as created using [@seealso \code{\link[=createResultsDataModelSettings]{createResultsDataModelSettings()}}]} } \if{html}{\out{}} @@ -235,6 +239,32 @@ Validate the module specifications } } \if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-CohortMethodModule-partitionModuleSpecifications}{}}} +\subsection{Method \code{partitionModuleSpecifications()}}{ +Partitions the module specifications into smaller jobs +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{CohortMethodModule$partitionModuleSpecifications( + analysisSpecifications, + specificationFolder +)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{analysisSpecifications}}{An object of type \code{AnalysisSpecifications} as created +by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} + +\item{\code{analysisSpecifications}}{An object of type \code{AnalysisSpecifications} as created +by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} + +\item{\code{specificationFolder}}{A directory where the partitioned jsons will be saved to} +} +\if{html}{\out{
}} +} +} +\if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-CohortMethodModule-clone}{}}} \subsection{Method \code{clone()}}{ diff --git a/man/PatientLevelPredictionModule.Rd b/man/PatientLevelPredictionModule.Rd index 5c53846b..97fc36d9 100644 --- a/man/PatientLevelPredictionModule.Rd +++ b/man/PatientLevelPredictionModule.Rd @@ -27,6 +27,8 @@ database in the OMOP Common Data Model. \item \href{#method-PatientLevelPredictionModule-uploadResults}{\code{PatientLevelPredictionModule$uploadResults()}} \item \href{#method-PatientLevelPredictionModule-createModuleSpecifications}{\code{PatientLevelPredictionModule$createModuleSpecifications()}} \item \href{#method-PatientLevelPredictionModule-validateModuleSpecifications}{\code{PatientLevelPredictionModule$validateModuleSpecifications()}} +\item \href{#method-PatientLevelPredictionModule-summarizeResults}{\code{PatientLevelPredictionModule$summarizeResults()}} +\item \href{#method-PatientLevelPredictionModule-partitionModuleSpecifications}{\code{PatientLevelPredictionModule$partitionModuleSpecifications()}} \item \href{#method-PatientLevelPredictionModule-clone}{\code{PatientLevelPredictionModule$clone()}} } } @@ -73,6 +75,9 @@ by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecifici \item{\code{analysisSpecifications}}{An object of type \code{AnalysisSpecifications} as created by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} +\item{\code{analysisSpecifications}}{An object of type \code{AnalysisSpecifications} as created +by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} + \item{\code{executionSettings}}{An object of type \code{ExecutionSettings} as created by \code{\link[=createCdmExecutionSettings]{createCdmExecutionSettings()}} or \code{\link[=createResultsExecutionSettings]{createResultsExecutionSettings()}}.} } @@ -103,6 +108,10 @@ is an object of class \code{connectionDetails} as created by the is an object of class \code{connectionDetails} as created by the \code{\link[DatabaseConnector:createConnectionDetails]{DatabaseConnector::createConnectionDetails()}} function.} +\item{\code{resultsConnectionDetails}}{The connection details to the results database which +is an object of class \code{connectionDetails} as created by the +\code{\link[DatabaseConnector:createConnectionDetails]{DatabaseConnector::createConnectionDetails()}} function.} + \item{\code{resultsDatabaseSchema}}{The schema in the results database that holds the results data model.} \item{\code{tablePrefix}}{A prefix to apply to the database table names (optional).} @@ -155,12 +164,21 @@ is an object of class \code{connectionDetails} as created by the is an object of class \code{connectionDetails} as created by the \code{\link[DatabaseConnector:createConnectionDetails]{DatabaseConnector::createConnectionDetails()}} function.} +\item{\code{resultsConnectionDetails}}{The connection details to the results database which +is an object of class \code{connectionDetails} as created by the +\code{\link[DatabaseConnector:createConnectionDetails]{DatabaseConnector::createConnectionDetails()}} function.} + +\item{\code{analysisSpecifications}}{An object of type \code{AnalysisSpecifications} as created +by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} + \item{\code{analysisSpecifications}}{An object of type \code{AnalysisSpecifications} as created by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} \item{\code{analysisSpecifications}}{An object of type \code{AnalysisSpecifications} as created by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} +\item{\code{resultsDataModelSettings}}{The results data model settings as created using [@seealso \code{\link[=createResultsDataModelSettings]{createResultsDataModelSettings()}}]} + \item{\code{resultsDataModelSettings}}{The results data model settings as created using [@seealso \code{\link[=createResultsDataModelSettings]{createResultsDataModelSettings()}}]} } \if{html}{\out{}} @@ -201,6 +219,69 @@ Validate the module specifications } } \if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-PatientLevelPredictionModule-summarizeResults}{}}} +\subsection{Method \code{summarizeResults()}}{ +Summarize the uploaded results for the module +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{PatientLevelPredictionModule$summarizeResults( + resultsConnectionDetails, + resultsDataModelSettings +)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{resultsConnectionDetails}}{The connection details to the results database which +is an object of class \code{connectionDetails} as created by the +\code{\link[DatabaseConnector:createConnectionDetails]{DatabaseConnector::createConnectionDetails()}} function.} + +\item{\code{resultsConnectionDetails}}{The connection details to the results database which +is an object of class \code{connectionDetails} as created by the +\code{\link[DatabaseConnector:createConnectionDetails]{DatabaseConnector::createConnectionDetails()}} function.} + +\item{\code{resultsConnectionDetails}}{The connection details to the results database which +is an object of class \code{connectionDetails} as created by the +\code{\link[DatabaseConnector:createConnectionDetails]{DatabaseConnector::createConnectionDetails()}} function.} + +\item{\code{resultsDataModelSettings}}{The results data model settings as created using [@seealso \code{\link[=createResultsDataModelSettings]{createResultsDataModelSettings()}}]} + +\item{\code{resultsDataModelSettings}}{The results data model settings as created using [@seealso \code{\link[=createResultsDataModelSettings]{createResultsDataModelSettings()}}]} +} +\if{html}{\out{
}} +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-PatientLevelPredictionModule-partitionModuleSpecifications}{}}} +\subsection{Method \code{partitionModuleSpecifications()}}{ +Paritions the module specifications into smaller jobs +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{PatientLevelPredictionModule$partitionModuleSpecifications( + analysisSpecifications, + specificationFolder +)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{analysisSpecifications}}{An object of type \code{AnalysisSpecifications} as created +by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} + +\item{\code{analysisSpecifications}}{An object of type \code{AnalysisSpecifications} as created +by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} + +\item{\code{analysisSpecifications}}{An object of type \code{AnalysisSpecifications} as created +by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} + +\item{\code{specificationFolder}}{A directory where the partitioned jsons will be saved to} +} +\if{html}{\out{
}} +} +} +\if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PatientLevelPredictionModule-clone}{}}} \subsection{Method \code{clone()}}{ diff --git a/man/SelfControlledCaseSeriesModule.Rd b/man/SelfControlledCaseSeriesModule.Rd index 90edb2ba..7fb18160 100644 --- a/man/SelfControlledCaseSeriesModule.Rd +++ b/man/SelfControlledCaseSeriesModule.Rd @@ -27,6 +27,7 @@ against the OMOP Common Data Model. \item \href{#method-SelfControlledCaseSeriesModule-uploadResults}{\code{SelfControlledCaseSeriesModule$uploadResults()}} \item \href{#method-SelfControlledCaseSeriesModule-createModuleSpecifications}{\code{SelfControlledCaseSeriesModule$createModuleSpecifications()}} \item \href{#method-SelfControlledCaseSeriesModule-validateModuleSpecifications}{\code{SelfControlledCaseSeriesModule$validateModuleSpecifications()}} +\item \href{#method-SelfControlledCaseSeriesModule-partitionModuleSpecifications}{\code{SelfControlledCaseSeriesModule$partitionModuleSpecifications()}} \item \href{#method-SelfControlledCaseSeriesModule-clone}{\code{SelfControlledCaseSeriesModule$clone()}} } } @@ -73,6 +74,9 @@ by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecifici \item{\code{analysisSpecifications}}{An object of type \code{AnalysisSpecifications} as created by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} +\item{\code{analysisSpecifications}}{An object of type \code{AnalysisSpecifications} as created +by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} + \item{\code{executionSettings}}{An object of type \code{ExecutionSettings} as created by \code{\link[=createCdmExecutionSettings]{createCdmExecutionSettings()}} or \code{\link[=createResultsExecutionSettings]{createResultsExecutionSettings()}}.} } @@ -163,6 +167,9 @@ by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecifici \item{\code{analysisSpecifications}}{An object of type \code{AnalysisSpecifications} as created by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} +\item{\code{analysisSpecifications}}{An object of type \code{AnalysisSpecifications} as created +by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} + \item{\code{resultsDataModelSettings}}{The results data model settings as created using [@seealso \code{\link[=createResultsDataModelSettings]{createResultsDataModelSettings()}}]} } \if{html}{\out{}} @@ -219,6 +226,35 @@ Validate the module specifications } } \if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-SelfControlledCaseSeriesModule-partitionModuleSpecifications}{}}} +\subsection{Method \code{partitionModuleSpecifications()}}{ +Partitions the module specifications into smaller jobs +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{SelfControlledCaseSeriesModule$partitionModuleSpecifications( + analysisSpecifications, + specificationFolder +)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{analysisSpecifications}}{An object of type \code{AnalysisSpecifications} as created +by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} + +\item{\code{analysisSpecifications}}{An object of type \code{AnalysisSpecifications} as created +by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} + +\item{\code{analysisSpecifications}}{An object of type \code{AnalysisSpecifications} as created +by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} + +\item{\code{specificationFolder}}{A directory where the partitioned jsons will be saved to} +} +\if{html}{\out{
}} +} +} +\if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-SelfControlledCaseSeriesModule-clone}{}}} \subsection{Method \code{clone()}}{ diff --git a/man/TreatmentPatternsModule.Rd b/man/TreatmentPatternsModule.Rd index 34fe65a2..0126250d 100644 --- a/man/TreatmentPatternsModule.Rd +++ b/man/TreatmentPatternsModule.Rd @@ -26,6 +26,7 @@ Characterization and description of patterns of events (cohorts). against the OM \item \href{#method-TreatmentPatternsModule-uploadResults}{\code{TreatmentPatternsModule$uploadResults()}} \item \href{#method-TreatmentPatternsModule-createModuleSpecifications}{\code{TreatmentPatternsModule$createModuleSpecifications()}} \item \href{#method-TreatmentPatternsModule-validateModuleSpecifications}{\code{TreatmentPatternsModule$validateModuleSpecifications()}} +\item \href{#method-TreatmentPatternsModule-partitionModuleSpecifications}{\code{TreatmentPatternsModule$partitionModuleSpecifications()}} \item \href{#method-TreatmentPatternsModule-clone}{\code{TreatmentPatternsModule$clone()}} } } @@ -72,6 +73,9 @@ by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecifici \item{\code{analysisSpecifications}}{An object of type \code{AnalysisSpecifications} as created by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} +\item{\code{analysisSpecifications}}{An object of type \code{AnalysisSpecifications} as created +by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} + \item{\code{executionSettings}}{An object of type \code{ExecutionSettings} as created by \code{\link[=createCdmExecutionSettings]{createCdmExecutionSettings()}} or \code{\link[=createResultsExecutionSettings]{createResultsExecutionSettings()}}.} } @@ -160,6 +164,9 @@ by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecifici \item{\code{analysisSpecifications}}{An object of type \code{AnalysisSpecifications} as created by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} +\item{\code{analysisSpecifications}}{An object of type \code{AnalysisSpecifications} as created +by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} + \item{\code{resultsDataModelSettings}}{The results data model settings as created using [@seealso \code{\link[=createResultsDataModelSettings]{createResultsDataModelSettings()}}]} } \if{html}{\out{}} @@ -275,6 +282,35 @@ Validate the module specifications } } \if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-TreatmentPatternsModule-partitionModuleSpecifications}{}}} +\subsection{Method \code{partitionModuleSpecifications()}}{ +Partitions the module specifications into smaller jobs +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{TreatmentPatternsModule$partitionModuleSpecifications( + analysisSpecifications, + specificationFolder +)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{analysisSpecifications}}{An object of type \code{AnalysisSpecifications} as created +by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} + +\item{\code{analysisSpecifications}}{An object of type \code{AnalysisSpecifications} as created +by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} + +\item{\code{analysisSpecifications}}{An object of type \code{AnalysisSpecifications} as created +by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} + +\item{\code{specificationFolder}}{A directory where the partitioned jsons will be saved to} +} +\if{html}{\out{
}} +} +} +\if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-TreatmentPatternsModule-clone}{}}} \subsection{Method \code{clone()}}{ diff --git a/man/partitionModule.Rd b/man/partitionModule.Rd new file mode 100644 index 00000000..cccda9c6 --- /dev/null +++ b/man/partitionModule.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Partition.R +\name{partitionModule} +\alias{partitionModule} +\title{Partition big json into smaller ones} +\usage{ +partitionModule(analysisSpecifications, specificationFolder) +} +\arguments{ +\item{analysisSpecifications}{An object of type \code{AnalysisSpecifications} as created +by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} + +\item{specificationFolder}{A folder to save the modules' partitioned jsons to} +} +\value{ +Nothing but in specificationFolder there will be a folder per module in analysisSpecifications +that contains json files with the partitioned analysis +} +\description{ +Partition big json into smaller ones +} diff --git a/tests/testthat/test-Partition.R b/tests/testthat/test-Partition.R new file mode 100644 index 00000000..7e8c4ae9 --- /dev/null +++ b/tests/testthat/test-Partition.R @@ -0,0 +1,340 @@ +analysisSpecifications <- ParallelLogger::loadSettingsFromJson( + fileName = system.file("testdata/cdmModulesAnalysisSpecifications.json", + package = "Strategus" + ) +) +specificationFolder <- file.path(tempDir, "specificationFolderTest") +if (!dir.exists(specificationFolder)) { + dir.create(specificationFolder, recursive = TRUE) +} + +withr::defer( + { + unlink(specificationFolder, recursive = TRUE, force = TRUE) + }, + testthat::teardown_env() +) + +# call the function that partitions the spec c("CohortGeneratorModule", "PatientLevelPredictionModule")] +Strategus:::partitionModule(analysisSpecifications, specificationFolder) + +test_that("Partition study has all modules", { + + # now check all the modules are in specificationFolder + modulesInSpec <- unlist(lapply(analysisSpecifications$moduleSpecifications, function(ms) ms$module)) + testthat::expect_true(sum(modulesInSpec %in% dir(specificationFolder)) == length(modulesInSpec)) +}) + +moduleNames <- c("CohortGeneratorModule","CharacterizationModule", "CohortIncidenceModule") +for(moduleName in moduleNames){ + +test_that(paste0("Partition study works for those that save single specs - ", moduleName), { + # now check each module jsons combine to the original + # ========================================== + # CohortGenerator/Characterization/CohortIncidence + # + # modules that do not partition due to being database + # rather than cpu heavy + # ========================================== + modulesInSpec <- unlist(lapply(analysisSpecifications$moduleSpecifications, function(ms) ms$module)) + + ind <- which(modulesInSpec == moduleName) + originalSetting <- analysisSpecifications$moduleSpecifications[[ind]]$settings + + jsons <- dir(file.path(specificationFolder,moduleName)) + + # check there is only one json + testthat::expect_true(length(jsons) == 1) + + spec <- list() + length(spec) <- length(jsons) + for(i in 1:length(jsons)){ + spec[[i]] <- ParallelLogger::loadSettingsFromJson( + file.path( + specificationFolder, + moduleName, + jsons[i] + ) + ) + } + + # check shared resources are the same and match the original + sharedResources <- unique(lapply(spec, function(x) x$sharedResources)) + sharedResources[[length(sharedResources) + 1]] <- analysisSpecifications$sharedResources + testthat::expect_true(length(unique(sharedResources)) == 1) + + # check the saved settings and the original + settings <- list() + for(i in 1:length(jsons)){ + settings <- append(settings, spec[[i]]$moduleSpecifications[[1]]$settings) + } + testthat::expect_true(identical(settings,originalSetting)) + +}) + +} + +test_that("Partition study works for PLP", { + # ========================================== + # PatientLevelPrediction + # ========================================== + modulesInSpec <- unlist(lapply(analysisSpecifications$moduleSpecifications, function(ms) ms$module)) + + plpInd <- which(modulesInSpec == "PatientLevelPredictionModule") + originalModelDesignList <- analysisSpecifications$moduleSpecifications[[plpInd]]$settings$modelDesignList + + jsons <- dir(file.path(specificationFolder,"PatientLevelPredictionModule")) + spec <- list() + length(spec) <- length(jsons) + for(i in 1:length(jsons)){ + spec[[i]] <- ParallelLogger::loadSettingsFromJson( + file.path( + specificationFolder, + "PatientLevelPredictionModule", + jsons[i] + ) + ) + } + + # check there is a single module spec + for(i in 1:length(jsons)){ + testthat::expect_true(length(spec[[i]]$moduleSpecifications) == 1) + } + + # check shared resources are the same and match the original + sharedResources <- unique(lapply(spec, function(x) x$sharedResources)) + sharedResources[[length(sharedResources) + 1]] <- analysisSpecifications$sharedResources + testthat::expect_true(length(unique(sharedResources)) == 1) + + # now check the moduleSpecifications combine to original + # for plp combine all the modelDesigns + modelDesignList <- list() + for(i in 1:length(jsons)){ + modelDesignList <- append(modelDesignList, spec[[i]]$moduleSpecifications[[1]]$settings$modelDesignList) + } + + # check same size + testthat::expect_true(length(modelDesignList) == length(originalModelDesignList)) + # check model designs the same + testthat::expect_true(sum(modelDesignList %in% originalModelDesignList) == length(originalModelDesignList)) + + +}) + + +test_that("Partition study works for CM", { + # ========================================== + # CohortMethod + # ========================================== + modulesInSpec <- unlist(lapply(analysisSpecifications$moduleSpecifications, function(ms) ms$module)) + + moduleName <- "CohortMethodModule" + + ind <- which(modulesInSpec == moduleName) + originalSettings <- analysisSpecifications$moduleSpecifications[[ind]]$settings + + jsons <- dir(file.path(specificationFolder,moduleName)) + spec <- list() + length(spec) <- length(jsons) + for(i in 1:length(jsons)){ + spec[[i]] <- ParallelLogger::loadSettingsFromJson( + file.path( + specificationFolder, + moduleName, + jsons[i] + ) + ) + } + + # check there is a single module spec + for(i in 1:length(jsons)){ + testthat::expect_true(length(spec[[i]]$moduleSpecifications) == 1) + } + + # check shared resources are the same and match the original + sharedResources <- unique(lapply(spec, function(x) x$sharedResources)) + sharedResources[[length(sharedResources) + 1]] <- analysisSpecifications$sharedResources + testthat::expect_true(length(unique(sharedResources)) == 1) + + # now check the moduleSpecifications combine to original + settingList <- lapply(spec, function(x) x$moduleSpecifications[[1]]$settings) + + + + # check cmAnalysisList,refitPsForEveryOutcome + # refitPsForEveryStudyPopulation + # cmDiagnosticThresholds + testthat::expect_true(length(unique(lapply(settingList, function(x) x$cmAnalysisList))) == 1) + testthat::expect_true(length(unique(lapply(settingList, function(x) x$refitPsForEveryOutcome))) == 1) + testthat::expect_true(length(unique(lapply(settingList, function(x) x$refitPsForEveryStudyPopulation))) == 1) + testthat::expect_true(length(unique(lapply(settingList, function(x) x$cmDiagnosticThresholds))) == 1) + + if(length(jsons) > 1 ){ + tcoList <- do.call(what = 'append', args = unique(lapply(settingList, function(x) x$targetComparatorOutcomesList))) + testthat::expect_true(sum(unique(do.call('append',lapply(settingList, function(x) x$cmAnalysisList))) %in% originalSettings$cmAnalysisList) == length(originalSettings$cmAnalysisList)) + testthat::expect_true(sum(unique(do.call('append',lapply(settingList, function(x) x$refitPsForEveryOutcome))) %in% originalSettings$refitPsForEveryOutcome) == length(originalSettings$refitPsForEveryOutcome)) + testthat::expect_true(sum(unique(do.call('append',lapply(settingList, function(x) x$refitPsForEveryStudyPopulation))) %in% originalSettings$refitPsForEveryStudyPopulation) == length(originalSettings$refitPsForEveryStudyPopulation)) + testthat::expect_true(sum(unique(do.call('append',lapply(settingList, function(x) x$cmDiagnosticThresholds))) %in% originalSettings$cmDiagnosticThresholds) == length(originalSettings$cmDiagnosticThresholds)) + } else{ + testthat::expect_true(sum(settingList[[1]]$cmAnalysisList %in% originalSettings$cmAnalysisList) == length(originalSettings$cmAnalysisList)) + testthat::expect_true(sum(settingList[[1]]$refitPsForEveryOutcome %in% originalSettings$refitPsForEveryOutcome) == length(originalSettings$refitPsForEveryOutcome)) + testthat::expect_true(sum(settingList[[1]]$refitPsForEveryStudyPopulation %in% originalSettings$refitPsForEveryStudyPopulation) == length(originalSettings$refitPsForEveryStudyPopulation)) + testthat::expect_true(sum(settingList[[1]]$cmDiagnosticThresholds %in% originalSettings$cmDiagnosticThresholds) == length(originalSettings$cmDiagnosticThresholds)) + tcoList <- settingList[[1]]$targetComparatorOutcomesList + } + + # check same length + testthat::expect_true(length(tcoList) == length(originalSettings$targetComparatorOutcomesList)) + # check tco same + testthat::expect_true(sum(tcoList %in% originalSettings$targetComparatorOutcomesList) == length(originalSettings$targetComparatorOutcomesList)) + +}) + + + +test_that("Partition study works for SCCS", { + # ========================================== + # SelfControlledCaseSeries + # ========================================== + modulesInSpec <- unlist(lapply(analysisSpecifications$moduleSpecifications, function(ms) ms$module)) + + moduleName <- "SelfControlledCaseSeriesModule" + + ind <- which(modulesInSpec == moduleName) + originalSettings <- analysisSpecifications$moduleSpecifications[[ind]]$settings + + jsons <- dir(file.path(specificationFolder,moduleName)) + spec <- list() + length(spec) <- length(jsons) + for(i in 1:length(jsons)){ + spec[[i]] <- ParallelLogger::loadSettingsFromJson( + file.path( + specificationFolder, + moduleName, + jsons[i] + ) + ) + } + + # check there is a single module spec + for(i in 1:length(jsons)){ + testthat::expect_true(length(spec[[i]]$moduleSpecifications) == 1) + } + + # check shared resources are the same and match the original + sharedResources <- unique(lapply(spec, function(x) x$sharedResources)) + sharedResources[[length(sharedResources) + 1]] <- analysisSpecifications$sharedResources + testthat::expect_true(length(unique(sharedResources)) == 1) + + # now check the moduleSpecifications combine to original + settingList <- lapply(spec, function(x) x$moduleSpecifications[[1]]$settings) + + # check sccsAnalysisList, combineDataFetchAcrossOutcomes, sccsDiagnosticThresholds + testthat::expect_true(length(unique(lapply(settingList, function(x) x$combineDataFetchAcrossOutcomes))) == 1) + testthat::expect_true(length(unique(lapply(settingList, function(x) x$sccsDiagnosticThresholds))) == 1) + testthat::expect_true(length(unique(lapply(settingList, function(x) x$sccsAnalysisList))) == 1) + + testthat::expect_true(sum(unlist(lapply(settingList, function(x) identical(x$combineDataFetchAcrossOutcomes, originalSettings$combineDataFetchAcrossOutcomes)))) == length(settingList)) + testthat::expect_true(sum(unlist(lapply(settingList, function(x) identical(x$sccsDiagnosticThresholds, originalSettings$sccsDiagnosticThresholds)))) == length(settingList)) + testthat::expect_true(sum(unlist(lapply(settingList, function(x) identical(x$sccsAnalysisList, originalSettings$sccsAnalysisList)))) == length(settingList)) + + if(length(jsons) > 1 ){ + eoList <- do.call(what = 'append', args = unique(lapply(settingList, function(x) x$exposuresOutcomeList))) + } else{ + eoList <- settingList[[1]]$exposuresOutcomeList + } + + # check same number of rows for components + eoComponents <- .extractExposuresOutcomeComponents(eoList) + eoOriginalComponents <- .extractExposuresOutcomeComponents(originalSettings$exposuresOutcomeList) + testthat::expect_true(nrow(eoComponents) == nrow(eoOriginalComponents)) + + # check tco same - paste rows into string and compare + testthat::expect_true(sum(unlist(lapply(1:nrow(eoComponents), function(i){paste0(eoComponents[i,], collapse = '-')})) %in% + unlist(lapply(1:nrow(eoOriginalComponents), function(i){paste0(eoOriginalComponents[i,], collapse = '-')}))) == nrow(eoComponents)) + +}) + +# add test for .extractExposuresOutcomeComponents +test_that(".extractExposuresOutcomeComponents works", { +eo1 <- list( + outcomeId = 10, + nestingCohortId = 100, + exposures = list( + list( + exposureId = 1, + exposureIdRef = 1, + trueEffectSize = NA + ) + ) +) + +eo2 <- list( + outcomeId = 11, + nestingCohortId = 100, + exposures = list( + list( + exposureId = 1, + exposureIdRef = 1, + trueEffectSize = NA + ), + list( + exposureId = 2, + exposureIdRef = 1, + trueEffectSize = 1 + ) + ) +) + +exposuresOutcomeList <- list( + eo1, eo2 +) + +dfEo <- .extractExposuresOutcomeComponents(exposuresOutcomeList) + +testthat::expect_true(nrow(dfEo) == 3) +# test the first row is as expected by rbinding rows and uniqueing +# then checking only one row +testthat::expect_true( + nrow(unique(rbind( + dfEo[1,], + data.frame( + outcomeId = 10, + nestingCohortId = 100, + exposureId = 1, + exposureIdRef = 1, + trueEffectSize = NA + ) + ) + )) == 1) + +# second row +testthat::expect_true( + nrow(unique(rbind( + dfEo[2,], + data.frame( + outcomeId = 11, + nestingCohortId = 100, + exposureId = 1, + exposureIdRef = 1, + trueEffectSize = NA + ) + ) + )) == 1) + +# third row +testthat::expect_true( + nrow(unique(rbind( + dfEo[3,], + data.frame( + outcomeId = 11, + nestingCohortId = 100, + exposureId = 2, + exposureIdRef = 1, + trueEffectSize = 1 + ) + ) + )) == 1) + + +})