test_that("Nesting Criteria works", { query <- visit(cs(descendants(9201, 9203, 262), name = "visit"), nestedWithAll( atLeast(1, conditionOccurrence(cs(descendants(316139), name = "heart failure")), duringInterval(startWindow = eventStarts(0, Inf), endWindow = eventStarts(-Inf, 0, index = "endDate") ) ) ) ) expect_s4_class(query@attributes[[1]], "nestedAttribute") query_list <- Capr:::as.list(query) expect_equal(names(query_list$VisitOccurrence)[2], "CorrelatedCriteria") l <- listConceptSets(query) expect_true(all(purrr::map_lgl(l, ~all(names(.) == c("id", "name", "expression"))))) }) test_that("Can build a cohort with nested attribute", { skip_if_not_installed("CirceR") cd <- cohort( entry = entry( visit(cs(descendants(9201, 9203, 262), name = "visit"), nestedWithAll( atLeast(1, conditionOccurrence(cs(descendants(316139), name = "heart failure")), duringInterval(startWindow = eventStarts(0, Inf), endWindow = eventStarts(-Inf, 0, index = "endDate") ) ) ) ), observationWindow = continuousObservation(0L, 0L), primaryCriteriaLimit = "First" ), exit = exit( endStrategy = fixedExit(index = "endDate", offsetDays = 1L) ), era = era(eraDays = 7L) ) cohortList <- toCirce(cd) expect_type(cohortList, "list") cohortJson <- jsonlite::toJSON(cohortList, pretty = T, auto_unbox = TRUE) %>% as.character() expect_type(cohortJson, "character") expect_true(nchar(cohortJson) > 1) sql <- CirceR::cohortExpressionFromJson(cohortJson) %>% CirceR::buildCohortQuery(options = CirceR::createGenerateOptions(generateStats = FALSE)) expect_type(sql, "character") expect_true(nchar(sql) > 1) # Test generatation # sql <- SqlRender::render(sql, # vocabulary_database_schema = "main", # cdm_database_schema = "main", # target_database_schema = "main", # target_cohort_id = "1", # target_cohort_table = "cohort", # results_database_schema = "main") # expect_length(stringr::str_extract_all(sql, "@\\w+")[[1]], 0) # Error in cohort sql translation for sqlite # sql <- SqlRender::translate(sql, "sqlite") # sql <- SqlRender::translate(sql, "duckdb") # con <- DBI::dbConnect(duckdb::duckdb(), Eunomia::eunomiaDir("GIBleed", dbms = "duckdb")) # requires development version of Eunomia # DBI::dbExecute(con, # "CREATE TABLE main.cohort ( # cohort_definition_id BIGINT, # subject_id BIGINT, # cohort_start_date DATE, # cohort_end_date DATE # );") # # SqlRender::splitSql(sql) %>% purrr::walk(~DBI::dbExecute(con, .)) # # df <- DBI::dbGetQuery(con, "select * from main.cohort") # # expect_s3_class(df, "data.frame") # DBI::dbDisconnect(con, shutdown = TRUE) }) test_that("Can build a cohort with nested groups", { skip_if_not_installed("CirceR") t2dDrug <- drugExposure(cs(descendants(1502809,1502826,1503297,1510202,1515249,1516766, 1525215,1529331,1530014,1547504,1559684,1560171, 1580747,1583722,1594973,1597756), name = "t2dDrug")) t2d <- conditionOccurrence(cs(descendants(201826), name = "t2d")) t1d <- conditionOccurrence(cs(descendants(201254), name = "t1d")) t1DrugCs <- cs(descendants(1502905,1513876,1516976,1517998, 1531601,1544838,1550023,1567198), name = "t1Drug") t1dDrug <- drugExposure(t1DrugCs) t1dDrugWT2Drug <- drugExposure(t1DrugCs, nestedWithAll( atLeast(1, t2dDrug, duringInterval(startWindow = eventStarts(-Inf, -1)) ) ) ) abLabFast <- measurement(cs(descendants(3037110), name = "abLabFast"), valueAsNumber(gte(125))) abLabHb <- measurement(cs(descendants(3003309,3004410,3005673,3007263), name = "abLabHb"), valueAsNumber(gte(6))) abLabRan <- measurement(cs(descendants(3000483,3004501), name = "abLabRan"), valueAsNumber(gte(200))) cd <- cohort( entry = entry( t2d, t2dDrug, abLabHb, abLabRan, abLabFast, observationWindow = continuousObservation(0L, 0L), primaryCriteriaLimit = "All", additionalCriteria = withAll( exactly(0, t1d, duringInterval(startWindow = eventStarts(-Inf, 0))) ), qualifiedLimit = "First" ), attrition = attrition( 't2dAlgo' = withAny( # Path 1 withAll( exactly(0, t2d, duringInterval(startWindow = eventStarts(-Inf, 0))), atLeast(1, t2dDrug, duringInterval(startWindow = eventStarts(-Inf, 0))), withAny( atLeast(1, abLabHb, duringInterval(startWindow = eventStarts(-Inf, 0))), atLeast(1, abLabRan, duringInterval(startWindow = eventStarts(-Inf, 0))), atLeast(1, abLabFast, duringInterval(startWindow = eventStarts(-Inf, 0))) ) ), #Path 2 withAll( atLeast(1, t2d, duringInterval(startWindow = eventStarts(-Inf, 0))), exactly(0, t1dDrug, duringInterval(startWindow = eventStarts(-Inf, 0))), exactly(0, t2dDrug, duringInterval(startWindow = eventStarts(-Inf, 0))), withAny( atLeast(1, abLabHb, duringInterval(startWindow = eventStarts(-Inf, 0))), atLeast(1, abLabRan, duringInterval(startWindow = eventStarts(-Inf, 0))), atLeast(1, abLabFast, duringInterval(startWindow = eventStarts(-Inf, 0))) ) ), #Path 3 withAll( atLeast(1, t2d, duringInterval(startWindow = eventStarts(-Inf, 0))), exactly(0, t1dDrug, duringInterval(startWindow = eventStarts(-Inf, 0))), atLeast(1, t2dDrug, duringInterval(startWindow = eventStarts(-Inf, 0))) ), #Path 4 withAll( atLeast(1, t2d, duringInterval(startWindow = eventStarts(-Inf, 0))), atLeast(1, t1dDrug, duringInterval(startWindow = eventStarts(-Inf, 0))), atLeast(1, t1dDrugWT2Drug, duringInterval(startWindow = eventStarts(-Inf, 0))) ), #Path 5 withAll( atLeast(1, t2d, duringInterval(startWindow = eventStarts(-Inf, 0))), atLeast(1, t1dDrug, duringInterval(startWindow = eventStarts(-Inf, 0))), exactly(0, t2dDrug, duringInterval(startWindow = eventStarts(-Inf, 0))), atLeast(2, t2d, duringInterval(startWindow = eventStarts(-Inf, 0))) ) ) ), exit = exit( endStrategy = observationExit(), censor = censoringEvents(t1d) ) ) expect_s4_class(cd, "Cohort") cohortList <- toCirce(cd) expect_type(cohortList, "list") cohortJson <- jsonlite::toJSON(cohortList, pretty = T, auto_unbox = TRUE) %>% as.character() expect_type(cohortJson, "character") expect_true(nchar(cohortJson) > 1) sql <- CirceR::cohortExpressionFromJson(cohortJson) %>% CirceR::buildCohortQuery(options = CirceR::createGenerateOptions(generateStats = FALSE)) expect_type(sql, "character") expect_true(nchar(sql) > 1) }) test_that("listConceptSets works with nested Query", { a <- visit(cs(descendants(9201, 9203, 262), name = "visit"), nestedWithAll( atLeast(1, conditionOccurrence(cs(descendants(316139), name = "heart failure")) ) ) ) conceptSets <- listConceptSets(a) expect_true(all(purrr::map_lgl(conceptSets, ~all(names(.) == c("id", "name", "expression"))))) }) # extra code for generation # sql <- CirceR::cohortExpressionFromJson(cohortJson) %>% # CirceR::buildCohortQuery(options = CirceR::createGenerateOptions(generateStats = FALSE)) # # expect_type(sql, "character") # expect_true(nchar(sql) > 1) # # sql <- SqlRender::render(sql, # vocabulary_database_schema = "main", # cdm_database_schema = "main", # target_database_schema = "main", # target_cohort_id = "1", # target_cohort_table = "cohort", # results_database_schema = "main") # # expect_length(stringr::str_extract_all(sql, "@\\w+")[[1]], 0) # # # Error in cohort sql translation for sqlite # # sql <- SqlRender::translate(sql, "sqlite") # # sql <- SqlRender::translate(sql, "duckdb") # # con <- DBI::dbConnect(duckdb::duckdb(), Eunomia::eunomiaDir("GIBleed", dbms = "duckdb")) # requires development version of Eunomia # # DBI::dbExecute(con, # "CREATE TABLE main.cohort ( # cohort_definition_id BIGINT, # subject_id BIGINT, # cohort_start_date DATE, # cohort_end_date DATE # );") # # SqlRender::splitSql(sql) %>% purrr::walk(~DBI::dbExecute(con, .)) # # df <- DBI::dbGetQuery(con, "select * from main.cohort") # # expect_s3_class(df, "data.frame") # DBI::dbDisconnect(con, shutdown = TRUE)