inst/doc/a02_cohorts.R

In CDMConnector: Connect to an OMOP Common Data Model

## ----include = FALSE----------------------------------------------------------

knitr::opts_chunk$set(
  collapse = TRUE,
  eval = rlang::is_installed("CirceR") & rlang::is_installed("Capr") & rlang::is_installed("duckdb"),
  comment = "#>"
)

library(CDMConnector)
library(dplyr, warn.conflicts = FALSE)

if (Sys.getenv("EUNOMIA_DATA_FOLDER") == "") Sys.setenv("EUNOMIA_DATA_FOLDER" = file.path(tempdir(), "eunomia"))
if (!dir.exists(Sys.getenv("EUNOMIA_DATA_FOLDER"))) dir.create(Sys.getenv("EUNOMIA_DATA_FOLDER"))
if (!eunomiaIsAvailable()) downloadEunomiaData()


## -----------------------------------------------------------------------------
pathToCohortJsonFiles <- system.file("cohorts1", package = "CDMConnector")
list.files(pathToCohortJsonFiles)

readr::read_csv(file.path(pathToCohortJsonFiles, "CohortsToCreate.csv"),
                show_col_types = FALSE)

## -----------------------------------------------------------------------------
library(CDMConnector)
pathToCohortJsonFiles <- system.file("example_cohorts", package = "CDMConnector")
list.files(pathToCohortJsonFiles)

con <- DBI::dbConnect(duckdb::duckdb(), eunomiaDir("GiBleed"))
cdm <- cdmFromCon(con, cdmName = "eunomia", cdmSchema = "main", writeSchema = "main")

cohortSet <- readCohortSet(pathToCohortJsonFiles) |>
  mutate(cohort_name = snakecase::to_snake_case(cohort_name))

cohortSet

cdm <- generateCohortSet(
  cdm = cdm, 
  cohortSet = cohortSet,
  name = "study_cohorts"
)

cdm$study_cohorts

## -----------------------------------------------------------------------------
cohortCount(cdm$study_cohorts)
settings(cdm$study_cohorts)
attrition(cdm$study_cohorts)

## ----eval=FALSE---------------------------------------------------------------
# cdm_gibleed <- cdm %>%
#   cdmSubsetCohort(cohortTable = "study_cohorts")

## -----------------------------------------------------------------------------
library(CDMConnector)
con <- DBI::dbConnect(duckdb::duckdb(), eunomiaDir())
cdm <- cdmFromCon(con, cdmSchema = "main", writeSchema = "main")

cohortSet <- readCohortSet(system.file("cohorts3", package = "CDMConnector"))


cdm <- generateCohortSet(cdm, cohortSet, name = "cohort") 

cdm$cohort

cohortCount(cdm$cohort)


## -----------------------------------------------------------------------------
library(dplyr)

cdm$cohort_subset <- cdm$cohort %>% 
  # only keep persons who are in the cohort at least 28 days
  filter(!!datediff("cohort_start_date", "cohort_end_date") >= 28) %>% 
  compute(name = "cohort_subset", temporary = FALSE, overwrite = TRUE) %>% 
  newCohortTable()

cohortCount(cdm$cohort_subset)

## -----------------------------------------------------------------------------
daysInCohort <- cdm$cohort %>% 
  filter(cohort_definition_id %in% c(1,5)) %>% 
  mutate(days_in_cohort = !!datediff("cohort_start_date", "cohort_end_date")) %>% 
  count(cohort_definition_id, days_in_cohort) %>% 
  collect()

daysInCohort

## -----------------------------------------------------------------------------

cdm$cohort_subset <- cdm$cohort %>% 
  filter(!!datediff("cohort_start_date", "cohort_end_date") >= 14) %>% 
  mutate(cohort_definition_id = 10 + cohort_definition_id) %>% 
  union_all(
    cdm$cohort %>%
    filter(!!datediff("cohort_start_date", "cohort_end_date") >= 21) %>% 
    mutate(cohort_definition_id = 100 + cohort_definition_id)
  ) %>% 
  union_all(
    cdm$cohort %>% 
    filter(!!datediff("cohort_start_date", "cohort_end_date") >= 28) %>% 
    mutate(cohort_definition_id = 1000 + cohort_definition_id)
  ) %>% 
  compute(name = "cohort_subset", temporary = FALSE, overwrite = TRUE) # %>% 
  # newCohortTable() # this function creates the cohort object and metadata

cdm$cohort_subset %>% 
  mutate(days_in_cohort = !!datediff("cohort_start_date", "cohort_end_date")) %>% 
  group_by(cohort_definition_id) %>% 
  summarize(mean_days_in_cohort = mean(days_in_cohort, na.rm = TRUE)) %>% 
  collect() %>% 
  arrange(mean_days_in_cohort)


## -----------------------------------------------------------------------------

library(dplyr, warn.conflicts = FALSE)

cdm <- generateConceptCohortSet(
  cdm, 
  conceptSet = list(gibleed = 192671), 
  name = "gibleed2", # name of the cohort table
  limit = "all", # use all occurrences of the concept instead of just the first
  end = 10 # set explicit cohort end date 10 days after start
)

cdm$gibleed2 <- cdm$gibleed2 %>% 
  semi_join(
    filter(cdm$person, gender_concept_id == 8507), 
    by = c("subject_id" = "person_id")
  ) %>% 
  recordCohortAttrition(reason = "Male")
  
attrition(cdm$gibleed2) 

## -----------------------------------------------------------------------------
cohort <- dplyr::tibble(
  cohort_definition_id = 1L,
  subject_id = 1L,
  cohort_start_date = as.Date("1999-01-01"),
  cohort_end_date = as.Date("2001-01-01")
)

cohort

## -----------------------------------------------------------------------------
library(omopgenerics)
cdm <- insertTable(cdm = cdm, name = "cohort", table = cohort, overwrite = TRUE)

cdm$cohort

## -----------------------------------------------------------------------------
cdm$cohort <- newCohortTable(cdm$cohort)

## -----------------------------------------------------------------------------
cohortCount(cdm$cohort)
settings(cdm$cohort)
attrition(cdm$cohort)

## -----------------------------------------------------------------------------
cdm <- insertTable(cdm = cdm, name = "cohort2", table = cohort, overwrite = TRUE)
cdm$cohort2 <- newCohortTable(cdm$cohort2)
settings(cdm$cohort2)

cohort_set <- data.frame(cohort_definition_id = 1L,
                         cohort_name = "made_up_cohort")
cdm$cohort2 <- newCohortTable(cdm$cohort2, cohortSetRef = cohort_set)

settings(cdm$cohort2)

## -----------------------------------------------------------------------------
DBI::dbDisconnect(con, shutdown = TRUE)