tests/testthat/test-addTableIntersect.R

In PatientProfiles: Identify Characteristics of Patients in the OMOP Common Data Model

test_that("basic structures", {
  cdm <- mockPatientProfiles(con = connection(), writeSchema = writeSchema())
  cdm$ati_visit <- cdm$cohort1 |>
    addTableIntersectCount(
      tableName = "visit_occurrence",
      nameStyle = "{table_name}_{value}_{window_name}"
    ) |>
    addTableIntersectFlag(
      tableName = "visit_occurrence",
      nameStyle = "{table_name}_{value}_{window_name}"
    ) |>
    addTableIntersectDate(
      tableName = "visit_occurrence",
      nameStyle = "{table_name}_{value}_{window_name}"
    ) |>
    addTableIntersectDays(
      tableName = "visit_occurrence",
      nameStyle = "{table_name}_{value}_{window_name}"
    )
  expect_true(all(c(
    "visit_occurrence_flag_0_to_inf", "visit_occurrence_count_0_to_inf",
    "visit_occurrence_date_0_to_inf", "visit_occurrence_days_0_to_inf"
  ) %in% colnames(cdm$ati_visit)))
  mockDisconnect(cdm = cdm)
})

test_that("input validation", {
  skip_on_cran()
  cdm <- mockPatientProfiles(con = connection(), writeSchema = writeSchema())
  expect_error(expect_warning(cdm$cohort1 %>%
    addTableIntersect(
      tableName = "visit_occurrence",
      indexDate = "index_date"
    )))

  expect_error(expect_warning(cdm$cohort1 %>%
    addTableIntersect(
      tableName = "visit_occurrence",
      censorDate = "index_date"
    )))

  expect_error(expect_warning(cdm$cohort1 %>%
    addTableIntersect(
      tableName = "visit_occurrence",
      censorDate = 42
    )))

  expect_error(expect_warning(cdm$cohort1 %>%
    addTableIntersect(
      tableName = "visit_occurrence",
      window = c(90, 0)
    )))

  expect_error(expect_warning(cdm$cohort1 %>%
    addTableIntersect(
      tableName = "visit_occurrence",
      order = 42
    )))

  expect_error(expect_warning(cdm$cohort1 %>%
    addTableIntersect(
      tableName = "visit_occurrence",
      targetStartDate = "drug_exposure_start_date"
    )))

  expect_error(expect_warning(cdm$cohort1 %>%
    addTableIntersect(
      tableName = "visit_occurrence",
      targetEndDate = "condition_end_date"
    )))

  expect_error(expect_warning(cdm$cohort1 %>%
    addTableIntersect(
      tableName = "visit_occurrence",
      flag = 1
    )))

  expect_error(expect_warning(cdm$cohort1 %>%
    addTableIntersect(
      tableName = "visit_occurrence",
      count = 1
    )))

  expect_error(expect_warning(cdm$cohort1 %>%
    addTableIntersect(
      tableName = "visit_occurrence",
      date = 1
    )))

  expect_error(expect_warning(cdm$cohort1 %>%
    addTableIntersect(
      tableName = "visit_occurrence",
      days = 1
    )))

  expect_error(expect_warning(cdm$cohort1 %>%
    addTableIntersect(
      tableName = "visit_occurrence",
      field = "condition_start_date"
    )))

  expect_error(expect_warning(cdm$cohort1 %>%
    addTableIntersect(
      tableName = "visit_occurrence",
      nameStyle = "table_name_value_window_name"
    )))
  mockDisconnect(cdm = cdm)
})

test_that("addTableIntersectCount example", {
  cohort1 <- dplyr::tibble(
    cohort_definition_id = c(1, 1, 1, 1, 1, 2, 2, 2, 2, 2),
    subject_id = c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1),
    cohort_start_date = as.Date(
      c(
        "2020-01-01",
        "2021-01-15",
        "2022-01-20",
        "2023-01-01",
        "2024-02-01",
        "2020-01-01",
        "2021-01-15",
        "2022-01-20",
        "2023-01-01",
        "2024-02-01"
      )
    ),
    cohort_end_date = cohort_start_date + 7
  )

  drug_exposure <- dplyr::tibble(
    drug_exposure_id = c(1:7),
    person_id = c(1, 1, 1, 1, 1, 1, 1),
    drug_concept_id = c(1, 2, 2, 2, 2, 3, 3),
    drug_type_concept_id = c(1, 1, 1, 1, 1, 1, 1),
    drug_exposure_start_date = as.Date(
      c(
        "2020-01-15",
        "2020-01-25",
        "2020-01-26",
        "2020-01-29",
        "2020-03-15",
        "2020-01-24",
        "2020-02-16"
      )
    ),
    drug_exposure_end_date = as.Date(
      c(
        "2020-01-15",
        "2020-01-25",
        "2020-01-26",
        "2020-01-29",
        "2020-03-15",
        "2020-01-24",
        "2020-02-16"
      )
    ),
    quantity = c(20, 10, 3, 5, 12, 44, 9),
    class = c("A", "B", "B", "A", "A", "A", "B")
  )

  cdm <- mockPatientProfiles(
    con = connection(),
    writeSchema = writeSchema(),
    cohort1 = cohort1,
    drug_exposure = drug_exposure
  )
  de_count <- cdm$cohort1 |>
    PatientProfiles::addTableIntersectCount(
      tableName = "drug_exposure",
      window = list(c(-50, 50))
    ) %>%
    dplyr::collect()

  expect_identical(
    de_count |> nrow() %>% as.numeric(),
    10
  )

  expect_true("drug_exposure_m50_to_50" %in%
    (colnames(de_count)))

  expect_identical(
    de_count %>% dplyr::filter(cohort_definition_id == 1) %>%
      dplyr::filter(cohort_start_date == "2020-01-01") %>%
      dplyr::pull("drug_exposure_m50_to_50") %>%
      as.numeric(),
    6
  )

  expect_true(all((de_count %>%
    dplyr::filter(!cohort_start_date == "2020-01-01") %>%
    dplyr::filter(cohort_start_date == "2020-01-01") %>%
    dplyr::pull("drug_exposure_m50_to_50") %>%
    as.numeric()) == 0))

  expect_identical(
    de_count %>% dplyr::filter(cohort_start_date == "2020-01-01") %>%
      dplyr::filter(cohort_start_date == "2009-01-01") |>
      nrow() |>
      as.numeric(),
    0
  )

  mockDisconnect(cdm = cdm)
})

test_that("addTableIntersectFlag example", {
  skip_on_cran()
  cohort1 <- dplyr::tibble(
    cohort_definition_id = c(1, 1, 1, 1, 1),
    subject_id = c(1, 1, 1, 1, 1),
    cohort_start_date = as.Date(
      c(
        "2020-01-01",
        "2021-01-15",
        "2022-01-20",
        "2023-01-01",
        "2024-02-01"
      )
    ),
    cohort_end_date = cohort_start_date + 7
  )

  drug_exposure <- dplyr::tibble(
    drug_exposure_id = c(1:7),
    person_id = c(1, 1, 1, 1, 1, 1, 1),
    drug_concept_id = c(1, 2, 2, 2, 2, 3, 3),
    drug_type_concept_id = c(1, 1, 1, 1, 1, 1, 1),
    drug_exposure_start_date = as.Date(
      c(
        "2020-01-15",
        "2020-01-25",
        "2020-01-26",
        "2020-01-29",
        "2020-03-15",
        "2020-01-24",
        "2020-02-16"
      )
    ),
    drug_exposure_end_date = as.Date(
      c(
        "2020-01-15",
        "2020-01-25",
        "2020-01-26",
        "2020-01-29",
        "2020-03-15",
        "2020-01-24",
        "2020-02-16"
      )
    ),
    quantity = c(20, 10, 3, 5, 12, 44, 9),
    class = c("A", "B", "B", "A", "A", "A", "B")
  )

  cdm <- mockPatientProfiles(
    con = connection(),
    writeSchema = writeSchema(),
    cohort1 = cohort1,
    drug_exposure = drug_exposure
  )
  de_flag <- cdm$cohort1 |>
    PatientProfiles::addTableIntersectFlag(
      tableName = "drug_exposure",
      window = list(
        c(-50, 50),
        c(-Inf, 0)
      )
    ) %>%
    dplyr::collect()

  expect_identical(
    de_flag |> nrow() %>% as.numeric(),
    5
  )

  expect_true(all(c("drug_exposure_m50_to_50", "drug_exposure_minf_to_0") %in%
    (colnames(de_flag))))

  expect_true(all((de_flag %>% dplyr::select("drug_exposure_m50_to_50") %>%
    dplyr::pull()) %in% c(0, 1)))

  expect_true(all((de_flag %>% dplyr::select("drug_exposure_minf_to_0") %>%
    dplyr::pull()) %in% c(0, 1)))

  expect_identical(
    de_flag %>%
      dplyr::filter(cohort_start_date == "2020-01-01") %>%
      dplyr::pull("drug_exposure_m50_to_50") %>%
      as.numeric(),
    1
  )

  expect_true(all((de_flag %>%
    dplyr::filter(!cohort_start_date == "2020-01-01") %>%
    dplyr::pull("drug_exposure_m50_to_50") %>%
    as.numeric()) == 0))

  expect_identical(
    de_flag %>%
      dplyr::filter(cohort_start_date == "2020-01-01") %>%
      dplyr::pull("drug_exposure_minf_to_0") %>%
      as.numeric(),
    0
  )

  expect_true(all((de_flag %>%
    dplyr::filter(!cohort_start_date == "2020-01-01") %>%
    dplyr::pull("drug_exposure_minf_to_0") %>%
    as.numeric()) == 1))

  mockDisconnect(cdm = cdm)
})

test_that("addTableIntersectDate example", {
  skip_on_cran()
  cohort1 <- dplyr::tibble(
    cohort_definition_id = c(1, 1, 1, 1, 1),
    subject_id = c(1, 1, 1, 1, 1),
    cohort_start_date = as.Date(
      c(
        "2020-01-01",
        "2021-01-15",
        "2022-01-20",
        "2023-01-01",
        "2024-02-01"
      )
    ),
    cohort_end_date = cohort_start_date + 7
  )

  drug_exposure <- dplyr::tibble(
    drug_exposure_id = c(1:7),
    person_id = c(1, 1, 1, 1, 1, 1, 1),
    drug_concept_id = c(1, 2, 2, 2, 2, 3, 3),
    drug_type_concept_id = c(1, 1, 1, 1, 1, 1, 1),
    drug_exposure_start_date = as.Date(
      c(
        "2020-01-15",
        "2020-01-25",
        "2021-01-26",
        "2021-01-29",
        "2022-03-15",
        "2022-01-24",
        "2023-02-16"
      )
    ),
    drug_exposure_end_date = as.Date(
      c(
        "2020-01-15",
        "2020-01-25",
        "2020-01-26",
        "2020-01-29",
        "2020-03-15",
        "2020-01-24",
        "2020-02-16"
      )
    ),
    quantity = c(20, 10, 3, 5, 12, 44, 9),
    class = c("A", "B", "B", "A", "A", "A", "B")
  )

  cdm <- mockPatientProfiles(
    con = connection(),
    writeSchema = writeSchema(),
    cohort1 = cohort1,
    drug_exposure = drug_exposure
  )
  de_date <- cdm$cohort1 |>
    PatientProfiles::addTableIntersectDate(
      tableName = "drug_exposure",
      window = list(c(-Inf, 0))
    ) %>%
    dplyr::collect()

  expect_identical(
    de_date |> nrow() %>% as.numeric(),
    5
  )

  expect_true(all(c("drug_exposure_minf_to_0") %in%
    (colnames(de_date))))

  expect_true(is.na(de_date %>%
    dplyr::filter(cohort_start_date == "2020-01-01") %>%
    dplyr::pull("drug_exposure_minf_to_0")))

  expect_true(all(!is.na(de_date %>%
    dplyr::filter(!cohort_start_date == "2020-01-01") %>%
    dplyr::pull("drug_exposure_minf_to_0"))))

  expect_identical(
    de_date %>%
      dplyr::filter(cohort_start_date == "2022-01-20") %>%
      dplyr::pull("drug_exposure_minf_to_0") %>%
      as.Date(),
    as.Date("2020-01-15")
  )

  expect_identical(
    de_date %>%
      dplyr::filter(cohort_start_date == "2024-02-01") %>%
      dplyr::pull("drug_exposure_minf_to_0") %>%
      as.Date(),
    as.Date("2020-01-15")
  )
  de_date2 <- cdm$cohort1 |>
    PatientProfiles::addTableIntersectDate(
      tableName = "drug_exposure",
      window = list(c(-Inf, 0)),
      order = "last"
    ) %>%
    dplyr::collect()

  expect_identical(
    de_date2 |> nrow() %>% as.numeric(),
    5
  )

  expect_true(all(c("drug_exposure_minf_to_0") %in%
    (colnames(de_date2))))

  expect_true(is.na(de_date2 %>%
    dplyr::filter(cohort_start_date == "2020-01-01") %>%
    dplyr::pull("drug_exposure_minf_to_0")))

  expect_true(all(!is.na(de_date2 %>%
    dplyr::filter(!cohort_start_date == "2020-01-01") %>%
    dplyr::pull("drug_exposure_minf_to_0"))))

  expect_identical(
    de_date2 %>%
      dplyr::filter(cohort_start_date == "2022-01-20") %>%
      dplyr::pull("drug_exposure_minf_to_0") %>%
      as.Date(),
    as.Date("2021-01-29")
  )

  expect_identical(
    de_date2 %>%
      dplyr::filter(cohort_start_date == "2024-02-01") %>%
      dplyr::pull("drug_exposure_minf_to_0") %>%
      as.Date(),
    as.Date("2023-02-16")
  )

  mockDisconnect(cdm = cdm)
})

test_that("addTableIntersectDays example", {
  skip_on_cran()
  cohort1 <- dplyr::tibble(
    cohort_definition_id = c(1, 1, 1, 1, 1),
    subject_id = c(1, 1, 1, 1, 1),
    cohort_start_date = as.Date(
      c(
        "2020-01-01",
        "2021-01-15",
        "2022-01-20",
        "2023-01-01",
        "2024-02-01"
      )
    ),
    cohort_end_date = cohort_start_date + 7
  )

  drug_exposure <- dplyr::tibble(
    drug_exposure_id = c(1:7),
    person_id = c(1, 1, 1, 1, 1, 1, 1),
    drug_concept_id = c(1, 2, 2, 2, 2, 3, 3),
    drug_type_concept_id = c(1, 1, 1, 1, 1, 1, 1),
    drug_exposure_start_date = as.Date(
      c(
        "2020-01-15",
        "2020-01-25",
        "2021-01-26",
        "2021-01-29",
        "2022-03-15",
        "2022-01-24",
        "2023-02-16"
      )
    ),
    drug_exposure_end_date = as.Date(
      c(
        "2020-01-15",
        "2020-01-25",
        "2020-01-26",
        "2020-01-29",
        "2020-03-15",
        "2020-01-24",
        "2020-02-16"
      )
    ),
    quantity = c(20, 10, 3, 5, 12, 44, 9),
    class = c("A", "B", "B", "A", "A", "A", "B")
  )

  cdm <- mockPatientProfiles(
    con = connection(),
    writeSchema = writeSchema(),
    cohort1 = cohort1,
    drug_exposure = drug_exposure
  )
  de_days <- cdm$cohort1 |>
    PatientProfiles::addTableIntersectDays(
      tableName = "drug_exposure",
      window = list(c(-Inf, 0))
    ) %>%
    dplyr::collect()

  expect_identical(
    de_days |> nrow() %>% as.numeric(),
    5
  )

  expect_true(all(c("drug_exposure_minf_to_0") %in%
    (colnames(de_days))))

  expect_true(is.na(de_days %>%
    dplyr::filter(cohort_start_date == "2020-01-01") %>%
    dplyr::pull("drug_exposure_minf_to_0")))

  expect_true(all(!is.na(de_days %>%
    dplyr::filter(!cohort_start_date == "2020-01-01") %>%
    dplyr::pull("drug_exposure_minf_to_0"))))

  expect_true(all(de_days %>%
    dplyr::filter(!is.na(drug_exposure_minf_to_0)) %>%
    dplyr::select("drug_exposure_minf_to_0") %>%
    dplyr::pull("drug_exposure_minf_to_0") <= 0))

  expect_identical(
    de_days %>%
      dplyr::filter(cohort_start_date == "2024-02-01") %>%
      dplyr::pull("drug_exposure_minf_to_0") %>%
      as.numeric(),
    -as.numeric(as.Date("2024-02-01") - as.Date("2020-01-15"))
  )

  de_days2 <- cdm$cohort1 |>
    PatientProfiles::addTableIntersectDays(
      tableName = "drug_exposure",
      window = list(c(0, Inf)),
      order = "last"
    ) %>%
    dplyr::collect()

  expect_identical(
    de_days2 |> nrow() %>% as.numeric(),
    5
  )

  expect_true(all(c("drug_exposure_0_to_inf") %in%
    (colnames(de_days2))))

  expect_true(is.na(de_days2 %>%
    dplyr::filter(cohort_start_date == "2024-02-01") %>%
    dplyr::pull("drug_exposure_0_to_inf")))

  expect_true(all(!is.na(de_days2 %>%
    dplyr::filter(!cohort_start_date == "2024-02-01") %>%
    dplyr::pull("drug_exposure_0_to_inf"))))

  expect_true(all(de_days2 %>%
    dplyr::filter(!is.na(drug_exposure_0_to_inf)) %>%
    dplyr::select("drug_exposure_0_to_inf") %>%
    dplyr::pull("drug_exposure_0_to_inf") >= 0))

  expect_identical(
    de_days2 %>%
      dplyr::filter(cohort_start_date == "2020-01-01") %>%
      dplyr::pull("drug_exposure_0_to_inf") %>%
      as.numeric(),
    as.numeric(as.Date("2023-02-16") - as.Date("2020-01-01"))
  )

  mockDisconnect(cdm = cdm)
})

test_that("addTableIntersectFields example", {
  skip_on_cran()
  cohort1 <- dplyr::tibble(
    cohort_definition_id = c(1, 1, 1, 1, 1),
    subject_id = c(1, 1, 1, 1, 1),
    cohort_start_date = as.Date(
      c(
        "2020-01-01",
        "2021-01-15",
        "2022-01-20",
        "2023-01-01",
        "2024-02-01"
      )
    ),
    cohort_end_date = cohort_start_date + 7
  )

  drug_exposure <- dplyr::tibble(
    drug_exposure_id = c(1:7),
    person_id = c(1, 1, 1, 1, 1, 1, 1),
    drug_concept_id = c(1, 2, 2, 2, 2, 3, 3),
    drug_type_concept_id = c(1, 1, 1, 1, 1, 1, 1),
    drug_exposure_start_date = as.Date(
      c(
        "2020-01-15",
        "2020-01-25",
        "2021-01-26",
        "2021-01-29",
        "2022-03-15",
        "2022-01-24",
        "2023-02-16"
      )
    ),
    drug_exposure_end_date = as.Date(
      c(
        "2020-01-15",
        "2020-01-25",
        "2020-01-26",
        "2020-01-29",
        "2020-03-15",
        "2020-01-24",
        "2020-02-16"
      )
    ),
    quantity = c(20, 10, 3, 5, 12, 44, 9),
    class = c("A", "B", "B", "A", "A", "A", "B")
  )

  cdm <- mockPatientProfiles(
    con = connection(),
    writeSchema = writeSchema(),
    cohort1 = cohort1,
    drug_exposure = drug_exposure
  )

  de_field <- cdm$cohort1 |>
    PatientProfiles::addTableIntersectField(
      tableName = "drug_exposure",
      window = list(c(-Inf, 0)),
      field = "drug_concept_id"
    ) %>%
    dplyr::collect()

  expect_identical(
    de_field |> nrow() %>% as.numeric(),
    5
  )

  expect_true(all(c("drug_exposure_drug_concept_id_minf_to_0") %in%
    (colnames(de_field))))

  expect_true(is.na(de_field %>%
    dplyr::filter(cohort_start_date == "2020-01-01") %>%
    dplyr::pull("drug_exposure_drug_concept_id_minf_to_0")))

  expect_true(all(!is.na(de_field %>%
    dplyr::filter(!cohort_start_date == "2020-01-01") %>%
    dplyr::pull("drug_exposure_drug_concept_id_minf_to_0"))))

  expect_true(all((de_field %>%
    dplyr::filter(!is.na(drug_exposure_drug_concept_id_minf_to_0)) %>%
    dplyr::select("drug_exposure_drug_concept_id_minf_to_0") %>%
    dplyr::pull("drug_exposure_drug_concept_id_minf_to_0") |>
    as.integer()) %in% c(1, 2, 3)))

  mockDisconnect(cdm = cdm)
})