---
title: "Summarise cohort entries"
output: 
  html_document:
    pandoc_args: [
      "--number-offset=1,0"
      ]
    number_sections: yes
    toc: yes
vignette: >
  %\VignetteIndexEntry{a05_summariseCohortEntries}
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteEncoding{UTF-8}
---

```{r, include = FALSE}
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>", message = FALSE, warning = FALSE,
  fig.width = 7
)

library(CDMConnector)
if (Sys.getenv("EUNOMIA_DATA_FOLDER") == "") Sys.setenv("EUNOMIA_DATA_FOLDER" = tempdir())
if (!dir.exists(Sys.getenv("EUNOMIA_DATA_FOLDER"))) dir.create(Sys.getenv("EUNOMIA_DATA_FOLDER"))
if (!eunomia_is_available()) downloadEunomiaData()
```

## Introduction
In this example we're going to summarise the characteristics of individuals with an ankle sprain, ankle fracture, forearm fracture, or a hip fracture using the Eunomia synthetic data. 

We'll begin by creating our study cohorts.

```{r}
library(CDMConnector)
library(CohortCharacteristics)
library(dplyr)
library(ggplot2)

con <- DBI::dbConnect(duckdb::duckdb(),
  dbdir = CDMConnector::eunomia_dir()
)
cdm <- CDMConnector::cdm_from_con(con,
  cdm_schem = "main",
  write_schema = "main",
  cdm_name = "Eunomia"
)

cdm <- generateConceptCohortSet(
  cdm = cdm,
  name = "injuries",
  conceptSet = list(
    "ankle_sprain" = 81151,
    "ankle_fracture" = 4059173,
    "forearm_fracture" = 4278672,
    "hip_fracture" = 4230399
  ),
  end = "event_end_date",
  limit = "all"
)
```

## Summarising cohort counts

We can first quickly summarise and present the overall counts of our cohorts.
```{r}
cohort_counts <- summariseCohortCount(cdm[["injuries"]])
tableCohortCount(cohort_counts)
```

Moreover, we can also easily stratify these counts. For example, here we add age groups and then stratify our counts by t
We can summarise the overall counts of our cohorts.
```{r}
cdm[["injuries"]] <- cdm[["injuries"]] |>
  PatientProfiles::addAge(ageGroup = list(
    c(0, 3),
    c(4, 17),
    c(18, Inf)
  )) |>
  compute(temporary = FALSE, name = "injuries")

cohort_counts <- summariseCohortCount(cdm[["injuries"]], strata = "age_group")
tableCohortCount(cohort_counts)
```

We can also apply minimum cell count suppression to our cohort counts. In this case we will obscure any counts below 10.
```{r}
cohort_counts <- suppress(cohort_counts, minCellCount = 10)
tableCohortCount(cohort_counts)
```

## Summarising cohort attrition
Say we specify two inclusion criteria. First, we keep only cohort entries after the year 2000. Second, we keep only cohort entries for those aged 18 or older. We can easily create plots summarising our cohort attrition.

```{r}
cdm <- generateConceptCohortSet(
  cdm = cdm,
  name = "ankle_sprain",
  conceptSet = list("ankle_sprain" = 81151),
  end = "event_end_date",
  limit = "all"
)

cdm[["ankle_sprain"]] <- cdm[["ankle_sprain"]] |>
  filter(year(cohort_start_date) >= 2000) |>
  recordCohortAttrition("Restrict to cohort_start_date >= 2000") |>
  compute(temporary = FALSE, name = "ankle_sprain")

attrition_summary <- summariseCohortAttrition(cdm[["ankle_sprain"]])

plotCohortAttrition(attrition_summary)
```

```{r}
cdm[["ankle_sprain"]] <- cdm[["ankle_sprain"]] |>
  PatientProfiles::addAge() |>
  filter(age >= 18) |>
  compute(temporary = FALSE, name = "ankle_sprain") |>
  recordCohortAttrition("Restrict to age >= 18")

attrition_summary <- summariseCohortAttrition(cdm[["ankle_sprain"]])

plotCohortAttrition(attrition_summary, cohortId = 1)
```

We could, of course, have applied these requirements the other way around.

```{r}
cdm <- generateConceptCohortSet(
  cdm = cdm,
  name = "ankle_sprain",
  conceptSet = list("ankle_sprain" = 81151),
  end = "event_end_date",
  limit = "all"
)

cdm[["ankle_sprain"]] <- cdm[["ankle_sprain"]] |>
  PatientProfiles::addAge() |>
  filter(age >= 18) |>
  compute(temporary = FALSE, name = "ankle_sprain") |>
  recordCohortAttrition("Restrict to age >= 18")

cdm[["ankle_sprain"]] <- cdm[["ankle_sprain"]] |>
  filter(year(cohort_start_date) >= 2000) |>
  recordCohortAttrition("Restrict to cohort_start_date >= 2000") |>
  compute(temporary = FALSE, name = "ankle_sprain")


attrition_summary <- summariseCohortAttrition(cdm[["ankle_sprain"]])

plotCohortAttrition(attrition_summary, cohortId = 1)
```

As well as plotting cohort attrition, we can also create a table of our results.
```{r}
tableCohortAttrition(attrition_summary)
```
