diff --git a/DESCRIPTION b/DESCRIPTION index 2695a82e..7cc279ca 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -35,6 +35,7 @@ Suggests: CohortDiagnostics (>= 3.4.0), CohortIncidence, CohortMethod, + ComparatorSelectionExplorer, Cyclops (>= 3.6.0), Eunomia, EvidenceSynthesis (>= 1.0.0), @@ -51,8 +52,10 @@ Suggests: withr Remotes: ohdsi/CohortDiagnostics, + ohdsi/CohortGenerator@develop, ohdsi/CohortIncidence, - ohdsi/CohortMethod + ohdsi/CohortMethod, + ohdsi/ComparatorSelectionExplorer@develop License: Apache License 2.0 VignetteBuilder: knitr URL: https://ohdsi.github.io/Strategus, https://github.com/OHDSI/Strategus diff --git a/NAMESPACE b/NAMESPACE index f546988b..52dfcd4b 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -5,6 +5,7 @@ export(CohortDiagnosticsModule) export(CohortGeneratorModule) export(CohortIncidenceModule) export(CohortMethodModule) +export(ComparatorSelectionExplorerModule) export(EvidenceSynthesisModule) export(PatientLevelPredictionModule) export(PatientLevelPredictionValidationModule) diff --git a/R/Module-CohortGenerator.R b/R/Module-CohortGenerator.R index 7f69b9c7..64fdb7bb 100644 --- a/R/Module-CohortGenerator.R +++ b/R/Module-CohortGenerator.R @@ -119,8 +119,20 @@ CohortGeneratorModule <- R6::R6Class( if (!CohortGenerator::isCohortDefinitionSet(cohortDefinitionSet)) { stop("cohortDefinitionSet is not properly defined") } + sharedResource <- list() + templateDefinitions <- CohortGenerator::getTemplateDefinitions(cohortDefinitionSet) + if (length(templateDefinitions) > 0) { + # Don't save templates as regular cohorts, this is handled entirely in the template definitions + cohortDefinitionSet <- cohortDefinitionSet |> + dplyr::filter(!.data$isTemplatedCohort) + + templateDefs <- lapply(templateDefinitions, function(x) { x$toList() }) + names(templateDefs) <- NULL + sharedResource$templateDefs <- templateDefs + } subsetDefinitions <- CohortGenerator::getSubsetDefinitions(cohortDefinitionSet) + if (length(subsetDefinitions) > 0) { # Filter the cohort definition set to the "parent" cohorts. parentCohortDefinitionSet <- cohortDefinitionSet[!cohortDefinitionSet$isSubset, ] @@ -128,16 +140,16 @@ CohortGeneratorModule <- R6::R6Class( parentCohortDefinitionSet <- cohortDefinitionSet } - sharedResource <- list() + cohortDefinitionSetFiltered <- private$.listafy(parentCohortDefinitionSet) - sharedResource["cohortDefinitions"] <- list(cohortDefinitionSetFiltered) + sharedResource$cohortDefinitions <- cohortDefinitionSetFiltered if (length(subsetDefinitions)) { # Subset definitions subsetDefinitionsJson <- lapply(subsetDefinitions, function(x) { x$toJSON() }) - sharedResource["subsetDefs"] <- list(subsetDefinitionsJson) + sharedResource$subsetDefs <- subsetDefinitionsJson # Filter to the subsets subsetCohortDefinitionSet <- cohortDefinitionSet[cohortDefinitionSet$isSubset, ] @@ -150,7 +162,7 @@ CohortGeneratorModule <- R6::R6Class( ) subsetIdMapping[[i]] <- idMapping } - sharedResource["cohortSubsets"] <- list(subsetIdMapping) + sharedResource$cohortSubsets <- subsetIdMapping } sharedResource <- super$createSharedResourcesSpecifications( diff --git a/R/Module-ComparatorSelectionExplorer.R b/R/Module-ComparatorSelectionExplorer.R new file mode 100644 index 00000000..a06e1a92 --- /dev/null +++ b/R/Module-ComparatorSelectionExplorer.R @@ -0,0 +1,129 @@ +# ComparatorSelectionExplorerModule ------------- +#' @title Analyze comparator selection using the ComparatorSelectionExplorer package +#' @export +#' @description +#' Development and evaluation of comparator selection algorithms +#' against the OMOP Common Data Model. +ComparatorSelectionExplorerModule <- R6::R6Class( + classname = "ComparatorSelectionExplorerModule", + inherit = StrategusModule, + public = list( + #' @field tablePrefix The table prefix to append to results tables + tablePrefix = "cse_", + + #' @description Initialize the module + initialize = function() { + super$initialize() + }, + + #' @description Executes the ComparatorSelectionExplorer package + #' @template connectionDetails + #' @template analysisSpecifications + #' @template executionSettings + execute = function(connectionDetails, analysisSpecifications, executionSettings) { + super$.validateCdmExecutionSettings(executionSettings) + super$execute(connectionDetails, analysisSpecifications, executionSettings) + + jobContext <- private$jobContext + exportFolder <- jobContext$moduleExecutionSettings$resultsSubFolder + args <- jobContext$settings + args$connectionDetails <- connectionDetails + args$cdmDatabaseSchema <- jobContext$moduleExecutionSettings$cdmDatabaseSchema + args$vocabularyDatabaseSchema <- jobContext$moduleExecutionSettings$vocabularyDatabaseSchema + args$resultsDatabaseSchema <- jobContext$moduleExecutionSettings$resultsDatabaseSchema + args$cohortDatabaseSchema <- jobContext$moduleExecutionSettings$workDatabaseSchema + args$tempEmulationSchema <- jobContext$moduleExecutionSettings$tempEmulationSchema + args$cohortDefinitionSet <- super$.createCohortDefinitionSetFromJobContext() + args$exportZipFile <- file.path(exportFolder, "results.zip") + args$incrementalFolder <- jobContext$moduleExecutionSettings$workSubFolder + args$logFileLocation <- file.path(exportFolder, "execution-log.txt") + args$generateCohortDefinitionSet <- TRUE + + # Execute the ComparatorSelectionExplorer package + ComparatorSelectionExplorer::execute(executionSettings = do.call(ComparatorSelectionExplorer::createExecutionSettings, args)) + + private$.message(paste("Results available at:", exportFolder)) + }, + + #' @description Create the results data model for the module + #' @template resultsConnectionDetails + #' @template resultsDatabaseSchema + #' @template tablePrefix + createResultsDataModel = function(resultsConnectionDetails, resultsDatabaseSchema, tablePrefix = self$tablePrefix) { + super$createResultsDataModel(resultsConnectionDetails, resultsDatabaseSchema, tablePrefix) + # Custom results data model creation logic if needed + ComparatorSelectionExplorer::createResultsDataModel(connectionDetails = resultsConnectionDetails, + databaseSchema = resultsDatabaseSchema, + tablePrefix = tablePrefix) + }, + + #' @description Get the results data model specification for the module + #' @template tablePrefix + getResultsDataModelSpecification = function(tablePrefix = "") { + resultsDataModelSpecification <- private$.getResultsDataModelSpecification() + # Add the prefix to the tableName column + resultsDataModelSpecification$tableName <- paste0(tablePrefix, self$tablePrefix, resultsDataModelSpecification$tableName) + return(resultsDataModelSpecification) + }, + + #' @description Upload the results for the module + #' @template resultsConnectionDetails + #' @template analysisSpecifications + #' @template resultsDataModelSettings + uploadResults = function(resultsConnectionDetails, analysisSpecifications, resultsDataModelSettings) { + super$uploadResults(resultsConnectionDetails, analysisSpecifications, resultsDataModelSettings) + + resultsFolder <- private$jobContext$moduleExecutionSettings$resultsSubFolder + zipFiles <- list.files( + path = resultsFolder, + pattern = "\\.zip$", + full.names = TRUE + ) + + if (length(zipFiles) > 0) { + zipFileName <- zipFiles[1] + } else { + DatabaseConnector::createZipFile( + zipFile = "results.zip", + files = list.files(resultsFolder, pattern = ".*\\.csv$"), + rootFolder = resultsFolder + ) + zipFileName <- file.path(resultsFolder, "results.zip") + } + + # Upload results using ComparatorSelectionExplorer + ComparatorSelectionExplorer::uploadResults( + connectionDetails = resultsConnectionDetails, + schema = resultsDataModelSettings$resultsDatabaseSchema, + tablePrefix = self$tablePrefix, + zipFileName = zipFileName + ) + }, + + #' @description Creates the ComparatorSelectionExplorer Module Specifications + #' @param ... Additional arameters for ComparatorSelectionExplorer settings + #' @param minExposureSize minimum number of individuals exposed to be considered in this analysis + #' @param targetCohortIds (optional) subset of cohort definition set to compute all pairwise comparisons for. By the N x N matrix of all similarity scores will be computed. + createModuleSpecifications = function(minExposureSize = 1000, targetCohortIds = NULL, ...) { + checkmate::assertIntegerish(minExposureSize, len = 1, lower = 1) + checkmate::assertNumeric(targetCohortIds, min.len = 1, null.ok = TRUE) + if (!is.null(targetCohortIds)) + checkmate::assertTRUE(all(targetCohortIds %% 1 == 0)) + analysis <- list(minExposureSize = minExposureSize, targetCohortIds = targetCohortIds, ...) + specifications <- super$createModuleSpecifications(moduleSpecifications = analysis) + return(specifications) + }, + + #' @description Validate the module specifications + #' @param moduleSpecifications The ComparatorSelectionExplorer module specifications + validateModuleSpecifications = function(moduleSpecifications) { + super$validateModuleSpecifications(moduleSpecifications = moduleSpecifications) + } + ), + + private = list( + .getResultsDataModelSpecification = function() { + ComparatorSelectionExplorer::getResultsDataModelSpec() + } + ) +) diff --git a/R/StrategusModule.R b/R/StrategusModule.R index ce00cde5..67f4713b 100644 --- a/R/StrategusModule.R +++ b/R/StrategusModule.R @@ -257,6 +257,14 @@ StrategusModule <- R6::R6Class( )) } + if (length(cohortDefinitionSharedResource$templateDefs)) { + for (tplDef in cohortDefinitionSharedResource$templateDefs) { + template <- CohortGenerator::CohortTemplateDefinition$new(tplDef) + cohortDefinitionSet <- cohortDefinitionSet |> + CohortGenerator::addCohortTemplateDefintion(template) + } + } + if (length(cohortDefinitionSharedResource$subsetDefs)) { subsetDefinitions <- lapply(cohortDefinitionSharedResource$subsetDefs, CohortGenerator::CohortSubsetDefinition$new) for (subsetDef in subsetDefinitions) { diff --git a/man/ComparatorSelectionExplorerModule.Rd b/man/ComparatorSelectionExplorerModule.Rd new file mode 100644 index 00000000..89ff5ea2 --- /dev/null +++ b/man/ComparatorSelectionExplorerModule.Rd @@ -0,0 +1,232 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Module-ComparatorSelectionExplorer.R +\name{ComparatorSelectionExplorerModule} +\alias{ComparatorSelectionExplorerModule} +\title{Analyze comparator selection using the ComparatorSelectionExplorer package} +\description{ +Development and evaluation of comparator selection algorithms +against the OMOP Common Data Model. +} +\section{Super class}{ +\code{\link[Strategus:StrategusModule]{Strategus::StrategusModule}} -> \code{ComparatorSelectionExplorerModule} +} +\section{Public fields}{ +\if{html}{\out{
}} +\describe{ +\item{\code{tablePrefix}}{The table prefix to append to results tables} +} +\if{html}{\out{
}} +} +\section{Methods}{ +\subsection{Public methods}{ +\itemize{ +\item \href{#method-ComparatorSelectionExplorerModule-new}{\code{ComparatorSelectionExplorerModule$new()}} +\item \href{#method-ComparatorSelectionExplorerModule-execute}{\code{ComparatorSelectionExplorerModule$execute()}} +\item \href{#method-ComparatorSelectionExplorerModule-createResultsDataModel}{\code{ComparatorSelectionExplorerModule$createResultsDataModel()}} +\item \href{#method-ComparatorSelectionExplorerModule-getResultsDataModelSpecification}{\code{ComparatorSelectionExplorerModule$getResultsDataModelSpecification()}} +\item \href{#method-ComparatorSelectionExplorerModule-uploadResults}{\code{ComparatorSelectionExplorerModule$uploadResults()}} +\item \href{#method-ComparatorSelectionExplorerModule-createModuleSpecifications}{\code{ComparatorSelectionExplorerModule$createModuleSpecifications()}} +\item \href{#method-ComparatorSelectionExplorerModule-validateModuleSpecifications}{\code{ComparatorSelectionExplorerModule$validateModuleSpecifications()}} +\item \href{#method-ComparatorSelectionExplorerModule-clone}{\code{ComparatorSelectionExplorerModule$clone()}} +} +} +\if{html}{\out{ +
Inherited methods + +
+}} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-ComparatorSelectionExplorerModule-new}{}}} +\subsection{Method \code{new()}}{ +Initialize the module +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{ComparatorSelectionExplorerModule$new()}\if{html}{\out{
}} +} + +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-ComparatorSelectionExplorerModule-execute}{}}} +\subsection{Method \code{execute()}}{ +Executes the ComparatorSelectionExplorer package +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{ComparatorSelectionExplorerModule$execute( + connectionDetails, + analysisSpecifications, + executionSettings +)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{connectionDetails}}{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{executionSettings}}{An object of type \code{ExecutionSettings} as created +by \code{\link[=createCdmExecutionSettings]{createCdmExecutionSettings()}} or \code{\link[=createResultsExecutionSettings]{createResultsExecutionSettings()}}.} +} +\if{html}{\out{
}} +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-ComparatorSelectionExplorerModule-createResultsDataModel}{}}} +\subsection{Method \code{createResultsDataModel()}}{ +Create the results data model for the module +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{ComparatorSelectionExplorerModule$createResultsDataModel( + resultsConnectionDetails, + resultsDatabaseSchema, + tablePrefix = self$tablePrefix +)}\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{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).} + +\item{\code{tablePrefix}}{A prefix to apply to the database table names (optional).} +} +\if{html}{\out{
}} +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-ComparatorSelectionExplorerModule-getResultsDataModelSpecification}{}}} +\subsection{Method \code{getResultsDataModelSpecification()}}{ +Get the results data model specification for the module +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{ComparatorSelectionExplorerModule$getResultsDataModelSpecification( + tablePrefix = "" +)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{tablePrefix}}{A prefix to apply to the database table names (optional).} + +\item{\code{tablePrefix}}{A prefix to apply to the database table names (optional).} +} +\if{html}{\out{
}} +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-ComparatorSelectionExplorerModule-uploadResults}{}}} +\subsection{Method \code{uploadResults()}}{ +Upload the results for the module +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{ComparatorSelectionExplorerModule$uploadResults( + resultsConnectionDetails, + analysisSpecifications, + 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{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{
}} +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-ComparatorSelectionExplorerModule-createModuleSpecifications}{}}} +\subsection{Method \code{createModuleSpecifications()}}{ +Creates the ComparatorSelectionExplorer Module Specifications +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{ComparatorSelectionExplorerModule$createModuleSpecifications( + minExposureSize = 1000, + targetCohortIds = NULL, + ... +)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{minExposureSize}}{minimum number of individuals exposed to be considered in this analysis} + +\item{\code{targetCohortIds}}{(optional) subset of cohort definition set to compute all pairwise comparisons for. By the N x N matrix of all similarity scores will be computed.} + +\item{\code{...}}{Additional arameters for ComparatorSelectionExplorer settings} +} +\if{html}{\out{
}} +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-ComparatorSelectionExplorerModule-validateModuleSpecifications}{}}} +\subsection{Method \code{validateModuleSpecifications()}}{ +Validate the module specifications +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{ComparatorSelectionExplorerModule$validateModuleSpecifications( + moduleSpecifications +)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{moduleSpecifications}}{The ComparatorSelectionExplorer module specifications} +} +\if{html}{\out{
}} +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-ComparatorSelectionExplorerModule-clone}{}}} +\subsection{Method \code{clone()}}{ +The objects of this class are cloneable with this method. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{ComparatorSelectionExplorerModule$clone(deep = FALSE)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{deep}}{Whether to make a deep clone.} +} +\if{html}{\out{
}} +} +} +} diff --git a/tests/testthat/test-ComparatorSelectionExplorer.R b/tests/testthat/test-ComparatorSelectionExplorer.R new file mode 100644 index 00000000..3f2524ca --- /dev/null +++ b/tests/testthat/test-ComparatorSelectionExplorer.R @@ -0,0 +1,31 @@ + +test_that("Verify createModuleSpecification input validation works properly", { + cseModule <- ComparatorSelectionExplorerModule$new() + + # Ensure valid inputs do not raise errors + specs <- cseModule$createModuleSpecifications( + targetCohortIds = c(1, 2, 3), + minExposureSize = 1000 + ) + expect_true(is.list(specs)) + expect_equal(specs$settings$targetCohortIds, c(1, 2, 3)) + expect_equal(specs$settings$minExposureSize, 1000) +}) + +test_that("Verify createModuleSpecifications handles optional parameters correctly", { + cseModule <- ComparatorSelectionExplorerModule$new() + + # Verify that excluding optional parameters uses default values + specs <- cseModule$createModuleSpecifications( + targetCohortIds = c(1, 2, 3) + ) + expect_equal(specs$settings$minExposureSize, 1000) # Default value + + # Verify that providing specific optional parameters overrides defaults + specs <- cseModule$createModuleSpecifications( + targetCohortIds = c(1, 2, 3), + minExposureSize = 500, + generateCohortDefinitionSet = FALSE + ) + expect_equal(specs$settings$minExposureSize, 500) +}) diff --git a/tests/testthat/test-ModulesRdms.R b/tests/testthat/test-ModulesRdms.R index 937bf39b..8237aa93 100644 --- a/tests/testthat/test-ModulesRdms.R +++ b/tests/testthat/test-ModulesRdms.R @@ -39,3 +39,7 @@ test_that("PatientLevelPredictionModule results data model is in correct format" test_that("SelfControlledCaseSeriesModule results data model is in correct format", { testResultsDataModelFormat("SelfControlledCaseSeriesModule") }) + +test_that("SelfControlledCaseSeriesModule results data model is in correct format", { + testResultsDataModelFormat("ComparatorSelectionExplorerModule") +})