tests/testthat/test-addCohortIntersect.R

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

test_that("output format - one outcome cohort", {
  # output format - one outcome cohort ----
  # additional column should be added
  # with the name as specified

  cdm <- mockPatientProfiles(
    con = connection(), writeSchema = writeSchema(), numberIndividuals = 10,
    seed = 1
  )

  cdm$cohort1a <- cdm$cohort1 %>%
    addCohortIntersectDays(
      targetCohortId = 1,
      targetDate = "cohort_start_date",
      targetCohortTable = "cohort2"
    )

  expect_true(ncol(cdm$cohort1a) == 5)

  cdm$cohort1b <- cdm$cohort1 %>%
    addCohortIntersectDate(
      targetCohortId = 1,
      targetDate = "cohort_start_date",
      targetCohortTable = "cohort2"
    )
  expect_true(ncol(cdm$cohort1b) == 5)

  # output format - multiple outcome cohorts ----
  # additional columns (one per outcome cohort) should be added
  # with the name as specified

  cdm$cohort1a <- cdm$cohort1 %>%
    addCohortIntersectDays(
      window = c(0, Inf),
      targetCohortId = NULL,
      indexDate = "cohort_start_date",
      targetCohortTable = "cohort2"
    )
  expect_true("cohort_2_0_to_inf" %in% colnames(cdm$cohort1a))
  cdm$cohort1b <- cdm$cohort1 %>%
    addCohortIntersectDate(
      window = c(0, Inf),
      targetCohortId = NULL,
      indexDate = "cohort_start_date",
      targetCohortTable = "cohort2"
    )
  expect_true("cohort_1_0_to_inf" %in% colnames(cdm$cohort1b))
  expect_true("cohort_2_0_to_inf" %in% colnames(cdm$cohort1b))

  cdm$cohort1c <- cdm$cohort1 %>%
    addCohortIntersectDays(
      window = c(-Inf, Inf),
      targetCohortId = NULL,
      indexDate = "cohort_start_date",
      targetCohortTable = "cohort2"
    )
  expect_true("cohort_1_minf_to_inf" %in% colnames(cdm$cohort1c))
  expect_true("cohort_2_minf_to_inf" %in% colnames(cdm$cohort1c))

  cdm$cohort1d <- cdm$cohort1 %>%
    addCohortIntersectDate(
      window = c(-Inf, Inf),
      targetCohortId = NULL,
      indexDate = "cohort_start_date",
      targetCohortTable = "cohort2"
    )
  expect_true("cohort_1_minf_to_inf" %in% colnames(cdm$cohort1d))
  expect_true("cohort_2_minf_to_inf" %in% colnames(cdm$cohort1d))

  mockDisconnect(cdm)
})

test_that("first vs last event - cohort table", {
  # depending on user choice, should get back either the
  # first or last outcome record

  cohort1 <- dplyr::tibble(
    cohort_definition_id = 1L,
    subject_id = c(1L, 2L),
    cohort_start_date = c(as.Date("2010-03-01"), as.Date("2011-02-01")),
    cohort_end_date = c(as.Date("2015-01-01"), as.Date("2013-01-01"))
  )

  cohort2 <- dplyr::tibble(
    cohort_definition_id = 1L,
    subject_id = c(1L, 1L, 1L, 2L),
    cohort_start_date = c(
      as.Date("2010-03-03"), as.Date("2010-03-15"), as.Date("2010-03-25"),
      as.Date("2013-01-03")
    ),
    cohort_end_date = c(
      as.Date("2010-03-03"), as.Date("2010-03-15"), as.Date("2010-03-25"),
      as.Date("2013-01-03")
    )
  )

  cdm <- mockPatientProfiles(
    con = connection(),
    writeSchema = writeSchema(),
    cohort1 = cohort1,
    cohort2 = cohort2,
    numberIndividuals = 2
  )

  # first
  cdm$cohort1a <- cdm$cohort1 %>%
    addCohortIntersectDays(
      targetCohortId = 1,
      indexDate = "cohort_start_date",
      targetCohortTable = "cohort2",
      order = "first"
    )
  expect_true(cdm$cohort1a %>%
    dplyr::filter(subject_id == 1) %>%
    dplyr::pull(5) ==
    as.numeric(difftime(as.Date("2010-03-03"),
      as.Date("2010-03-01"),
      units = "days"
    )))
  expect_true(cdm$cohort1a %>%
    dplyr::filter(subject_id == 2) %>%
    dplyr::pull(5) ==
    as.numeric(difftime(as.Date("2013-01-03"),
      as.Date("2011-02-01"),
      units = "days"
    )))

  cdm$cohort1b <- cdm$cohort1 %>%
    addCohortIntersectDate(
      targetCohortId = 1,
      indexDate = "cohort_start_date",
      targetCohortTable = "cohort2",
      order = "first"
    )
  expect_true(cdm$cohort1b %>%
    dplyr::filter(subject_id == 1) %>%
    dplyr::pull(5) == as.Date("2010-03-03"))
  expect_true(cdm$cohort1b %>%
    dplyr::filter(subject_id == 2) %>%
    dplyr::pull(5) == as.Date("2013-01-03"))


  # last
  cdm$cohort1c <- cdm$cohort1 %>%
    addCohortIntersectDays(
      targetCohortId = 1,
      indexDate = "cohort_start_date",
      targetCohortTable = "cohort2",
      order = "last"
    )
  expect_true(cdm$cohort1c %>%
    dplyr::filter(subject_id == 1) %>%
    dplyr::pull(5) ==
    as.numeric(difftime(as.Date("2010-03-25"),
      as.Date("2010-03-01"),
      units = "days"
    )))
  expect_true(cdm$cohort1c %>%
    dplyr::filter(subject_id == 2) %>%
    dplyr::pull(5) ==
    as.numeric(difftime(as.Date("2013-01-03"),
      as.Date("2011-02-01"),
      units = "days"
    )))

  cdm$cohort1d <- cdm$cohort1 %>%
    addCohortIntersectDate(
      targetCohortId = 1,
      indexDate = "cohort_start_date",
      targetCohortTable = "cohort2",
      order = "last"
    )
  expect_true(cdm$cohort1d %>%
    dplyr::filter(subject_id == 1) %>%
    dplyr::pull(5) ==
    as.Date("2010-03-25"))
  expect_true(cdm$cohort1d %>%
    dplyr::filter(subject_id == 2) %>%
    dplyr::pull(5) == as.Date("2013-01-03"))

  mockDisconnect(cdm)
})

test_that("multiple cohort entries per person", {
  # in the presence of multiple cohort entries in the index cohort
  # each record should be treated independently

  cohort1 <- dplyr::tibble(
    cohort_definition_id = 1L,
    subject_id = c(1L, 1L, 2L),
    cohort_start_date = c(
      as.Date("2010-03-01"), as.Date("2012-03-01"), as.Date("2011-02-01")
    ),
    cohort_end_date = c(
      as.Date("2012-01-01"), as.Date("2016-03-01"), as.Date("2013-01-01")
    )
  )

  cohort2 <- dplyr::tibble(
    cohort_definition_id = 1L,
    subject_id = c(1L, 1L, 1L, 2L),
    cohort_start_date = c(
      as.Date("2010-03-03"), as.Date("2010-03-15"), as.Date("2012-03-25"),
      as.Date("2013-01-03")
    ),
    cohort_end_date = c(
      as.Date("2010-03-03"), as.Date("2010-03-15"), as.Date("2012-03-25"),
      as.Date("2013-01-03")
    )
  )

  cdm <- mockPatientProfiles(
    con = connection(),
    writeSchema = writeSchema(),
    cohort1 = cohort1,
    cohort2 = cohort2,
    numberIndividuals = 2
  )

  # 100 days from index
  cdm$cohort1a <- cdm$cohort1 %>%
    addCohortIntersectDays(
      window = c(0, 100),
      indexDate = "cohort_start_date",
      targetCohortTable = "cohort2",
      order = "first"
    )

  expect_true(all(cdm$cohort1a %>%
    dplyr::filter(subject_id == 1) %>%
    dplyr::collect() |>
    dplyr::arrange(cohort_start_date) %>%
    dplyr::pull(5) ==
    c(
      as.numeric(difftime(as.Date("2010-03-03"),
        as.Date("2010-03-01"),
        units = "days"
      )),
      as.numeric(difftime(as.Date("2012-03-25"),
        as.Date("2012-03-01"),
        units = "days"
      ))
    )))

  expect_equal(
    cdm$cohort1 %>% dplyr::tally() %>% dplyr::pull("n"),
    cdm$cohort1a %>% dplyr::tally() %>% dplyr::pull("n")
  )

  cdm$cohort1b <- cdm$cohort1 %>%
    addCohortIntersectDate(
      window = c(0, 100),
      indexDate = "cohort_start_date",
      targetCohortTable = "cohort2",
      order = "first"
    )

  expect_true(all(cdm$cohort1b %>%
    dplyr::filter(subject_id == 1) %>%
    dplyr::collect() |>
    dplyr::arrange(cohort_start_date) %>%
    dplyr::pull(5) ==
    c(
      as.Date("2010-03-03"),
      as.Date("2012-03-25")
    )))

  expect_equal(
    cdm$cohort1 %>% dplyr::tally() %>% dplyr::pull("n"),
    cdm$cohort1b %>% dplyr::tally() %>% dplyr::pull("n")
  )

  mockDisconnect(cdm)
})

test_that("output names", {
  skip_on_cran()
  # additional column should be added
  # with the name as specified

  cdm <- mockPatientProfiles(
    con = connection(), writeSchema = writeSchema(), numberIndividuals = 10,
    seed = 1
  )

  # default naming
  cdm$cohort1a <- cdm$cohort1 %>%
    addCohortIntersectDays(
      window = c(10, 50),
      targetCohortId = 1,
      targetDate = "cohort_start_date",
      targetCohortTable = "cohort2"
    )
  expect_true(all(
    c("cohort_1_10_to_50") %in%
      colnames(cdm$cohort1a)
  ))

  cdm$cohort1b <- cdm$cohort1 %>%
    addCohortIntersectDate(
      window = c(10, 50),
      targetCohortId = c(1,2),
      targetDate = "cohort_start_date",
      targetCohortTable = "cohort2"
    ) # id_name won't be clear to the user
  expect_true(all(
    c("cohort_1_10_to_50", "cohort_2_10_to_50") %in%
      colnames(cdm$cohort1b)
  ))

  # new names
  cdm$cohort1c <- cdm$cohort1 %>%
    addCohortIntersectDays(
      window = c(10, 50),
      targetCohortId = c(1, 2),
      targetDate = "cohort_start_date",
      targetCohortTable = "cohort2",
      nameStyle = "study_{cohort_name}"
    )
  expect_true(all(
    c("study_cohort_1", "study_cohort_2") %in%
      colnames(cdm$cohort1c)
  ))

  # new names
  cdm$cohort1d <- cdm$cohort1 %>%
    addCohortIntersectDate(
      window = c(10, 50),
      targetCohortId = 2,
      targetDate = "cohort_start_date",
      targetCohortTable = "cohort2",
      nameStyle = "study_{cohort_name}"
    )
  expect_true(all(
    c("study_cohort_2") %in%
      colnames(cdm$cohort1c)
  ))

  # bad naming
  expect_error(cdm$cohort1 %>%
    addCohortIntersectDate(
      window = list(c(0, 3), c(10, 50)),
      targetCohortId = NULL,
      targetDate = "cohort_start_date",
      targetCohortTable = "cohort2",
      nameStyle = "study"
    ))

  mockDisconnect(cdm)
})

test_that("expected errors ", {
  skip_on_cran()
  cdm <- mockPatientProfiles(con = connection(), writeSchema = writeSchema())

  # missing outcome table
  expect_error(cdm$cohort1 %>%
    addCohortIntersectDays(
      targetCohortId = 1,
      indexDate = "cohort_start_date",
      targetCohortTable = "table_x"
    ))
  expect_error(cdm$cohort1 %>%
    addCohortIntersectDate(
      targetCohortId = 1,
      indexDate = "cohort_start_date",
      targetCohortTable = "table_x"
    ))

  expect_error(cdm$cohort1 %>%
    addCohortIntersectDays(
      targetCohortId = 1,
      indexDate = "cohort_start_date",
      targetCohortTable = "cohort2",
      window = c(300, 100)
    ))

  expect_error(cdm$cohort1 %>%
    addCohortIntersectDate(
      targetCohortId = 1,
      indexDate = "cohort_start_date",
      targetCohortTable = "cohort2",
      censorDate = as.Date("2020-01-01")
    ))

  expect_error(cdm$cohort1 %>%
    addCohortIntersectDate(
      targetCohortId = 1,
      indexDate = "cohort_start_date",
      targetCohortTable = "cohort2",
      censorDate = "subject_id"
    ))

  mockDisconnect(cdm)
})

test_that("working examples", {
  skip_on_cran()
  # functionality
  cohort1 <- dplyr::tibble(
    cohort_definition_id = as.integer(c(1, 1, 1, 1, 1)),
    subject_id = as.integer(c(1, 1, 1, 2, 2)),
    cohort_start_date = as.Date(
      c(
        "2020-01-01",
        "2020-01-15",
        "2020-01-20",
        "2020-01-01",
        "2020-02-01"
      )
    ),
    cohort_end_date = as.Date(
      c(
        "2020-01-01",
        "2020-01-15",
        "2020-01-20",
        "2020-01-01",
        "2020-02-01"
      )
    )
  )

  cohort2 <- dplyr::tibble(
    cohort_definition_id = as.integer(c(1, 1, 2, 2, 3, 3, 3)),
    subject_id = as.integer(c(1, 1, 1, 2, 2, 2, 1)),
    cohort_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"
      )
    ),
    cohort_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"
      )
    ),
  )

  cdm <- mockPatientProfiles(
    con = connection(),
    writeSchema = writeSchema(),
    cohort1 = cohort1,
    cohort2 = cohort2,
    numberIndividuals = 2
  )

  result0 <- cdm$cohort1 %>%
    addCohortIntersectCount(targetCohortTable = "cohort2") %>%
    dplyr::collect() %>%
    dplyr::arrange(subject_id, cohort_start_date)
  result1 <- cdm$cohort1 %>%
    addCohortIntersectCount(targetCohortTable = "cohort2", targetCohortId = 1) %>%
    dplyr::collect() %>%
    dplyr::arrange(subject_id, cohort_start_date)
  result2 <- cdm$cohort1 %>%
    addCohortIntersectCount(targetCohortTable = "cohort2", targetCohortId = 2) %>%
    dplyr::collect() %>%
    dplyr::arrange(subject_id, cohort_start_date)
  result3 <- cdm$cohort1 %>%
    addCohortIntersectCount(targetCohortTable = "cohort2", targetCohortId = 3) %>%
    dplyr::collect() %>%
    dplyr::arrange(subject_id, cohort_start_date)

  expect_true(all(result0$cohort_1_0_to_inf == result1$cohort_1_0_to_inf))
  expect_true(all(result0$cohort_2_0_to_inf == result2$cohort_2_0_to_inf))
  expect_true(all(result0$cohort_3_0_to_inf == result3$cohort_3_0_to_inf))

  result1 <- cdm$cohort1 %>%
    addCohortIntersectCount(
      targetCohortTable = "cohort2", targetCohortId = c(2, 3),
      window = list(c(-Inf, 0))
    ) %>%
    dplyr::collect() %>%
    dplyr::arrange(subject_id, cohort_start_date)

  expect_true(all(result1$cohort_2_minf_to_0 == c(0, 0, 0, 0, 1)))
  expect_true(all(result1$cohort_3_minf_to_0 == c(0, 0, 0, 0, 1)))

  attr(cdm$cohort2, "cohort_set") <- dplyr::tibble(
    cohort_definition_id = as.integer(c(1, 2, 3)),
    cohort_name = c("asthma", "covid", "tb")
  )
  result2 <- cdm$cohort1 %>%
    addCohortIntersectCount(
      targetCohortTable = "cohort2", targetCohortId = c(2, 3),
      window = list(c(-Inf, 0))
    ) %>%
    dplyr::collect() %>%
    dplyr::arrange(subject_id, cohort_start_date)

  expect_true(all(result2$covid_minf_to_0 == c(0, 0, 0, 0, 1)))
  expect_true(all(result2$tb_minf_to_0 == c(0, 0, 0, 0, 1)))

  mockDisconnect(cdm)
})

test_that("working examples", {
  skip_on_cran()
  # functionality
  cohort1 <- dplyr::tibble(
    cohort_definition_id = as.integer(c(1, 1, 1, 1, 1)),
    subject_id = as.integer(c(1, 1, 1, 2, 2)),
    cohort_start_date = as.Date(
      c(
        "2020-01-01",
        "2020-01-15",
        "2020-01-20",
        "2020-01-01",
        "2020-02-01"
      )
    ),
    cohort_end_date = as.Date(
      c(
        "2020-01-01",
        "2020-01-15",
        "2020-01-20",
        "2020-01-01",
        "2020-02-01"
      )
    )
  )

  cohort2 <- dplyr::tibble(
    cohort_definition_id = as.integer(c(1, 1, 2, 2, 3, 3, 3)),
    subject_id = as.integer(c(1, 1, 1, 2, 2, 2, 1)),
    cohort_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"
      )
    ),
    cohort_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"
      )
    ),
  )

  cdm <- mockPatientProfiles(
    con = connection(), writeSchema = writeSchema(),
    cohort1 = cohort1,
    cohort2 = cohort2,
    numberIndividuals = 2
  )

  result0 <- cdm$cohort1 %>%
    addCohortIntersectFlag(targetCohortTable = "cohort2") %>%
    dplyr::collect() %>%
    dplyr::arrange(subject_id, cohort_start_date)
  result1 <- cdm$cohort1 %>%
    addCohortIntersectFlag(targetCohortTable = "cohort2", targetCohortId = 1) %>%
    dplyr::collect() %>%
    dplyr::arrange(subject_id, cohort_start_date)
  result2 <- cdm$cohort1 %>%
    addCohortIntersectFlag(targetCohortTable = "cohort2", targetCohortId = 2) %>%
    dplyr::collect() %>%
    dplyr::arrange(subject_id, cohort_start_date)
  result3 <- cdm$cohort1 %>%
    addCohortIntersectFlag(targetCohortTable = "cohort2", targetCohortId = 3) %>%
    dplyr::collect() %>%
    dplyr::arrange(subject_id, cohort_start_date)

  expect_true(all(result0$cohort_1_0_to_inf == result1$cohort_1_0_to_inf))
  expect_true(all(result0$cohort_2_0_to_inf == result2$cohort_2_0_to_inf))
  expect_true(all(result0$cohort_3_0_to_inf == result3$cohort_3_0_to_inf))

  result1 <- cdm$cohort1 %>%
    addCohortIntersectFlag(targetCohortTable = "cohort2", targetCohortId = 2) %>%
    dplyr::collect() %>%
    dplyr::arrange(subject_id, cohort_start_date)

  expect_true(all(result1$cohort_2_0_to_inf == c(1, 1, 1, 1, 0)))

  mockDisconnect(cdm)
})

test_that("working examples", {
  skip_on_cran()
  # functionality
  cohort1 <- dplyr::tibble(
    cohort_definition_id = as.integer(c(1, 1, 1, 1, 1)),
    subject_id = as.integer(c(1, 1, 1, 2, 2)),
    cohort_start_date = as.Date(c(
      "2020-01-01", "2020-01-15", "2020-01-20", "2020-01-01", "2020-02-01"
    )),
    cohort_end_date = as.Date(c(
      "2020-01-01", "2020-01-15", "2020-01-20", "2020-01-01", "2020-02-01"
    ))
  )

  cohort2 <- dplyr::tibble(
    cohort_definition_id = as.integer(c(1, 1, 2, 2, 3, 3, 3)),
    subject_id = as.integer(c(1, 1, 1, 2, 2, 2, 1)),
    cohort_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"
    )),
    cohort_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"
    ))
  )

  cdm <- mockPatientProfiles(
    con = connection(),
    writeSchema = writeSchema(),
    cohort1 = cohort1,
    cohort2 = cohort2,
    numberIndividuals = 2
  )

  expect_no_error(
    result2 <- cdm$cohort1 %>%
      addCohortIntersectCount(
        targetCohortTable = "cohort2",
        nameStyle = "{value}_{cohort_name}_{window_name}"
      ) %>%
      addCohortIntersectFlag(
        targetCohortTable = "cohort2",
        nameStyle = "{value}_{cohort_name}_{window_name}"
      ) %>%
      addCohortIntersectDate(
        targetCohortTable = "cohort2",
        nameStyle = "{value}_{cohort_name}_{window_name}"
      ) %>%
      addCohortIntersectDays(
        targetCohortTable = "cohort2",
        nameStyle = "{value}_{cohort_name}_{window_name}"
      ) %>%
      dplyr::collect() %>%
      dplyr::arrange(subject_id, cohort_start_date)
  )

  mockDisconnect(cdm)
})

test_that("censorDate functionality", {
  skip_on_cran()
  cohort1 <- dplyr::tibble(
    cohort_definition_id = as.integer(c(1, 1, 1, 1, 1)),
    subject_id = as.integer(c(1, 2, 3, 4, 5)),
    cohort_start_date = as.Date(c(
      "2020-01-01", "2020-01-15", "2020-01-20", "2020-01-01", "2020-02-01"
    )),
    cohort_end_date = as.Date(c(
      "2020-03-01", "2021-01-15", "2022-01-20", "2020-01-06", "2020-07-01"
    ))
  )

  cohort2 <- dplyr::tibble(
    cohort_definition_id = as.integer(c(1, 1, 1, 1, 1, 1, 1)),
    subject_id = as.integer(c(1, 1, 2, 3, 4, 5, 5)),
    cohort_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"
    )),
    cohort_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"
    ))
  )

  cdm <- mockPatientProfiles(
    con = connection(),
    writeSchema = writeSchema(),
    cohort1 = cohort1,
    cohort2 = cohort2,
    numberIndividuals = 5
  )

  compareNA <- function(v1, v2) {
    same <- (v1 == v2) | (is.na(v1) & is.na(v2))
    same[is.na(same)] <- FALSE
    return(same)
  }

  result1 <- cdm$cohort1 %>%
    addCohortIntersectFlag(
      targetCohortTable = "cohort2",
      censorDate = "cohort_end_date",
      nameStyle = "{value}_{window_name}"
    ) %>%
    addCohortIntersectCount(
      targetCohortTable = "cohort2",
      censorDate = "cohort_end_date",
      nameStyle = "{value}_{window_name}"
    ) %>%
    addCohortIntersectDate(
      targetCohortTable = "cohort2",
      censorDate = "cohort_end_date",
      nameStyle = "{value}_{window_name}"
    ) %>%
    addCohortIntersectDays(
      targetCohortTable = "cohort2",
      censorDate = "cohort_end_date",
      nameStyle = "{value}_{window_name}"
    ) %>%
    dplyr::collect() %>%
    dplyr::arrange(subject_id, cohort_start_date)

  expect_true(all(compareNA(
    result1 %>% dplyr::filter(subject_id == 4) %>%
      dplyr::select(dplyr::ends_with("inf")) %>% dplyr::arrange("subject_id") %>%
      unlist(use.names = F),
    c(0, 0, NA, NA)
  )))

  mockDisconnect(cdm)
})

test_that("casing of empty dates", {
  skip_on_cran()
  cdm <- mockPatientProfiles(
    con = connection(), writeSchema = writeSchema(), numberIndividuals = 3,
    seed = 1
  )
  cdm$cohort1 <- cdm$cohort1 %>% dplyr::filter(cohort_definition_id == 1)
  expect_false(
    cdm$cohort2 %>%
      addCohortIntersectDate(targetCohortTable = "cohort1") %>%
      head(1) %>%
      dplyr::pull("cohort_2_0_to_inf") %>%
      is.numeric()
  )

  mockDisconnect(cdm)
})

test_that("cohortIntersect after observation", {
  skip_on_cran()
  cdm <- mockPatientProfiles(
    con = connection(),
    writeSchema = writeSchema(),
    cohort1 = dplyr::tibble(
      cohort_definition_id = 1L,
      subject_id = 1L,
      cohort_start_date = as.Date(c("2020-01-01", "2020-06-01")),
      cohort_end_date = as.Date(c("2020-04-01", "2020-08-01"))
    ),
    cohort2 = dplyr::tibble(
      cohort_definition_id = c(1L, 2L, 1L),
      subject_id = 1L,
      cohort_start_date = as.Date(c("2019-12-30", "2020-05-25", "2020-05-25")),
      cohort_end_date = as.Date(c("2019-12-30", "2020-05-25", "2020-05-25"))
    ),
    person = dplyr::tibble(
      person_id = 1L,
      gender_concept_id = 8532L,
      year_of_birth = 1992L,
      month_of_birth = 12L,
      day_of_birth = 30L,
      race_concept_id = 0L,
      ethnicity_concept_id = 0L
    ),
    observation_period = dplyr::tibble(
      observation_period_id = 1L,
      person_id = 1L,
      observation_period_start_date = as.Date("2006-03-11"),
      observation_period_end_date = as.Date("2102-04-02"),
      period_type_concept_id = 0L
    )
  )

  windows <- list(
    c(-Inf, Inf), c(0, 0), c(0, Inf), c(5000, 31000), c(31000, Inf),
    c(31000, 45000), c(-Inf, -5000), c(-Inf, -6000), c(-8000, -6000)
  )

  expect_no_error(
    x <- cdm$cohort1 |>
      addCohortIntersectFlag(
        targetCohortTable = "cohort2",
        targetCohortId = 1,
        window = windows,
        nameStyle = "flag_{window_name}"
      ) |>
      addCohortIntersectCount(
        targetCohortTable = "cohort2",
        targetCohortId = 1,
        window = windows,
        nameStyle = "count_{window_name}"
      ) |>
      addCohortIntersectDays(
        targetCohortTable = "cohort2",
        targetCohortId = 1,
        window = windows,
        nameStyle = "days_{window_name}"
      ) |>
      addCohortIntersectDate(
        targetCohortTable = "cohort2",
        targetCohortId = 1,
        window = windows,
        nameStyle = "date_{window_name}"
      ) |>
      dplyr::collect()
  )

  windows <- omopgenerics::validateWindowArgument(windows)
  out <- c(5, 6, 8, 9)
  for (k in seq_along(windows)) {
    for (val in c("flag", "count", "date", "days")) {
      col <- paste0(val, "_", names(windows)[k])
      expect_true(col %in% colnames(x))
      if (k %in% out) {
        expect_true(all(is.na(x[[col]])))
      } else if (val %in% c("flag", "count")) {
        expect_true(all(!is.na(x[[col]])))
      }
    }
  }

  mockDisconnect(cdm)
})

test_that("issue 612", {
  skip_on_cran()
  cohort <- dplyr::tibble(
    cohort_definition_id = as.integer(c(1, 2, 3, 1, 2, 3, 1, 2)),
    subject_id = as.integer(c(1, 1, 1, 2, 3, 3, 4, 4)),
    cohort_start_date = as.Date(c(
      "2020-03-01", "2020-04-01", "2020-01-01", "2020-02-01", "2020-03-01",
      "2020-04-01", "2020-02-01", "2020-06-01"
    )),
    cohort_end_date = as.Date(c(
      "2020-05-01", "2020-06-01", "2020-05-01", "2020-05-01", "2020-05-01",
      "2020-07-01", "2020-02-04", "2020-06-08"
    ))
  )
  person <- dplyr::tibble(
    person_id = as.integer(c(1, 2, 3, 4)),
    gender_concept_id = as.integer(c(8507, 8532, 8507, 8532)),
    year_of_birth = 2000L,
    month_of_birth = 1L,
    day_of_birth = 1L,
    race_concept_id = as.integer(NA),
    ethnicity_concept_id = as.integer(NA)
  )
  observation_period <- dplyr::tibble(
    observation_period_id = as.integer(1:4),
    person_id = as.integer(1:4),
    observation_period_start_date = as.Date("2010-01-01"),
    observation_period_end_date = as.Date("2020-12-31"),
    period_type_concept_id = 32880L
  )
  cdm <- mockPatientProfiles(
    con = connection(),
    writeSchema = writeSchema(),
    observation_period = observation_period,
    person = person,
    cohort1 = cohort
  )

  x <- cdm$cohort1 |>
    addCohortIntersectFlag(
      targetCohortTable = "cohort1",
      window = c(0, 0),
      nameStyle = "{cohort_name}"
    ) |>
    dplyr::collect() |>
    dplyr::arrange(
      .data$cohort_definition_id, .data$subject_id, .data$cohort_start_date
    )

  expect_true(all(x$cohort_1 == c(1, 1, 1, 1, 0, 0, 0, 0)))
  expect_true(all(x$cohort_2 == c(0, 0, 0, 1, 1, 1, 0, 1)))
  expect_true(all(x$cohort_3 == c(1, 0, 0, 1, 0, 0, 1, 1)))

  mockDisconnect(cdm)
})