tests/testthat/test-plotProportionOfPatientsCovered.R

In DrugUtilisation: Summarise Patient-Level Drug Utilisation in Data Mapped to the OMOP Common Data Model

test_that("basic plot", {
  skip_on_cran()
  cdm <- mockDrugUtilisation(
    con = connection(),
    writeSchema = schema(),
    drug_exposure = dplyr::tibble(
      drug_exposure_id = 1:4,
      person_id = c(1, 2, 3, 4),
      drug_concept_id = c(1125360),
      drug_exposure_start_date = as.Date(c("2000-01-01", "2002-01-01", "2010-01-01", "2011-01-01")),
      drug_exposure_end_date = as.Date(c("2000-01-05", "2003-01-15", "2020-01-20", "2021-01-20")),
      drug_type_concept_id = 0,
      quantity = 0
    ),
    dus_cohort = dplyr::tibble(
      cohort_definition_id = 1,
      subject_id = c(1, 2, 3, 4),
      cohort_start_date = as.Date(c("2000-01-01", "2002-01-01", "2010-01-01", "2011-01-01")),
      cohort_end_date = as.Date(c("2000-01-05", "2002-01-15", "2010-01-20", "2011-01-20"))
    ),
    observation_period = dplyr::tibble(
      observation_period_id = 1:4,
      person_id = 1:4,
      observation_period_start_date = as.Date(c("2000-01-01", "2002-01-01", "2010-01-01", "2011-01-01")),
      observation_period_end_date = as.Date(c("2000-01-25", "2002-01-15", "2010-01-25", "2011-01-25")),
      period_type_concept_id = 0
    )
  )

  ppc <- cdm$dus_cohort |>
    summariseProportionOfPatientsCovered()

  expect_no_error(plotProportionOfPatientsCovered(ppc))
  expect_no_error(plotProportionOfPatientsCovered(ppc, facet = "cdm_name"))
  expect_no_error(plotProportionOfPatientsCovered(ppc, colour = "cohort_name"))


  # expected warnings - empty result or result with no ppc
  expect_warning(plotProportionOfPatientsCovered(
    omopgenerics::emptySummarisedResult()
  ))
  expect_warning(plotProportionOfPatientsCovered(ppc |>
    dplyr::filter(!stringr::str_starts(.data$estimate_name, "ppc"))))
  # expected errors
  expect_error(plotProportionOfPatientsCovered(cars))
  expect_error(plotProportionOfPatientsCovered(ppc, facet = "not_a_var"))
  expect_error(plotProportionOfPatientsCovered(ppc, colour = "not_a_var"))

  mockDisconnect(cdm = cdm)
})

test_that("multiple cohorts", {
  skip_on_cran()
  # id 1 - in cohort 1 for 5 days, exits the database after 25
  # id 2 - in cohort 1 for 15 days, exits the database after 15
  # id 3 - in cohort 1 for 20 days, exits the database after 25
  # id 4 - in cohort 2 for 25 days, exits the database after 30
  cdm <- mockDrugUtilisation(
    con = connection(),
    writeSchema = schema(),
    drug_exposure = dplyr::tibble(
      drug_exposure_id = 1:4,
      person_id = c(1, 2, 3, 4),
      drug_concept_id = c(1125360),
      drug_exposure_start_date = as.Date(c("2000-01-01", "2002-01-01", "2010-01-01", "2011-01-01")),
      drug_exposure_end_date = as.Date(c("2000-01-05", "2003-01-15", "2020-01-20", "2021-01-20")),
      drug_type_concept_id = 0,
      quantity = 0
    ),
    dus_cohort = dplyr::tibble(
      cohort_definition_id = c(1, 1, 1, 2),
      subject_id = c(1, 2, 3, 4),
      cohort_start_date = as.Date(c("2000-01-01", "2002-01-01", "2010-01-01", "2011-01-01")),
      cohort_end_date = as.Date(c("2000-01-05", "2002-01-15", "2010-01-20", "2011-01-25"))
    ),
    observation_period = dplyr::tibble(
      observation_period_id = 1:4,
      person_id = 1:4,
      observation_period_start_date = as.Date(c("2000-01-01", "2002-01-01", "2010-01-01", "2011-01-01")),
      observation_period_end_date = as.Date(c("2000-01-25", "2002-01-15", "2010-01-25", "2011-01-30")),
      period_type_concept_id = 0
    )
  )

  ppc <- cdm$dus_cohort |>
    summariseProportionOfPatientsCovered()

  expect_no_error(plotProportionOfPatientsCovered(ppc, facet = "cohort_name"))
  expect_no_error(plotProportionOfPatientsCovered(ppc, colour = "cohort_name"))

  mockDisconnect(cdm = cdm)
})

test_that("stratification", {
  skip_on_cran()
  # basic example one cohort entry
  # id 1 - in cohort for 5 days, break, 5 more days, exits the database after 25
  # id 2 - in cohort for 15 days, exits the database after 15
  # id 3 - in cohort for 20 days, exits the database after 25
  # id 4 - in cohort for 20 days, exits the database after 25

  cdm <- mockDrugUtilisation(
    con = connection(),
    writeSchema = schema(),
    dus_cohort = dplyr::tibble(
      cohort_definition_id = 1,
      subject_id = c(1, 1, 2, 3, 4),
      cohort_start_date = as.Date(c("2000-01-01", "2000-01-10", "2002-01-01", "2010-01-01", "2011-01-01")),
      cohort_end_date = as.Date(c("2000-01-05", "2000-01-15", "2002-01-15", "2010-01-20", "2011-01-20"))
    ),
    observation_period = dplyr::tibble(
      observation_period_id = 1:4,
      person_id = 1:4,
      observation_period_start_date = as.Date(c("2000-01-01", "2002-01-01", "2010-01-01", "2011-01-01")),
      observation_period_end_date = as.Date(c("2000-01-25", "2002-01-15", "2010-01-25", "2011-01-25")),
      period_type_concept_id = 0
    )
  )
  cdm$dus_cohort <- cdm$dus_cohort |>
    dplyr::mutate(
      var0 = "group",
      var1 = dplyr::if_else(subject_id == 1,
        "group_1", "group_2"
      ),
      var2 = dplyr::if_else(subject_id %in% c(1, 2),
        "group_a", "group_b"
      )
    )

  ppc <- cdm$dus_cohort |>
    summariseProportionOfPatientsCovered(strata = list(
      c("var1"), c("var2"), c("var1", "var2")
    ))

  expect_no_error(plotProportionOfPatientsCovered(
    ppc, facet = "cohort_name", colour = c("var1", "var2")
  ))

  expect_no_error(plotProportionOfPatientsCovered(
    ppc, facet = "cohort_name", colour = c("var1", "var2"), ribbon = FALSE
  ))

  expect_no_error(
    ppc |>
      plotProportionOfPatientsCovered(
        facet = cohort_name ~ var2,
        colour = "var1",
        ribbon = FALSE
      )
  )

  mockDisconnect(cdm = cdm)
})