tests/testthat/test-collectCodesetId.R

In OHDSI/Capr: Cohort Definition Application Programming

# test the listConceptSets() function

# Query, group

test_that("listConceptSets - Query", {
  conceptSets <- listConceptSets(conditionOccurrence(cs(1, name = "test")))
  expect_true(all(purrr::map_lgl(conceptSets, ~all(names(.) == c("id", "name", "expression")))))
})

test_that("listConceptSets - Criteria", {
  conceptSets <- listConceptSets(atLeast(1, conditionOccurrence(cs(1, name = "test"))))
  expect_true(all(purrr::map_lgl(conceptSets, ~all(names(.) == c("id", "name", "expression")))))
})

test_that("listConceptSets - Group", {
  g <- withAll(
    atLeast(1, conditionOccurrence(cs(1, name = "test"))),
    exactly(0, conditionOccurrence(cs(2, name = "test")))
  )
  conceptSets <- listConceptSets(g)
  expect_length(conceptSets, 2)
  expect_true(all(purrr::map_lgl(conceptSets, ~all(names(.) == c("id", "name", "expression")))))
})

test_that("listConceptSets - Entry", {
  e <- entry(withAll(
    atLeast(1, conditionOccurrence(cs(1, name = "test"))),
    exactly(0, conditionOccurrence(cs(2, name = "test")))
  ))
  conceptSets <- listConceptSets(e)
  expect_true(all(purrr::map_lgl(conceptSets, ~all(names(.) == c("id", "name", "expression")))))
})

test_that("listConceptSets - Attrition", {
  x <- attrition(withAll(
    atLeast(1, conditionOccurrence(cs(1, name = "test"))),
    exactly(0, conditionOccurrence(cs(2, name = "test")))
  ))

  conceptSets <- listConceptSets(x)
  expect_length(conceptSets, 2)
  expect_true(all(purrr::map_lgl(conceptSets, ~all(names(.) == c("id", "name", "expression")))))
})

test_that("listConceptSets - Attrition", {

  x <- attrition(
    'no t1d' = withAll(
      exactly(0,
              conditionOccurrence(cs(descendants(201254L), name = "test")),
              duringInterval(eventStarts(-Inf, -1))
      )
    ),
    'abnormal hba1c' = withAll(
      atLeast(1,
              measurement(
                cs(descendants(4184637L), name = "test"),
                valueAsNumber(lt(13)),
                unit(8713L)
              ),
              duringInterval(eventStarts(-Inf, -1))
      )
    )
  )

  conceptSets <- listConceptSets(x)
  expect_length(conceptSets, 2)
  expect_true(all(purrr::map_lgl(conceptSets, ~all(names(.) == c("id", "name", "expression")))))
})




test_that("listConceptSets - CohortExit", {
  e <- exit(drugExit(cs(1,2,5, name = "test")))
  expect_s4_class(e, "CohortExit")
  conceptSets <- listConceptSets(e)
  expect_length(conceptSets, 1)
  expect_true(all(purrr::map_lgl(conceptSets, ~all(names(.) == c("id", "name", "expression")))))
})

test_that("listConceptSets - Query with nested criteria", {
  x <- visit(cs(1, name = "test"),
             nestedWithAll(atLeast(1, conditionOccurrence(cs(9, name = "test"))),
                           atLeast(1, drugExposure(cs(1:5, name = "test")))))

  conceptSets <- listConceptSets(x)
  expect_length(conceptSets, 3)
  expect_true(all(purrr::map_lgl(conceptSets, ~all(names(.) == c("id", "name", "expression")))))
})

test_that("listConceptSets - Query with double nested criteria", {
  x <- visit(cs(1, name = "test"),
         nestedWithAll(
           atLeast(1, drugExposure(cs(21:24, name = "test"))),
           atLeast(1, conditionOccurrence(cs(9, name = "test"),
             nestedWithAll(atLeast(1, drugExposure(cs(11, name = "test"))))
      ))))

  conceptSets <- listConceptSets(x)
  expect_length(conceptSets, 4)
  expect_true(all(purrr::map_lgl(conceptSets, ~all(names(.) == c("id", "name", "expression")))))
})

test_that("listConceptSets - nested Query", {
  skip("failing test") # TODO fix listConceptSets so this passes

  # this works fine
  x <- visit(cs(descendants(9201, 9203, 262), name = "test"),
    nestedWithAll(
      atLeast(1,
        conditionOccurrence(cs(descendants(316139), name = "heart failure"),
          attributes = nestedWithAll(
            atLeast(1,
              conditionOccurrence(cs(descendants(316139), name = "heart failure"))
            )
          )
        )
      )
    )
  )


  conceptSets <- listConceptSets(x)
  expect_length(conceptSets, 3)
  expect_true(all(purrr::map_lgl(conceptSets, ~all(names(.) == c("id", "name", "expression")))))

  # this does not work
  x <- visit(cs(descendants(9201, 9203, 262), name = "test"),
    nestedWithAll(
      atLeast(1,
        conditionOccurrence(cs(descendants(316139), name = "heart failure"),
          attributes = list(male(), nestedWithAll(
            atLeast(1,
              conditionOccurrence(cs(descendants(316139), name = "heart failure"))
            )
          ))
        )
      )
    )
  )

  # str(a, max.level = 5) # I'm not sure if this Capr object is correct - attribute under attribute
  conceptSets <- listConceptSets(x) # error
  expect_true(all(purrr::map_lgl(conceptSets, ~all(names(.) == c("id", "name", "expression")))))
})


test_that("listConceptSets - Cohort", {

  cd <- cohort(
    entry = entry(
      conditionOccurrence(cs(descendants(201826L), name = "test"), male()),
      observationWindow = continuousObservation(365, 0)
    ),
    attrition = attrition(
      'no t1d' = withAll(
        exactly(0,
                conditionOccurrence(cs(descendants(201254L), name = "test")),
                duringInterval(eventStarts(-Inf, -1))
        )
      ),
      'abnormal hba1c' = withAll(
        atLeast(1,
                measurement(
                  cs(descendants(4184637L), name = "test"),
                  valueAsNumber(lt(13)),
                  unit(8713L)
                ),
                duringInterval(eventStarts(-Inf, -1))
        )
      )
    )
  )

  conceptSets <- listConceptSets(cd)
  expect_length(conceptSets, 3)
  expect_true(all(purrr::map_lgl(conceptSets, ~all(names(.) == c("id", "name", "expression")))))
})