diff --git a/DESCRIPTION b/DESCRIPTION index 73de4417..11d95ee6 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -54,14 +54,14 @@ Suggests: rmarkdown, RSQLite, SelfControlledCaseSeries (>= 6.0.0), + SelfControlledCohort (>= 2.0.0), testthat (>= 3.0.0), TreatmentPatterns (>= 3.1.0), withr Remotes: ohdsi/Characterization, ohdsi/CohortDiagnostics, - ohdsi/CohortIncidence, - ohdsi/CohortMethod + ohdsi/CohortIncidence 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 b99f5e2f..9bf08925 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -9,6 +9,7 @@ export(EvidenceSynthesisModule) export(PatientLevelPredictionModule) export(PatientLevelPredictionValidationModule) export(SelfControlledCaseSeriesModule) +export(SelfControlledCohortModule) export(StrategusModule) export(TreatmentPatternsModule) export(addCharacterizationModuleSpecifications) diff --git a/R/Module-EvidenceSynthesis.R b/R/Module-EvidenceSynthesis.R index 09e07827..883e185e 100644 --- a/R/Module-EvidenceSynthesis.R +++ b/R/Module-EvidenceSynthesis.R @@ -109,12 +109,12 @@ EvidenceSynthesisModule <- R6::R6Class( #' Create an evidence synthesis source #' #' @param sourceMethod The source method generating the estimates to synthesize. Can be "CohortMethod" or - #' "SelfControlledCaseSeries" + #' "SelfControlledCaseSeries", or "SelfControlledCohort" #' @param databaseIds The database IDs to include. Use `databaseIds = NULL` to include all database IDs. #' @param analysisIds The source method analysis IDs to include. Use `analysisIds = NULL` to include all #' analysis IDs. #' @param likelihoodApproximation The type of likelihood approximation. Can be "adaptive grid", "normal", or "grid - #' with gradients". + #' with gradients". Note: "SelfControlledCohort" only supports "normal". #' #' @return #' An object of type `EvidenceSynthesisSource`. @@ -123,7 +123,7 @@ EvidenceSynthesisModule <- R6::R6Class( analysisIds = NULL, likelihoodApproximation = "grid with gradients") { errorMessages <- checkmate::makeAssertCollection() - checkmate::assertChoice(sourceMethod, c("CohortMethod", "SelfControlledCaseSeries"), add = errorMessages) + checkmate::assertChoice(sourceMethod, c("CohortMethod", "SelfControlledCaseSeries", "SelfControlledCohort"), add = errorMessages) if (is.character(databaseIds)) { checkmate::assertCharacter(databaseIds, null.ok = TRUE, add = errorMessages) } else { @@ -132,6 +132,9 @@ EvidenceSynthesisModule <- R6::R6Class( checkmate::assertIntegerish(analysisIds, null.ok = TRUE, add = errorMessages) checkmate::assertChoice(likelihoodApproximation, c("adaptive grid", "normal", "grid with gradients"), add = errorMessages) checkmate::reportAssertions(collection = errorMessages) + if (sourceMethod == "SelfControlledCohort" && likelihoodApproximation != "normal") { + stop("SelfControlledCohort only supports likelihoodApproximation = 'normal'.") + } analysis <- list() for (name in names(formals(self$createEvidenceSynthesisSource))) { @@ -341,7 +344,9 @@ EvidenceSynthesisModule <- R6::R6Class( "es_cm_shared_covariate_balance", "es_cm_covariate", "es_sccs_result", - "es_sccs_diagnostics_summary" + "es_sccs_diagnostics_summary", + "es_scc_result", + "es_scc_diagnostics_summary" ) invisible(lapply(outputTables, function(x) { private$.ensureEmptyAndExists(x, resultsFolder) @@ -447,12 +452,16 @@ EvidenceSynthesisModule <- R6::R6Class( controlKey <- c("targetComparatorId", "analysisId") } else if (analysisSettings$evidenceSynthesisSource$sourceMethod == "SelfControlledCaseSeries") { controlKey <- c("exposureId", "nestingCohortId", "covariateId", "analysisId") + } else if (analysisSettings$evidenceSynthesisSource$sourceMethod == "SelfControlledCohort") { + controlKey <- c("targetCohortId", "analysisId") } } else if (analysisSettings$controlType == "exposure") { if (analysisSettings$evidenceSynthesisSource$sourceMethod == "CohortMethod") { controlKey <- c("outcomeId", "analysisId") } else if (analysisSettings$evidenceSynthesisSource$sourceMethod == "SelfControlledCaseSeries") { controlKey <- c("outcomeId", "analysisId") + } else if (analysisSettings$evidenceSynthesisSource$sourceMethod == "SelfControlledCohort") { + controlKey <- c("outcomeCohortId", "analysisId") } } else { stop(sprintf("Unknown control type '%s'", analysisSettings$controlType)) @@ -491,9 +500,9 @@ EvidenceSynthesisModule <- R6::R6Class( TRUE ~ "FAIL" )) |> mutate(unblind = ifelse(.data$mdrrDiagnostic != "FAIL" & - .data$easeDiagnostic != "FAIL" & - .data$i2Diagnostic != "FAIL" & - .data$tauDiagnostic != "FAIL", 1, 0)) + .data$easeDiagnostic != "FAIL" & + .data$i2Diagnostic != "FAIL" & + .data$tauDiagnostic != "FAIL", 1, 0)) if (analysisSettings$evidenceSynthesisSource$sourceMethod == "CohortMethod") { passBalance <- function(maxSdm, sdmFamilyWiseMinP) { if (is.null(esDiagnosticThresholds$sdmThreshold)) { @@ -525,6 +534,8 @@ EvidenceSynthesisModule <- R6::R6Class( fileName <- file.path(resultsFolder, "es_cm_diagnostics_summary.csv") } else if (analysisSettings$evidenceSynthesisSource$sourceMethod == "SelfControlledCaseSeries") { fileName <- file.path(resultsFolder, "es_sccs_diagnostics_summary.csv") + } else if (analysisSettings$evidenceSynthesisSource$sourceMethod == "SelfControlledCohort") { + fileName <- file.path(resultsFolder, "es_scc_diagnostics_summary.csv") } else { stop(sprintf("Saving diagnostics summary not implemented for source method '%s'", analysisSettings$evidenceSynthesisSource$sourceMethod)) } @@ -539,6 +550,8 @@ EvidenceSynthesisModule <- R6::R6Class( fileName <- file.path(resultsFolder, "es_cm_result.csv") } else if (analysisSettings$evidenceSynthesisSource$sourceMethod == "SelfControlledCaseSeries") { fileName <- file.path(resultsFolder, "es_sccs_result.csv") + } else if (analysisSettings$evidenceSynthesisSource$sourceMethod == "SelfControlledCohort") { + fileName <- file.path(resultsFolder, "es_scc_result.csv") } else { stop(sprintf("Saving results not implemented for source method '%s'", analysisSettings$evidenceSynthesisSource$sourceMethod)) } @@ -697,6 +710,15 @@ EvidenceSynthesisModule <- R6::R6Class( covariateEras = sumMinCellCount(subset$covariateEras, minCellCount), covariateOutcomes = sumMinCellCount(subset$covariateOutcomes, minCellCount) ) + } else if (analysisSettings$evidenceSynthesisSource$sourceMethod == "SelfControlledCohort") { + counts <- tibble( + numPersons = sumMinCellCount(subset$numPersons, minCellCount), + timeAtRiskExposed = sumMinCellCount(subset$timeAtRiskExposed, 0), + timeAtRiskUnexposed = sumMinCellCount(subset$timeAtRiskUnexposed, 0), + numOutcomesExposed = sumMinCellCount(subset$numOutcomesExposed, minCellCount), + numOutcomesUnexposed = sumMinCellCount(subset$numOutcomesUnexposed, minCellCount), + numExposures = sumMinCellCount(subset$numExposures, minCellCount) + ) } else { stop(sprintf("Aggregating counts not implemented for source method '%s'", analysisSettings$evidenceSynthesisSource$sourceMethod)) } @@ -940,8 +962,8 @@ EvidenceSynthesisModule <- R6::R6Class( ) trueEffectSizes <- trueEffectSizes |> mutate(trueEffectSize = ifelse(!is.na(.data$trueEffectSize) & .data$trueEffectSize == 0, - NA, - .data$trueEffectSize + NA, + .data$trueEffectSize )) } else if (evidenceSynthesisSource$sourceMethod == "SelfControlledCaseSeries") { key <- c("exposureId", "nestingCohortId", "outcomeId", "exposuresOutcomeSetId", "covariateId") @@ -1068,8 +1090,84 @@ EvidenceSynthesisModule <- R6::R6Class( ) trueEffectSizes <- trueEffectSizes |> mutate(trueEffectSize = ifelse(!is.na(.data$trueEffectSize) & .data$trueEffectSize == 0, - NA, - .data$trueEffectSize + NA, + .data$trueEffectSize + )) + } else if (evidenceSynthesisSource$sourceMethod == "SelfControlledCohort") { + key <- c("targetCohortId", "outcomeCohortId") + databaseIds <- evidenceSynthesisSource$databaseIds + analysisIds <- evidenceSynthesisSource$analysisIds + if (evidenceSynthesisSource$likelihoodApproximation != "normal") { + stop("SelfControlledCohort only supports 'normal' likelihood approximation for evidence synthesis.") + } + sql <- "SELECT scc_result.*, + diag.unblind_for_evidence_synthesis AS unblind + FROM @database_schema.scc_result + LEFT JOIN ( + SELECT database_id, + analysis_id, + target_cohort_id, + outcome_cohort_id, + pass AS unblind_for_evidence_synthesis + FROM @database_schema.scc_diagnostics_summary + WHERE diagnostic_name = 'UNBLIND' + ) diag + ON scc_result.database_id = diag.database_id + AND scc_result.analysis_id = diag.analysis_id + AND scc_result.target_cohort_id = diag.target_cohort_id + AND scc_result.outcome_cohort_id = diag.outcome_cohort_id + {@database_ids != ''| @analysis_ids != ''} ? {WHERE} + {@database_ids != ''} ? { scc_result.database_id IN (@database_ids)} + {@analysis_ids != ''} ? { {@database_ids != ''} ? {AND} scc_result.analysis_id IN (@analysis_ids)}; + " + estimates <- DatabaseConnector::renderTranslateQuerySql( + connection = connection, + sql = sql, + database_schema = databaseSchema, + database_ids = if (is.null(databaseIds)) "" else private$.quoteSql(databaseIds), + analysis_ids = if (is.null(analysisIds)) "" else analysisIds, + snakeCaseToCamelCase = TRUE + ) |> + as_tibble() + + # Temp hack: detect NA values that have been converted to 0 in the DB: + idx <- estimates$seLogRr == 0 + estimates$logRr[idx] <- NA + estimates$seLogRr[idx] <- NA + estimates$pValue[idx] <- NA + + # Rename columns to match the expected names used downstream + estimates <- estimates |> + rename( + ci95Lb = .data$lb95, + ci95Ub = .data$ub95, + p = .data$pValue + ) + + llApproximations <- estimates |> + filter(!is.na(.data$unblind) & .data$unblind == 1) |> + select( + "targetCohortId", + "outcomeCohortId", + "analysisId", + "databaseId", + "logRr", + "seLogRr" + ) + + sql <- "SELECT * + FROM @database_schema.scc_outcome_exposure; + " + trueEffectSizes <- DatabaseConnector::renderTranslateQuerySql( + connection = connection, + sql = sql, + database_schema = databaseSchema, + snakeCaseToCamelCase = TRUE + ) + trueEffectSizes <- trueEffectSizes |> + mutate(trueEffectSize = ifelse(!is.na(.data$trueEffectSize) & .data$trueEffectSize == 0, + NA, + .data$trueEffectSize )) } else { stop(sprintf("Evidence synthesis for source method '%s' hasn't been implemented yet.", evidenceSynthesisSource$sourceMethod)) diff --git a/R/Module-SelfControlledCohort.R b/R/Module-SelfControlledCohort.R new file mode 100644 index 00000000..f930c84a --- /dev/null +++ b/R/Module-SelfControlledCohort.R @@ -0,0 +1,160 @@ +# SelfControlledCohort ------------- +#' @title Self-Controlled Cohort design with the \href{https://ohdsi.github.io/SelfControlledCohort/}{HADES SelfControlledCohort Package} +#' @export +#' @description +#' Module for performing Self-Controlled Cohort (SCC) analyses +#' against the OMOP Common Data Model. +#' +#' @details +#' This R6 class acts as a thin wrapper around the SelfControlledCohort package functions. +#' The design pattern used here delegates all implementation logic to the package itself, +#' which means this wrapper should rarely (ideally never) need to change when the underlying +#' package evolves. This approach reduces tight coupling between Strategus and analysis modules, +#' making the system more maintainable and allowing module developers to update their packages +#' independently without requiring changes to the Strategus framework. +SelfControlledCohortModule <- R6::R6Class( + classname = "SelfControlledCohortModule", + inherit = StrategusModule, + public = list( + #' @field tablePrefix The table prefix for results tables + tablePrefix = "scc_", + + #' @description Initialize the module + initialize = function() { + super$initialize() + }, + + #' @description Executes the SelfControlledCohort package + #' @template connectionDetails + #' @template analysisSpecifications + #' @template executionSettings + #' + #' @details + #' This method simply constructs a jobContext object and delegates execution + #' to the package's own execute() function. By keeping this wrapper minimal, + #' we avoid the need to update Strategus every time the underlying analysis + #' logic changes. The package itself owns its execution logic, version checking, + #' and parameter handling - this wrapper just provides the interface contract + #' that Strategus expects. + execute = function(connectionDetails, analysisSpecifications, executionSettings) { + super$.validateCdmExecutionSettings(executionSettings) + super$execute(connectionDetails, analysisSpecifications, executionSettings) + + jobContext <- private$jobContext + exportFolder <- private$jobContext$moduleExecutionSettings$resultsSubFolder + # Delegate to the package's execute function + # The package handles all logic including version checking, parameter validation, + # and actual analysis execution. This wrapper doesn't need to know about those details. + SelfControlledCohort::execute( + connectionDetails = connectionDetails, + executionSettings = executionSettings, + analysisSpecifications = jobContext$settings$parameters, + databaseId = jobContext$moduleExecutionSettings$cdmDatabaseMetaData$databaseId, + exportFolder = exportFolder + ) + + # Handle results metadata - this is framework-level concern, not package concern + resultsDataModel <- self$getResultsDataModelSpecification() + resultsDataModel <- resultsDataModel[file.exists(file.path(exportFolder, paste0(resultsDataModel$tableName, ".csv"))), ] + if (any(!startsWith(resultsDataModel$tableName, self$tablePrefix))) { + stop("Table names do not have required prefix") + } + CohortGenerator::writeCsv( + x = resultsDataModel, + file = file.path(exportFolder, "resultsDataModelSpecification.csv"), + warnOnFileNameCaseMismatch = FALSE + ) + + private$.message(paste("Results available at:", exportFolder)) + }, + + #' @description Create the results data model for the module + #' @template resultsConnectionDetails + #' @template resultsDatabaseSchema + #' @template tablePrefix + #' + #' @details + #' Delegates to the package's own createResultsDataModel function. + #' The package knows its own schema requirements - Strategus just needs to + #' call the function with the appropriate database connection details. + createResultsDataModel = function(resultsConnectionDetails, resultsDatabaseSchema, tablePrefix = "") { + # Direct delegation - no need to replicate schema logic here + SelfControlledCohort::createResultsDataModel( + connectionDetails = resultsConnectionDetails, + databaseSchema = resultsDatabaseSchema, + tablePrefix = tablePrefix + ) + }, + + #' @description Get the results data model specification for the module + #' @template tablePrefix + #' + #' @details + #' Retrieves the data model specification from the package itself. + #' Only framework-specific modification is adding the table prefix. + getResultsDataModelSpecification = function(tablePrefix = "") { + # Get specification from package - it knows its own schema + resultsDataModelSpecification <- SelfControlledCohort::getResultsDataModelSpecifications() + # Apply framework-level prefix requirement + resultsDataModelSpecification$tableName <- paste0(tablePrefix, resultsDataModelSpecification$tableName) + return(resultsDataModelSpecification) + }, + + #' @description Upload the results for the module + #' @template resultsConnectionDetails + #' @template analysisSpecifications + #' @template resultsDataModelSettings + #' @param ... Additional parameters passed to the package's uploadResults function + #' @details + #' Delegates upload logic to the package's uploadResults function. + #' The package handles the specifics of what data needs to be uploaded and how. + uploadResults = function(resultsConnectionDetails, analysisSpecifications, resultsDataModelSettings, ...) { + super$uploadResults(resultsConnectionDetails, analysisSpecifications, resultsDataModelSettings) + jobContext <- private$jobContext + exportFolder <- private$jobContext$moduleExecutionSettings$resultsSubFolder + + analysisSettings <- jobContext$settings$parameters$analysisSettings + resultsFolders <- SelfControlledCohort::getResultsFolders(analysisSettings, exportFolder) + lapply(resultsFolders, function(resultsFolder) { + SelfControlledCohort::uploadResults(connectionDetails = resultsConnectionDetails, + resultsFolder = resultsFolder, + schema = resultsDataModelSettings$resultsDatabaseSchema, + ...) + } + ) + + }, + + #' @description Creates the SelfControlledCohort Module Specifications + #' @param sccAnalysesSpecifications Module specifications created by + #' SelfControlledCohort::createSelfControlledCohortModuleSpecifications() + #' + #' @details + #' Wraps the package's createModuleSpecifications output in Strategus format. + #' The package function already handles versioning, parameter validation, etc. + #' This wrapper just ensures compatibility with Strategus conventions. + createModuleSpecifications = function(sccAnalysesSpecifications) { + # The package creates its own specifications with proper version metadata + # We just need to ensure it's wrapped in the parent class structure + specifications <- super$createModuleSpecifications( + moduleSpecifications = sccAnalysesSpecifications + ) + return(specifications) + }, + + #' @description Validate the module specifications + #' @param moduleSpecifications The SelfControlledCohort module specifications + #' + #' @details + #' Validation happens within the package's execute() function (including version checking). + #' This method provides the Strategus interface but doesn't duplicate validation logic. + validateModuleSpecifications = function(moduleSpecifications) { + # Parent class validation handles framework-level requirements + # Package-specific validation (including version compatibility) happens + # in the package's execute() function via checkModuleVersion() + super$validateModuleSpecifications( + moduleSpecifications = moduleSpecifications + ) + } + ) +) diff --git a/inst/csv/evidenceSynthesisRdms.csv b/inst/csv/evidenceSynthesisRdms.csv index 5dd57be0..8645c60f 100644 --- a/inst/csv/evidenceSynthesisRdms.csv +++ b/inst/csv/evidenceSynthesisRdms.csv @@ -119,4 +119,42 @@ es_sccs_result,calibrated_se_log_rr,float,No,No,No,The standard error of the log es_sccs_result,pi_95_lb,float,No,No,No,The lower bound of the 95% prediction interval of the relative risk. es_sccs_result,pi_95_ub,float,No,No,No,The upper bound of the 95% prediction interval of the relative risk. es_sccs_result,calibrated_pi_95_lb,float,No,No,No,The lower bound of the calibrated 95% prediction interval of the relative risk. -es_sccs_result,calibrated_pi_95_ub,float,No,No,No,The upper bound of the calibrated 95% prediction interval of the relative risk. \ No newline at end of file +es_sccs_result,calibrated_pi_95_ub,float,No,No,No,The upper bound of the calibrated 95% prediction interval of the relative risk. +es_scc_diagnostics_summary,target_cohort_id,bigint,Yes,Yes,No,A foreign key referencing the target cohort. +es_scc_diagnostics_summary,outcome_cohort_id,bigint,Yes,Yes,No,The identifier for the outcome cohort. +es_scc_diagnostics_summary,analysis_id,int,Yes,Yes,No,A unique identifier for the self-controlled cohort analysis. +es_scc_diagnostics_summary,evidence_synthesis_analysis_id,int,Yes,Yes,No,A foreign key referencing the es_analysis table. +es_scc_diagnostics_summary,mdrr,float,No,No,No,The minimum detectable relative risk. +es_scc_diagnostics_summary,i_2,float,No,No,No,The I2 statistic for heterogeneity. +es_scc_diagnostics_summary,tau,float,No,No,No,The estimated tau (standard deviation of the random-effects distribution). +es_scc_diagnostics_summary,ease,float,No,No,No,The expected absolute systematic error. +es_scc_diagnostics_summary,mdrr_diagnostic,varchar(13),Yes,No,No,PASS / NOT EVALUATED / FAIL classification of the MDRR diagnostic. +es_scc_diagnostics_summary,i_2_diagnostic,varchar(13),Yes,No,No,PASS / NOT EVALUATED / FAIL classification of the I2 diagnostic. +es_scc_diagnostics_summary,tau_diagnostic,varchar(13),Yes,No,No,PASS / NOT EVALUATED / FAIL classification of the tau diagnostic. +es_scc_diagnostics_summary,ease_diagnostic,varchar(13),Yes,No,No,PASS / NOT EVALUATED / FAIL classification of the EASE diagnostic. +es_scc_diagnostics_summary,unblind,int,Yes,No,No,"Is unblinding the result recommended? (1 = yes, 0 = no)" +es_scc_result,target_cohort_id,bigint,Yes,Yes,No,A foreign key referencing the target cohort. +es_scc_result,outcome_cohort_id,bigint,Yes,Yes,No,The identifier for the outcome cohort. +es_scc_result,analysis_id,int,Yes,Yes,No,A unique identifier for the self-controlled cohort analysis. +es_scc_result,evidence_synthesis_analysis_id,int,Yes,Yes,No,A foreign key referencing the es_analysis table. +es_scc_result,rr,float,No,No,No,The estimated relative risk (i.e. the incidence rate ratio). +es_scc_result,ci_95_lb,float,No,No,No,The lower bound of the 95% confidence interval of the relative risk. +es_scc_result,ci_95_ub,float,No,No,No,The upper bound of the 95% confidence interval of the relative risk. +es_scc_result,p,float,No,No,No,The two-sided p-value considering the null hypothesis of no effect. +es_scc_result,one_sided_p,float,No,No,No,The one-sided p-value considering the null hypothesis of RR <= 1. +es_scc_result,log_rr,float,No,No,No,The log of the relative risk. +es_scc_result,se_log_rr,float,No,No,No,The standard error of the log of the relative risk. +es_scc_result,num_persons,int,No,No,Yes,The number of persons in the analysis. +es_scc_result,time_at_risk_exposed,bigint,No,No,No,Time at risk while exposed. +es_scc_result,time_at_risk_unexposed,bigint,No,No,No,Time at risk while unexposed. +es_scc_result,num_outcomes_exposed,int,No,No,Yes,The number of outcomes observed during exposed time. +es_scc_result,num_outcomes_unexposed,int,No,No,Yes,The number of outcomes observed during unexposed time. +es_scc_result,num_exposures,int,No,No,Yes,The number of exposures. +es_scc_result,n_databases,int,Yes,No,No,The number of databases that contributed to the meta-analytic estimate. +es_scc_result,calibrated_rr,float,No,No,No,The calibrated relative risk. +es_scc_result,calibrated_ci_95_lb,float,No,No,No,The lower bound of the calibrated 95% confidence interval of the relative risk. +es_scc_result,calibrated_ci_95_ub,float,No,No,No,The upper bound of the calibrated 95% confidence interval of the relative risk. +es_scc_result,calibrated_p,float,No,No,No,The calibrated two-sided p-value. +es_scc_result,calibrated_one_sided_p,float,No,No,No,The calibrated one-sided p-value considering the null hypothesis of RR <= 1. +es_scc_result,calibrated_log_rr,float,No,No,No,The log of the calibrated relative risk. +es_scc_result,calibrated_se_log_rr,float,No,No,No,The standard error of the log of the calibrated relative risk. diff --git a/inst/csv/hadesModuleList.csv b/inst/csv/hadesModuleList.csv index c02beeae..2ecf951b 100644 --- a/inst/csv/hadesModuleList.csv +++ b/inst/csv/hadesModuleList.csv @@ -7,4 +7,5 @@ CohortMethodModule EvidenceSynthesisModule PatientLevelPredictionModule SelfControlledCaseSeriesModule +SelfControlledCohortModule TreatmentPatternsModule diff --git a/inst/testdata/cdmModulesAnalysisSpecifications.json b/inst/testdata/cdmModulesAnalysisSpecifications.json index bcbf6000..11e207c1 100644 --- a/inst/testdata/cdmModulesAnalysisSpecifications.json +++ b/inst/testdata/cdmModulesAnalysisSpecifications.json @@ -618,6 +618,16 @@ "cohortName": "PenicillinV", "type": "event" }, + { + "cohortId": 9, + "cohortName": "Doxylamine", + "type": "event" + }, + { + "cohortId": 10, + "cohortName": "PenicillinV", + "type": "event" + }, { "cohortId": 8, "cohortName": "Death", diff --git a/man/SelfControlledCohortModule.Rd b/man/SelfControlledCohortModule.Rd new file mode 100644 index 00000000..58b48115 --- /dev/null +++ b/man/SelfControlledCohortModule.Rd @@ -0,0 +1,270 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Module-SelfControlledCohort.R +\name{SelfControlledCohortModule} +\alias{SelfControlledCohortModule} +\title{Self-Controlled Cohort design with the \href{https://ohdsi.github.io/SelfControlledCohort/}{HADES SelfControlledCohort Package}} +\description{ +Module for performing Self-Controlled Cohort (SCC) analyses +against the OMOP Common Data Model. +} +\details{ +This R6 class acts as a thin wrapper around the SelfControlledCohort package functions. +The design pattern used here delegates all implementation logic to the package itself, +which means this wrapper should rarely (ideally never) need to change when the underlying +package evolves. This approach reduces tight coupling between Strategus and analysis modules, +making the system more maintainable and allowing module developers to update their packages +independently without requiring changes to the Strategus framework. +} +\section{Super class}{ +\code{\link[Strategus:StrategusModule]{Strategus::StrategusModule}} -> \code{SelfControlledCohort} +} +\section{Public fields}{ +\if{html}{\out{
}} +\describe{ +\item{\code{tablePrefix}}{The table prefix for results tables} +} +\if{html}{\out{
}} +} +\section{Methods}{ +\subsection{Public methods}{ +\itemize{ +\item \href{#method-SelfControlledCohort-new}{\code{SelfControlledCohortModule$new()}} +\item \href{#method-SelfControlledCohort-execute}{\code{SelfControlledCohortModule$execute()}} +\item \href{#method-SelfControlledCohort-createResultsDataModel}{\code{SelfControlledCohortModule$createResultsDataModel()}} +\item \href{#method-SelfControlledCohort-getResultsDataModelSpecification}{\code{SelfControlledCohortModule$getResultsDataModelSpecification()}} +\item \href{#method-SelfControlledCohort-uploadResults}{\code{SelfControlledCohortModule$uploadResults()}} +\item \href{#method-SelfControlledCohort-createModuleSpecifications}{\code{SelfControlledCohortModule$createModuleSpecifications()}} +\item \href{#method-SelfControlledCohort-validateModuleSpecifications}{\code{SelfControlledCohortModule$validateModuleSpecifications()}} +\item \href{#method-SelfControlledCohort-clone}{\code{SelfControlledCohortModule$clone()}} +} +} +\if{html}{\out{ +
Inherited methods + +
+}} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-SelfControlledCohort-new}{}}} +\subsection{Method \code{new()}}{ +Initialize the module +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{SelfControlledCohortModule$new()}\if{html}{\out{
}} +} + +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-SelfControlledCohort-execute}{}}} +\subsection{Method \code{execute()}}{ +Executes the SelfControlledCohort package +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{SelfControlledCohortModule$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{
}} +} +\subsection{Details}{ +This method simply constructs a jobContext object and delegates execution +to the package's own execute() function. By keeping this wrapper minimal, +we avoid the need to update Strategus every time the underlying analysis +logic changes. The package itself owns its execution logic, version checking, +and parameter handling - this wrapper just provides the interface contract +that Strategus expects. +} + +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-SelfControlledCohort-createResultsDataModel}{}}} +\subsection{Method \code{createResultsDataModel()}}{ +Create the results data model for the module +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{SelfControlledCohortModule$createResultsDataModel( + resultsConnectionDetails, + resultsDatabaseSchema, + 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{
}} +} +\subsection{Details}{ +Delegates to the package's own createResultsDataModel function. +The package knows its own schema requirements - Strategus just needs to +call the function with the appropriate database connection details. +} + +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-SelfControlledCohort-getResultsDataModelSpecification}{}}} +\subsection{Method \code{getResultsDataModelSpecification()}}{ +Get the results data model specification for the module +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{SelfControlledCohortModule$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{
}} +} +\subsection{Details}{ +Retrieves the data model specification from the package itself. +Only framework-specific modification is adding the table prefix. +} + +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-SelfControlledCohort-uploadResults}{}}} +\subsection{Method \code{uploadResults()}}{ +Upload the results for the module +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{SelfControlledCohortModule$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()}}]} + +\item{\code{...}}{Additional parameters passed to the package's uploadResults function} +} +\if{html}{\out{
}} +} +\subsection{Details}{ +Delegates upload logic to the package's uploadResults function. +The package handles the specifics of what data needs to be uploaded and how. +} + +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-SelfControlledCohort-createModuleSpecifications}{}}} +\subsection{Method \code{createModuleSpecifications()}}{ +Creates the SelfControlledCohort Module Specifications +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{SelfControlledCohortModule$createModuleSpecifications( + sccAnalysesSpecifications +)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{sccAnalysesSpecifications}}{Module specifications created by +SelfControlledCohort::createSelfControlledCohortModuleSpecifications()} +} +\if{html}{\out{
}} +} +\subsection{Details}{ +Wraps the package's createModuleSpecifications output in Strategus format. +The package function already handles versioning, parameter validation, etc. +This wrapper just ensures compatibility with Strategus conventions. +} + +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-SelfControlledCohort-validateModuleSpecifications}{}}} +\subsection{Method \code{validateModuleSpecifications()}}{ +Validate the module specifications +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{SelfControlledCohortModule$validateModuleSpecifications(moduleSpecifications)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{moduleSpecifications}}{The SelfControlledCohort module specifications} +} +\if{html}{\out{
}} +} +\subsection{Details}{ +Validation happens within the package's execute() function (including version checking). +This method provides the Strategus interface but doesn't duplicate validation logic. +} + +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-SelfControlledCohort-clone}{}}} +\subsection{Method \code{clone()}}{ +The objects of this class are cloneable with this method. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{SelfControlledCohortModule$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-SelfControlledCohortModule.R b/tests/testthat/test-SelfControlledCohortModule.R new file mode 100644 index 00000000..1c0c4037 --- /dev/null +++ b/tests/testthat/test-SelfControlledCohortModule.R @@ -0,0 +1,88 @@ +library(testthat) +library(Strategus) + +test_that("SelfControlledCohortModule can be instantiated", { + sccModule <- SelfControlledCohortModule$new() + expect_s3_class(sccModule, "SelfControlledCohortModule") + expect_equal(sccModule$tablePrefix, "scc_") +}) + +test_that("SelfControlledCohortModule - create module settings requires sccAnalysesSpecifications", { + sccModule <- SelfControlledCohortModule$new() + + # Missing sccAnalysesSpecifications parameter should cause an error + expect_error( + sccModule$createModuleSpecifications() + ) +}) + +test_that("SelfControlledCohortModule - create module settings with empty list", { + sccModule <- SelfControlledCohortModule$new() + + # Empty list should be accepted as valid input + # (The actual validation happens in the SelfControlledCohort package) + specs <- sccModule$createModuleSpecifications( + sccAnalysesSpecifications = list() + ) + expect_s3_class(specs, "SelfControlledCohortModuleSpecifications") + expect_true("settings" %in% names(specs)) + expect_true("module" %in% names(specs)) +}) + +test_that("SelfControlledCohortModule - module specifications have correct structure", { + sccModule <- SelfControlledCohortModule$new() + + specs <- sccModule$createModuleSpecifications( + sccAnalysesSpecifications = list() + ) + + # Verify the specification structure + expect_s3_class(specs, "SelfControlledCohortModuleSpecifications") + expect_true("settings" %in% names(specs)) + expect_true("module" %in% names(specs)) + expect_equal(specs$module, "SelfControlledCohortModule") +}) + +test_that("SelfControlledCohortModule - validateModuleSpecifications works", { + sccModule <- SelfControlledCohortModule$new() + + specs <- sccModule$createModuleSpecifications( + sccAnalysesSpecifications = list() + ) + + # Validation should complete without error for valid specs + expect_no_error( + sccModule$validateModuleSpecifications( + moduleSpecifications = specs + ) + ) +}) + +test_that("SelfControlledCohortModule - getResultsDataModelSpecification returns data model", { + sccModule <- SelfControlledCohortModule$new() + + # Get the data model specification + dataModel <- sccModule$getResultsDataModelSpecification() + + # Verify it is a data frame with required columns + expect_s3_class(dataModel, "data.frame") + expect_true("tableName" %in% names(dataModel)) + expect_true("columnName" %in% names(dataModel)) + + # Verify table names have the correct prefix + expect_true(all(startsWith(unique(dataModel$tableName), "scc_"))) +}) + +test_that("SelfControlledCohortModule - getResultsDataModelSpecification with custom prefix", { + sccModule <- SelfControlledCohortModule$new() + + # Get the data model specification with a custom prefix + dataModel <- sccModule$getResultsDataModelSpecification(tablePrefix = "custom_") + + # Verify it is a data frame + expect_s3_class(dataModel, "data.frame") + + # Verify table names have the custom prefix combined with scc_ prefix + expect_true(all(startsWith(unique(dataModel$tableName), "custom_scc_"))) +}) +