---
title: "Applying demographic requirements to a cohort"
output: rmarkdown::html_vignette
vignette: >
  %\VignetteIndexEntry{a03_require_demographics}
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteEncoding{UTF-8}
---

```{r, include = FALSE}
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)
```

```{r}
library(CodelistGenerator)
library(CohortConstructor)
library(CohortCharacteristics)
library(ggplot2)
```

```{r, include = FALSE}
knitr::opts_chunk$set(
  collapse = TRUE,
  eval = TRUE, message = FALSE, warning = FALSE,
  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"))
  downloadEunomiaData()  
}
```

In this vignette we'll show how requirements related to patient demographics can be applied to a cohort. Again we'll use the Eunomia synthetic data.

```{r}
con <- DBI::dbConnect(duckdb::duckdb(), dbdir = eunomia_dir())
cdm <- cdm_from_con(con, cdm_schema = "main", 
                    write_schema = c(prefix = "my_study_", schema = "main"))
```

Let's start by creating a cohort of people with a fracture. We'll first look for codes that might represent a fracture and the build a cohort using these codes, setting cohort exit to 180 days after the fracture.

```{r}
fracture_codes <- getCandidateCodes(cdm, "fracture")
fracture_codes <- list("fracture" = fracture_codes$concept_id)
cdm$fracture <- conceptCohort(cdm = cdm, 
                                 conceptSet = fracture_codes, 
                                 name = "fracture")

summary_attrition <- summariseCohortAttrition(cdm$fracture)
plotCohortAttrition(summary_attrition)
```

## Restrict cohort by age

We can choose a specific age range for individuals in our cohort using `requireAge()` from CohortConstructor. 

```{r}
cdm$fracture <- cdm$fracture |> 
  requireAge(indexDate = "cohort_start_date",
             ageRange = list(c(18, 100)))

summary_attrition <- summariseCohortAttrition(cdm$fracture)
plotCohortAttrition(summary_attrition)
```

Note that by default individuals are filtered based on the age they were when they entered the cohort.  

## Restrict cohort by sex

We can also specify a sex criteria for individuals in our cohort using `requireSex()` from CohortConstructor. 

```{r}
cdm$fracture <- cdm$fracture |> 
  requireSex(sex = "Female")

summary_attrition <- summariseCohortAttrition(cdm$fracture)
plotCohortAttrition(summary_attrition)
```

## Restrict cohort by number of prior observations

We can also specify a minimum number of days of prior observations for each individual using `requirePriorObservation()` from CohortConstructor. 

```{r}
cdm$fracture <- cdm$fracture |> 
  requirePriorObservation(indexDate = "cohort_start_date",
                          minPriorObservation = 365)

summary_attrition <- summariseCohortAttrition(cdm$fracture)
plotCohortAttrition(summary_attrition)
```

As well as specifying a minimum amount of prior observation, we can require some mimimum amount of follow-up by using `requireFutureObservation()` in a similar way.

## Applying multiple demographic requirements to a cohort

We can implement multiple demographic requirements at the same time by using the more general `requireDemographics()` function.

```{r}
cdm$fracture <- conceptCohort(cdm = cdm, 
                                 conceptSet = fracture_codes, 
                                 name = "fracture") |> 
  requireDemographics(indexDate = "cohort_start_date",
                      ageRange = c(18,100),
                      sex = "Female",
                      minPriorObservation = 365, 
                      minFutureObservation = 30)

summary_attrition <- summariseCohortAttrition(cdm$fracture)
plotCohortAttrition(summary_attrition)
```