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::eunomiaDir())
  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
      )
  )

  cdm$condition_occurrence <- NULL
  expect_no_error(
    cdm$my_cohort |>
      addConceptIntersectCount(
        conceptSet = list(concept1 = c(0L, 4294548L, 9201L))
      )
  )

  mockDisconnect(cdm = cdm)
})

test_that("conceptSetExpression", {
  skip_on_cran()
  skip_if_not_installed("omopgenerics", minimum_version = "1.1.0")
  con <- DBI::dbConnect(duckdb::duckdb(), CDMConnector::eunomiaDir())
  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",
    limit = "all",
    end = 0
  )

  # get as codelist
  codelist <- cdm$concept_ancestor |>
    dplyr::filter(.data$ancestor_concept_id == 1125315) |>
    dplyr::pull("descendant_concept_id") |>
    list() |>
    rlang::set_names("acetaminophen")
  conceptSetExpression <- list(
    acetaminophen = dplyr::tibble(
      concept_id = 1125315,
      descendants = TRUE,
      excluded = FALSE,
      mapped = FALSE
    )
  ) |>
    omopgenerics::newConceptSetExpression()

  # windows
  windows <- list(c(-Inf, -366), c(-365, -1), c(0, 0), c(1, 365), c(366, Inf))

  expect_no_error(
    x1 <- cdm$my_cohort |>
      addConceptIntersectCount(conceptSet = codelist, window = windows)
  )
  expect_no_error(
    x2 <- cdm$my_cohort |>
      addConceptIntersectCount(conceptSet = conceptSetExpression, window = windows)
  )
  prepareData <- function(x) {
    ord <- sort(colnames(x))
    x |>
      dplyr::collect() |>
      dplyr::select(dplyr::all_of(ord)) |>
      dplyr::arrange(dplyr::across(dplyr::all_of(ord)))
  }
  expect_identical(prepareData(x1), prepareData(x2))
})

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()
  con <- DBI::dbConnect(duckdb::duckdb(), dbdir = CDMConnector::eunomiaDir())

  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::cdmFromCon(
    con = con, cdmSchema = "main", writeSchema = "main", cohortTables = "cohort"
  )

  cdm <- cdm |>
    CDMConnector::cdmSubset(personId = 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"))))


})