Skip to contents

Article Case Study Generation

Source: vignettes/a13_article_case_studies.Rmd
a13_article_case_studies.Rmd

Goal

This vignette documents the code used to generate the article-style CohortContrast studies shown at http://omop-apps.cloud.ut.ee/CohortContrast/.

The workflow uses cohort JSON definitions exported from ATLAS and runs against the OPTIMA OMOP Common Data Model database.

The workflow is designed to produce:

  • one final summary-mode study folder per case

Expected JSON layout

Each cohort JSON definition should live in its own directory, because CohortContrast::cohortFromJSON() expects a directory containing the JSON cohort definition files.

Recommended package layout:

  • inst/extdata/article_cases/lung/cohort.json
  • inst/extdata/article_cases/prostate/cohort.json

When the package is installed, these paths can be resolved with system.file().

Notes

  • This vignette is shown as code only and is not executed during package checks, because it depends on a real OMOP Common Data Model database.
  • The workflow below uses one clean CohortContrast() analysis followed by a single export of the final filtered and mapped study object to a temporary patient-mode folder. That temporary folder is used only to create the summary-mode study and is then removed. The retained study folders therefore contain only the final concepts that passed the statistical selection steps.

Package versions used for the wiki page

The article case-study outputs were generated in an R package environment equivalent to the ICD10 atlas-generation workflow.

Package Version
CohortContrast 1.0.0
backports 1.5.0
bit 4.6.0
bit64 4.6.0-1
blob 1.2.4
CDMConnector 2.2.0
checkmate 2.3.3
cli 3.6.5
clipr 0.8.0
clock 0.7.3
cluster 2.1.8.1
codetools 0.2-20
CohortConstructor 0.5.0
compiler 4.5.1
cpp11 0.5.2
crayon 1.5.3
data.table 1.17.8
DBI 1.2.3
dbplyr 2.5.1
doParallel 1.0.17
dplyr 1.1.4
foreach 1.5.2
generics 0.1.4
glue 1.8.0
graphics 4.5.1
grDevices 4.5.1
grid 4.5.1
here 1.0.2
hms 1.1.3
igraph 2.1.4
iterators 1.0.14
jsonlite 2.0.0
lattice 0.22-7
lifecycle 1.0.4
lubridate 1.9.4
magrittr 2.0.4
MASS 7.3-65
Matrix 1.7-3
methods 4.5.1
mgcv 1.9-3
nanoparquet 0.4.3
nlme 3.1-168
omopgenerics 1.3.0
parallel 4.5.1
PatientProfiles 1.4.2
permute 0.9-8
pillar 1.11.0
pkgconfig 2.0.3
plyr 1.8.9
png 0.1-8
prettyunits 1.2.0
progress 1.2.3
purrr 1.1.0
R6 2.6.1
rappdirs 0.3.3
Rcpp 1.1.0
RcppTOML 0.2.3
readr 2.1.5
reshape2 1.4.4
reticulate 1.44.1
rlang 1.1.6
rprojroot 2.1.1
snakecase 0.11.1
splines 4.5.1
stats 4.5.1
stringi 1.8.7
stringr 1.5.2
tibble 3.3.0
tidyr 1.3.1
tidyselect 1.2.1
timechange 0.3.0
tools 4.5.1
tzdb 0.5.0
utf8 1.2.6
utils 4.5.1
vctrs 0.6.5
vegan 2.7-1
vroom 1.6.5
withr 3.0.2

Required environment variables 

# Database connection settings expected by the helper below.
Sys.getenv("DB_NAME")
Sys.getenv("DB_HOST")
Sys.getenv("DB_PORT")
Sys.getenv("DB_USERNAME")
Sys.getenv("DB_PASSWORD")

# OMOP schema settings.
Sys.getenv("OHDSI_CDM")
Sys.getenv("OHDSI_RESULTS")
Sys.getenv("OHDSI_WRITE")

Connect to the OMOP database 

library(CohortContrast)
library(CDMConnector)
library(DBI)
library(RPostgres)
library(dplyr)
library(purrr)
library(tibble)

connectArticleCdm <- function() {
  # Open the database connection using environment variables instead of
  # hard-coded credentials.
  db <- DBI::dbConnect(
    RPostgres::Postgres(),
    dbname = Sys.getenv("DB_NAME"),
    host = Sys.getenv("DB_HOST"),
    user = Sys.getenv("DB_USERNAME"),
    password = Sys.getenv("DB_PASSWORD"),
    port = as.integer(Sys.getenv("DB_PORT"))
  )

  # Create the CDMConnector object used by CohortContrast.
  cdm <- CDMConnector::cdmFromCon(
    con = db,
    cdmSchema = Sys.getenv("OHDSI_CDM"),
    achillesSchema = Sys.getenv("OHDSI_RESULTS"),
    writeSchema = c(
      schema = Sys.getenv("OHDSI_WRITE"),
      prefix = "cc_"
    )
  )

  list(db = db, cdm = cdm)
}

Define study cases 

# Each case points to a directory containing one ATLAS cohort JSON definition.
# Add future studies by inserting a new row here.
cases <- tibble::tribble(
  ~case_name, ~json_dir, ~study_name,
  "lung",
  system.file("extdata", "article_cases", "lung", package = "CohortContrast"),
  "malignant_neoplasm_of_lung_1year_after",
  "prostate",
  system.file("extdata", "article_cases", "prostate", package = "CohortContrast"),
  "malignant_neoplasm_of_prostate_1year_after"
)

Build the target cohort 

buildTargetTable <- function(cdm, jsonDir) {
  # Generate the target cohort from the JSON definition.
  targetTable <- CohortContrast::cohortFromJSON(
    pathToJSON = jsonDir,
    cdm = cdm
  ) %>%
    # Shift the cohort start slightly earlier and define a 1-year follow-up.
    dplyr::mutate(
      cohort_start_date = cohort_start_date - 14L,
      cohort_end_date = cohort_start_date + 365L
    )

  # Resolve any overlaps before continuing with the analysis.
  CohortContrast::resolveCohortTableOverlaps(
    cohortTable = targetTable,
    cdm = cdm
  )
}

Build the visit-based control cohort 

buildVisitBasedControl <- function(cdm, targetTable, lookbackDays = 1095L, followupDays = 365L) {
  # Shift the target windows backwards to define the control-search anchor.
  controlSeed <- targetTable %>%
    dplyr::mutate(
      cohort_start_date = cohort_start_date - as.integer(lookbackDays),
      cohort_end_date = cohort_start_date + as.integer(followupDays)
    )

  # Insert the shifted target windows as a temporary table used to retrieve the
  # latest eligible visit before the control anchor date.
  cdm <- CDMConnector::insertTable(
    cdm = cdm,
    name = "article_control_seed",
    table = controlSeed,
    overwrite = TRUE,
    temporary = TRUE
  )

  controlTable <- cdm$visit_occurrence %>%
    dplyr::inner_join(cdm$article_control_seed, by = c("person_id" = "subject_id")) %>%
    dplyr::filter(visit_start_date <= cohort_start_date) %>%
    dplyr::group_by(person_id) %>%
    # To reduce bias from differential encounter density, align each patient's
    # control window to the clinical visit start closest to the baseline anchor
    # date, operationalized here as the latest eligible visit on or before that
    # anchor date.
    dplyr::slice_max(order_by = visit_start_date, n = 1, with_ties = FALSE) %>%
    dplyr::ungroup() %>%
    dplyr::transmute(
      subject_id = person_id,
      cohort_start_date = visit_start_date
    ) %>%
    dplyr::collect() %>%
    dplyr::mutate(
      cohort_definition_id = "control",
      cohort_end_date = .data$cohort_start_date + as.integer(followupDays)
    ) %>%
    dplyr::select(
      cohort_definition_id,
      subject_id,
      cohort_start_date,
      cohort_end_date
    )

  CohortContrast::resolveCohortTableOverlaps(
    cohortTable = controlTable,
    cdm = cdm
  )
}

Keep only the final selected concepts 

trimFinalStudy <- function(data) {
  # selectedFeatureData is the final selected concept set after statistical
  # filtering and optional post-processing.
  finalIds <- unique(data$selectedFeatureData$selectedFeatureIds)

  # Keep only the final selected concepts in the exported feature table.
  data$data_features <- data$data_features %>%
    dplyr::filter(.data$CONCEPT_ID %in% finalIds)

  # Keep only patient-level rows belonging to the final selected concepts.
  data$data_patients <- data$data_patients %>%
    dplyr::filter(.data$CONCEPT_ID %in% finalIds)

  # Keep only mapping rows connected to the final selected concepts.
  data$complementaryMappingTable <- data$complementaryMappingTable %>%
    dplyr::filter(
      .data$CONCEPT_ID %in% finalIds |
        .data$NEW_CONCEPT_ID %in% finalIds
    )

  # Keep the selected-feature payload aligned with the final study subset.
  data$selectedFeatureData$selectedFeatures <- data$selectedFeatureData$selectedFeatures %>%
    dplyr::filter(.data$CONCEPT_ID %in% finalIds)
  data$selectedFeatureData$selectedFeatureIds <- finalIds
  data$selectedFeatureData$selectedFeatureNames <- unique(
    data$selectedFeatureData$selectedFeatures$CONCEPT_NAME
  )
  data$trajectoryDataList <- data$selectedFeatureData

  data
}

Run one final mapped study 

runArticleCase <- function(cdm, jsonDir, studyName, summaryRoot, scratchRoot) {
  # Build the target and control cohorts for the selected case.
  targetTable <- buildTargetTable(cdm = cdm, jsonDir = jsonDir)
  controlTable <- buildVisitBasedControl(cdm = cdm, targetTable = targetTable)

  # Run the full CohortContrast workflow in memory first.
  # Output writing is delayed until the final selected/mapped study object has
  # been trimmed to the published concept subset.
  result <- CohortContrast::CohortContrast(
    cdm = cdm,
    targetTable = targetTable,
    controlTable = controlTable,
    pathToResults = scratchRoot,
    prevalenceCutOff = 1,
    getSourceData = FALSE,
    runChi2YTests = TRUE,
    runLogitTests = TRUE,
    createOutputFiles = FALSE,
    complName = studyName,
    runRemoveTemporalBias = TRUE,
    removeTemporalBiasArgs = list(
      removeIdentified = TRUE
    ),
    runAutomaticHierarchyCombineConcepts = TRUE,
    automaticHierarchyCombineConceptsArgs = list(
      abstractionLevel = -1,
      minDepthAllowed = 0,
      allowOnlyMinors = TRUE
    ),
    runAutomaticCorrelationCombineConcepts = TRUE,
    automaticCorrelationCombineConceptsArgs = list(
      abstractionLevel = -1,
      minCorrelation = 0.7,
      maxDaysInBetween = 1,
      heritageDriftAllowed = FALSE
    )
  )

  # Keep only the concepts that survived the statistical and post-processing
  # pipeline, then write one temporary patient-mode study folder.
  result <- trimFinalStudy(result)
  CohortContrast:::saveResult(result, scratchRoot)

  # Create the summary-mode study from the temporary patient-mode study.
  CohortContrast::precomputeSummary(
    studyPath = file.path(scratchRoot, studyName),
    outputPath = file.path(summaryRoot, paste0(studyName, "_summary")),
    clusterKValues = c(2, 3, 4, 5)
  )

  # Remove the temporary patient-mode folder and keep only the summary.
  unlink(file.path(scratchRoot, studyName), recursive = TRUE, force = TRUE)

  invisible(result)
}

Run all configured cases 

# Directory that will keep the published summary-mode study folders.
summaryRoot <- "article_studies"

# Temporary directory used only while precomputeSummary() is running.
scratchRoot <- file.path(tempdir(), "cohortcontrast_article_scratch")

dir.create(summaryRoot, recursive = TRUE, showWarnings = FALSE)
dir.create(scratchRoot, recursive = TRUE, showWarnings = FALSE)

conn <- connectArticleCdm()
db <- conn$db
cdm <- conn$cdm

purrr::pwalk(
  cases,
  \(case_name, json_dir, study_name) {
    # Run one complete article workflow per case.
    runArticleCase(
      cdm = cdm,
      jsonDir = json_dir,
      studyName = study_name,
      summaryRoot = summaryRoot,
      scratchRoot = scratchRoot
    )
  }
)

# Close the database connection when finished.
DBI::dbDisconnect(db)

Resulting study folders

After the workflow completes, the output directory will contain:

  • <study_name>_summary/ for the corresponding summary-mode study

Temporary patient-mode study folders are created only while precomputeSummary() is running and are removed afterward.

The retained summary-mode study folders therefore contain the final published outputs.

For the two configured cases, that means:

  • malignant_neoplasm_of_lung_1year_after_summary/
  • malignant_neoplasm_of_prostate_1year_after_summary/

These summary folders can then be opened directly in the Viewer.