tests/testthat/test-addConceptIntersect.R

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

test_that("addConceptIntersect", {
  skip_on_cran()
  con <- DBI::dbConnect(duckdb::duckdb(), CDMConnector::eunomia_dir())
  cdm <- CDMConnector::cdmFromCon(
    con = con, cdmSchema = "main", writeSchema = "main"
  )
  cdm <- CDMConnector::copyCdmTo(
    con = connection(), cdm = cdm, schema = writeSchema()
  )
  DBI::dbDisconnect(conn = con, shutdown = TRUE)

  # create a cohort
  cdm <- CDMConnector::generateConceptCohortSet(
    cdm = cdm, conceptSet = list("sinusitis" = c(4294548L, 40481087L, 257012L)),
    name = "my_cohort"
  )

  codelist <- list(
    "statin" = cdm$concept |>
      dplyr::filter(grepl("statin", concept_name, ignore.case = T)) |>
      dplyr::pull("concept_id"),
    "serum_measurement" = cdm$concept |>
      dplyr::filter(grepl("serum", concept_name, ignore.case = T)) |>
      dplyr::pull("concept_id"),
    "allergy" = cdm$concept |>
      dplyr::filter(grepl("allergy", concept_name, ignore.case = T)) |>
      dplyr::pull("concept_id"),
    "bypass" = cdm$concept |>
      dplyr::filter(grepl("bypass", concept_name, ignore.case = T)) |>
      dplyr::pull("concept_id"),
    "laceration" = cdm$concept |>
      dplyr::filter(grepl("laceration", concept_name, ignore.case = T)) |>
      dplyr::pull("concept_id")
  )

  expect_no_error(
    cdm$my_cohort |>
      addConceptIntersectCount(conceptSet = codelist)
  )

  expect_no_error(
    cdm$my_cohort |>
      addConceptIntersectFlag(conceptSet = codelist)
  )

  expect_no_error(
    cdm$my_cohort |>
      addConceptIntersectDate(conceptSet = codelist)
  )

  # test input
  expect_error(
    cdm$my_cohort |>
      addConceptIntersectCount(
        conceptSet = codelist, targetStartDate = "cohort_start_date"
      )
  )
  expect_error(
    cdm$my_cohort |>
      addConceptIntersectCount(
        conceptSet = codelist, targetEndDate = "cohort_start_date"
      )
  )

  expect_no_error(
    cdm$my_cohort |>
      addConceptIntersectDays(
        conceptSet = codelist, targetDate = "event_end_date"
      )
  )

  expect_no_error(
    cdm$my_cohort |>
      addConceptIntersectDate(
        conceptSet = codelist, targetDate = "event_end_date"
      )
  )

  expect_no_error(
    cdm$my_cohort |>
      addConceptIntersectCount(
        conceptSet = codelist, targetStartDate = "event_end_date"
      )
  )

  expect_error(
    cdm$my_cohort |>
      addConceptIntersectCount(
        conceptSet = codelist, targetStartDate = NULL
      )
  )

  mockDisconnect(cdm = cdm)
})

test_that("unsupported domain name", {
  skip_on_cran()
  cdm <- mockPatientProfiles(con = connection(), writeSchema = writeSchema())
  concept <- dplyr::tibble(
    concept_id = c(1125315),
    domain_id = "random",
    concept_class_id = NA_character_,
    vocabulary_id = NA_character_,
    concept_code = NA_character_,
    valid_start_date = as.Date("1900-01-01"),
    valid_end_date = as.Date("2099-01-01"),
    invalid_reason = NA_character_
  ) %>%
    dplyr::mutate(concept_name = paste0("concept: ", .data$concept_id))
  cdm <- CDMConnector::insertTable(cdm, "concept", concept)

  expect_no_warning(result <- cdm$cohort1 %>%
    addConceptIntersectFlag(
      conceptSet = list("random" = 1125315L)
    ) %>%
    dplyr::collect())

  expect_true(
    "random_0_to_inf" %in%
      (result |>
        colnames())
  )

  expect_no_error(
    cdm$cohort1a <- cdm$cohort1 %>%
    addConceptIntersectFlag(
      conceptSet = list("not_in_concept_table" = 99L),
      nameStyle = "new_col"
    )
  )
 expect_true(all(cdm$cohort1a |>
    dplyr::pull("new_col") == 0L))

  mockDisconnect(cdm = cdm)
})

test_that("NA domain name", {
  skip_on_cran()
  cdm <- mockPatientProfiles(con = connection(), writeSchema = writeSchema())
  concept <- dplyr::tibble(
    concept_id = c(1125315),
    domain_id = NA_character_,
    concept_class_id = NA_character_,
    vocabulary_id = NA_character_,
    concept_code = NA_character_,
    valid_start_date = as.Date("1900-01-01"),
    valid_end_date = as.Date("2099-01-01"),
    invalid_reason = NA_character_
  ) %>%
    dplyr::mutate(concept_name = paste0("concept: ", .data$concept_id))
  cdm <- CDMConnector::insertTable(cdm, "concept", concept)

  expect_no_warning(result <- cdm$cohort1 %>%
    addConceptIntersectFlag(
      conceptSet = list("random2" = 1125315L)
    ) %>%
    dplyr::collect())

  expect_true(
    "random2_0_to_inf" %in%
      (result |>
        colnames())
  )
  mockDisconnect(cdm = cdm)
})

test_that("domain name not in cdm", {
  skip_on_cran()
  cdm <- mockPatientProfiles(con = connection(), writeSchema = writeSchema())
  concept <- dplyr::tibble(
    concept_id = c(1125315L),
    domain_id = "device",
    concept_class_id = NA_character_,
    vocabulary_id = NA_character_,
    concept_code = NA_character_,
    valid_start_date = as.Date("1900-01-01"),
    valid_end_date = as.Date("2099-01-01"),
    invalid_reason = NA_character_
  ) %>%
    dplyr::mutate(concept_name = paste0("concept: ", .data$concept_id))
  cdm <- CDMConnector::insertTable(cdm, "concept", concept)

  expect_no_warning(result <- cdm$cohort1 %>%
    addConceptIntersectFlag(
      conceptSet = list("random3" = 1125315L)
    ) %>%
    dplyr::collect())

  expect_true(
    "random3_0_to_inf" %in%
      (result |>
        colnames())
  )

  mockDisconnect(cdm = cdm)
})

test_that("missing event end date", {
  skip_on_cran()
  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 (!CDMConnector::eunomia_is_available()) {
    invisible(utils::capture.output(CDMConnector::downloadEunomiaData(pathToData = Sys.getenv("EUNOMIA_DATA_FOLDER"))))
  }
  con <- DBI::dbConnect(duckdb::duckdb(),
    dbdir = CDMConnector::eunomia_dir()
  )

  cohort <- dplyr::tibble(
    cohort_definition_id = 1L,
    subject_id = 273L,
    cohort_start_date = as.Date("2012-10-10"),
    cohort_end_date = as.Date("2013-10-10")
  )

  DBI::dbWriteTable(con, "cohort", cohort)
  cdm <- CDMConnector::cdm_from_con(con,
    cdm_schema = "main", write_schema = "main",
    cohort_tables = "cohort"
  )

  cdm <- cdm %>%
    CDMConnector::cdm_subset(person_id = 273L)


  expect_true(cdm$cohort %>%
    PatientProfiles::addConceptIntersectFlag(
      conceptSet = list(a = 192671L),
      window = c(-Inf, 0)
    ) |>
    dplyr::pull("a_minf_to_0") == 1)


  mockDisconnect(cdm)
})

test_that("records out of observation", {

  cdm <- mockPatientProfiles(con = connection(),
                             writeSchema = writeSchema())
  cdm <- omopgenerics::insertTable(
    cdm, "observation_period",
    table = data.frame(observation_period_id = 1L,
                       person_id = 1L,
                       observation_period_start_date = as.Date("2000-01-01"),
                       observation_period_end_date  = as.Date("2010-01-01"),
                       period_type_concept_id = 1L))
  cdm <- omopgenerics::insertTable(
    cdm, "my_cohort",
    table = data.frame(cohort_definition_id = 1L,
                       subject_id = 1L,
                       cohort_start_date = as.Date("2000-01-01"),
                       cohort_end_date = as.Date("2010-01-01")))
  # add a concept to put out of observation
  cdm <- omopgenerics::insertTable(cdm, "concept",
                            table = data.frame(concept_id = 99L,
                                               concept_name = "concept",
                                               domain_id = "condition",
                                               vocabulary_id = "test",
                                               concept_class_id = 1L,
                                               concept_code = 99L,
                                               valid_start_date = as.Date("1900-01-01"),
                                               valid_end_date = as.Date("2099-01-01")))

  cdm <- omopgenerics::insertTable(cdm, "condition_occurrence",
                                   table = data.frame(condition_occurrence_id = c(1L, 2L),
                                                      person_id = c(1L, 1L),
                                                      condition_concept_id = c(99L, 99L),
                                                      condition_start_date = c(as.Date("1990-01-01"),
                                                                               as.Date("1991-01-01")),
                                                      condition_end_date= c(as.Date("1990-01-01"),
                                                                            as.Date("1991-01-01")),
                                                      condition_type_concept_id = c(1L, 1L))
  )


  # default - record out of observation will be excluded
  cdm$my_cohort <- cdm$my_cohort |>
   addConceptIntersectFlag(conceptSet = list(a = 99L),
                           window = list(c(-Inf, Inf)),
                           inObservation = TRUE,
                           nameStyle = "intersect")
  expect_true(cdm$my_cohort |>
    dplyr::pull("intersect") == 0)

  # include records out of observation
  cdm$my_cohort <- cdm$my_cohort |>
    addConceptIntersectFlag(conceptSet = list(a = 99L),
                            window = list(c(-Inf, Inf)),
                            inObservation = FALSE,
                            nameStyle = "intersect")
  expect_true(cdm$my_cohort |>
                dplyr::pull("intersect") == 1)
  # not if outside of window
  cdm$my_cohort <- cdm$my_cohort |>
    addConceptIntersectFlag(conceptSet = list(a = 99L),
                            window = list(c(0, Inf)),
                            inObservation = FALSE,
                            nameStyle = "intersect")
  expect_true(cdm$my_cohort |>
                dplyr::pull("intersect") == 0)

expect_error(cdm$my_cohort |>
    addConceptIntersectFlag(conceptSet = list(a = 99L),
                            window = list(c(-Inf, Inf)),
                            inObservation = "not_logical", # should cause error
                            nameStyle = "intersect"))

  # count
  cdm$my_cohort <- cdm$my_cohort |>
    addConceptIntersectCount(conceptSet = list(a = 99L),
                            window = list(c(-Inf, Inf)),
                            inObservation = FALSE,
                            nameStyle = "intersect")
  expect_true(cdm$my_cohort |>
                dplyr::pull("intersect") == 2)

  # date
  cdm$my_cohort <- cdm$my_cohort |>
    addConceptIntersectDate(conceptSet = list(a = 99L),
                             window = list(c(-Inf, Inf)),
                             inObservation = FALSE,
                              order = "first",
                             nameStyle = "intersect")
  expect_true(cdm$my_cohort |>
                dplyr::pull("intersect") == "1990-01-01")

  cdm$my_cohort <- cdm$my_cohort |>
    addConceptIntersectDate(conceptSet = list(a = 99L),
                            window = list(c(-Inf, Inf)),
                            inObservation = FALSE,
                            order = "last",
                            nameStyle = "intersect")
  expect_true(cdm$my_cohort |>
                dplyr::pull("intersect") == "1991-01-01")

   # days
  cdm$my_cohort <- cdm$my_cohort |>
    addConceptIntersectDays(conceptSet = list(a = 99L),
                            window = list(c(-Inf, Inf)),
                            inObservation = FALSE,
                            order = "last",
                            nameStyle = "intersect")
  expect_true(cdm$my_cohort |>
                dplyr::pull("intersect") ==
                as.integer(difftime(as.Date("1991-01-01"),
                         as.Date("2000-01-01"))))

  cdm$my_cohort <- cdm$my_cohort |>
    addConceptIntersectDays(conceptSet = list(a = 99L),
                            window = list(c(-Inf, Inf)),
                            inObservation = FALSE,
                            order = "first",
                            nameStyle = "intersect")
  expect_true(cdm$my_cohort |>
                dplyr::pull("intersect") ==
                as.integer(difftime(as.Date("1990-01-01"),
                                    as.Date("2000-01-01"))))


})