inst/doc/a04_Calculating_prevalence.R

In IncidencePrevalence: Estimate Incidence and Prevalence using the OMOP Common Data Model

## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE, 
  warning = FALSE, 
  message = FALSE,
  comment = "#>",
  fig.width = 8.5,
  fig.height = 6,
  eval = Sys.getenv("$RUNNER_OS") != "macOS"
)

## ----message= FALSE, warning=FALSE, echo=FALSE--------------------------------
library(here)

## ----echo=FALSE, out.width="80%"----------------------------------------------
knitr::include_graphics(here("vignettes/point_prev.png"))

## ----echo=FALSE, out.width="80%"----------------------------------------------
knitr::include_graphics(here("vignettes/period_prev.png"))

## ----message=FALSE, warning=FALSE---------------------------------------------
library(IncidencePrevalence)
library(dplyr)
library(tidyr)
library(ggplot2)
library(patchwork)

cdm <- mockIncidencePrevalence(
  sampleSize = 20000,
  earliestObservationStartDate = as.Date("1960-01-01"),
  minOutcomeDays = 365,
  outPre = 0.3
)

cdm <- generateDenominatorCohortSet(
  cdm = cdm, name = "denominator",
  cohortDateRange = c(as.Date("1990-01-01"), as.Date("2009-12-31")),
  ageGroup = list(c(0, 150)),
  sex = "Both",
  daysPriorObservation = 0
)

cdm$denominator %>%
  glimpse()

## ----message= FALSE, warning=FALSE--------------------------------------------
prev <- estimatePointPrevalence(
  cdm = cdm,
  denominatorTable = "denominator",
  outcomeTable = "outcome",
  interval = "Years"
)

prev %>%
  glimpse()

plotPrevalence(prev)

## ----message= FALSE, warning=FALSE--------------------------------------------
outcome_plot <- plotPrevalencePopulation(result = prev, y = "outcome_count") + xlab("") +
  theme(axis.text.x = element_blank()) +
  ggtitle("a) Number of outcomes by year")
denominator_plot <- plotPrevalencePopulation(result = prev) +
  ggtitle("b) Number of people in denominator population by year")
outcome_plot / denominator_plot

## ----message= FALSE, warning=FALSE--------------------------------------------
prev <- estimatePointPrevalence(
  cdm = cdm,
  denominatorTable = "denominator",
  outcomeTable = "outcome",
  interval = "Months"
)

prev %>%
  glimpse()

plotPrevalence(prev)

## ----message= FALSE, warning=FALSE--------------------------------------------
prev <- estimatePointPrevalence(
  cdm = cdm,
  denominatorTable = "denominator",
  outcomeTable = "outcome",
  interval = "Years",
  timePoint = "middle"
)

prev %>%
  glimpse()

plotPrevalence(prev, line = FALSE)

## ----message= FALSE, warning=FALSE--------------------------------------------
prev <- estimatePeriodPrevalence(
  cdm = cdm,
  denominatorTable = "denominator",
  outcomeTable = "outcome",
  interval = "Years"
)

prev %>%
  glimpse()

plotPrevalence(prev)

## ----message= FALSE, warning=FALSE--------------------------------------------
prev <- estimatePeriodPrevalence(
  cdm = cdm,
  denominatorTable = "denominator",
  outcomeTable = "outcome",
  interval = "Months"
)

prev %>%
  glimpse()

plotPrevalence(prev)

## ----message= FALSE, warning=FALSE--------------------------------------------
prev <- estimatePeriodPrevalence(
  cdm = cdm,
  denominatorTable = "denominator",
  outcomeTable = "outcome",
  interval = "Months",
  fullContribution = FALSE
)

prev %>%
  glimpse()

plotPrevalence(prev)

## -----------------------------------------------------------------------------
cdm <- generateDenominatorCohortSet(
  cdm = cdm, name = "denominator_age_sex",
  cohortDateRange = c(as.Date("1990-01-01"), as.Date("2009-12-31")),
  ageGroup = list(
    c(0, 39),
    c(41, 65),
    c(66, 150)
  ),
  sex = "Both",
  daysPriorObservation = 0
)
prev <- estimatePeriodPrevalence(
  cdm = cdm,
  denominatorTable = "denominator_age_sex",
  outcomeTable = "outcome"
)

plotPrevalence(prev) +
  facet_wrap(vars(denominator_age_group), ncol = 1)

## ----message= FALSE, warning=FALSE--------------------------------------------
denominator_plot <- plotPrevalencePopulation(result = prev)

denominator_plot +
  facet_wrap(vars(denominator_age_group), ncol = 1)

## -----------------------------------------------------------------------------
cdm$denominator <- cdm$denominator %>%
  mutate(group = if_else(as.numeric(subject_id) < 500, "first", "second"))

prev <- estimatePeriodPrevalence(
  cdm = cdm,
  denominatorTable = "denominator",
  outcomeTable = "outcome",
  strata = "group"
)

plotPrevalence(prev,
  colour = "group"
) + 
  facet_wrap(vars(group), ncol = 1)

## ----fig.width=13-------------------------------------------------------------
cdm$denominator <- cdm$denominator %>%
  mutate(
    group_1 = if_else(as.numeric(subject_id) < 1500, "first", "second"),
    group_2 = if_else(as.numeric(subject_id) < 1000, "one", "two")
  )

prev <- estimatePeriodPrevalence(
  cdm = cdm,
  denominatorTable = "denominator",
  outcomeTable = "outcome",
  strata = list(
    c("group_1"), # for just group_1
    c("group_2"), # for just group_2
    c("group_1", "group_2")
  ) # for group_1 and group_2
)

plotPrevalence(prev) + 
  facet_wrap(vars(group_1, group_2), ncol = 2)

## ----message= FALSE, warning=FALSE--------------------------------------------
prev <- estimatePeriodPrevalence(
  cdm = cdm,
  denominatorTable = "denominator",
  outcomeTable = "outcome",
  interval = "Years",
  fullContribution = TRUE
)
tablePrevalenceAttrition(prev, style = "darwin")