From b7caa83396a2fc7971a65f36bd6e0506e0f6a2e9 Mon Sep 17 00:00:00 2001 From: jreps Date: Thu, 1 Aug 2024 09:56:50 -0400 Subject: [PATCH] CohortIncidence updates - updating test database for new CohortIncidence - fixing tests for new CohortIncidence --- extras/codeToCreateCharacterizationDatabase.R | 143 +++++++++++++----- tests/resources/cDatabase/databaseFile.sqlite | Bin 241664 -> 266240 bytes .../test-characterization-incidence.R | 16 +- 3 files changed, 108 insertions(+), 51 deletions(-) diff --git a/extras/codeToCreateCharacterizationDatabase.R b/extras/codeToCreateCharacterizationDatabase.R index e7f3a61..d8058cc 100644 --- a/extras/codeToCreateCharacterizationDatabase.R +++ b/extras/codeToCreateCharacterizationDatabase.R @@ -64,7 +64,7 @@ for(table in c('c_time_to_event', 'c_dechallenge_rechallenge', 'c_analysis_ref', 'c_covariate_ref', 'c_covariates', 'c_covariates_continuous', 'c_settings', 'c_cohort_details', 'c_cohort_counts')){ - sql <- "UPDATE main.@tbl SET database_id = '85642205.0';" + sql <- "UPDATE main.@tbl SET database_id = '85642205';" sql <- SqlRender::render(sql, tbl = table) DatabaseConnector::executeSql(con, sql) } @@ -87,7 +87,7 @@ Characterization::insertResultsToDatabase( if(F){ # add in rhe database_meta_data and cohort_definitions tables -serverDesc <- "tests/resources/charDatabase/databaseFile.sqlite" +serverDesc <- "tests/resources/cDatabase/databaseFile.sqlite" connectionDetailsDesc <- DatabaseConnector::createConnectionDetails( dbms = 'sqlite', server = serverDesc @@ -164,48 +164,107 @@ createTable = T, camelCaseToSnakeCase = F ) +} + + +# adding cohort incidence +##remotes::install_github('ohdsi/CohortIncidence') +serverDesc <- "tests/resources/cDatabase/databaseFile.sqlite" +connectionDetailsDesc <- DatabaseConnector::createConnectionDetails( + dbms = 'sqlite', + server = serverDesc +) +ddlPrefix <- SqlRender::render( + sql = CohortIncidence::getResultsDdl(), + "schemaName.incidence_summary" = "main.i_incidence_summary", + "schemaName.target_def" = 'main.i_target_def', + "schemaName.outcome_def" = 'main.i_outcome_def', + "schemaName.tar_def" = 'main.i_tar_def', + "schemaName.subgroup_def" = 'main.i_subgroup_def', + "schemaName.age_group_def" = 'main.i_age_group_def' + ) +con <- DatabaseConnector::connect(connectionDetailsDesc) +DatabaseConnector::executeSql(con, sql = ddlPrefix) +DatabaseConnector::disconnect(con) + +t1 <- CohortIncidence::createCohortRef(id=1, name="Target cohort 1") + +o1 <- CohortIncidence::createOutcomeDef(id=1,name="Outcome 3, 30d Clean", + cohortId =3, + cleanWindow =30) + +tar1 <- CohortIncidence::createTimeAtRiskDef(id=1, + startWith="start", + endWith="end", + endOffset=30) + +# Note: c() is used when dealing with an array of numbers, +# later we use list() when dealing with an array of objects +analysis1 <- CohortIncidence::createIncidenceAnalysis(targets = c(t1$id), + outcomes = c(o1$id), + tars = c(tar1$id)) + +subgroup1 <- CohortIncidence::createCohortSubgroup( + id=1, + name="Subgroup 1", + cohortRef = CohortIncidence::createCohortRef(id=300) + ) + + +# Create Design (note use of list() here): +irDesign <- CohortIncidence::createIncidenceDesign(targetDefs = list(t1), + outcomeDefs = list(o1), + tars=list(tar1), + analysisList = list(analysis1), + subgroups = list(subgroup1)) + +buildOptions <- CohortIncidence::buildOptions(cohortTable = "main.cohort", + cdmDatabaseSchema = "main", + sourceName = "eunomia", + refId = 1) + + +executeResults <- CohortIncidence::executeAnalysis(connectionDetails = connectionDetails, + incidenceDesign = irDesign, + buildOptions = buildOptions) -# add results to i_INCIDENCE_SUMMARY +# adding database +executeResults$incidence_summary$database_id <- 'eunomia' +# insert results DatabaseConnector::insertTable( - connection = connectionDesc, + connection = con, databaseSchema = 'main', - tableName = 'i_INCIDENCE_SUMMARY', - data.frame( - ref_id = 1, - DATABASE_ID = 'eunomia', - source_name = '', - target_cohort_definition_id = 1, - target_name = 'target 1', - tar_id = 1, - tar_start_with = 'start', - tar_start_offset = 0, - tar_end_with = 'end', - tar_end_offset = 0, - subgroup_id = 1, - subgroup_name = '', - outcome_id = 3, - outcome_cohort_definition_id = 3, - outcome_name = 'outcome 3', - clean_window = 0, - age_id = 1, - age_group_name = '', - gender_id = 1, - gender_name = '', - start_year = 1, - persons_at_risk_pe = 1, - persons_at_risk = 1, - person_days_pe = 1, - person_days = 1, - person_outcomes_pe = 1, - person_outcomes = 1, - outcomes_pe = 1, - outcomes = 1, - incidence_proportion_p100p = 0.1, - incidence_rate_p100py = 0.1 - ), - createTable = T, - camelCaseToSnakeCase = F + tableName = 'i_incidence_summary', + data = executeResults$incidence_summary + ) +DatabaseConnector::insertTable( + connection = con, + databaseSchema = 'main', + tableName = 'i_target_def', + data = executeResults$target_def +) +DatabaseConnector::insertTable( + connection = con, + databaseSchema = 'main', + tableName = 'i_outcome_def', + data = executeResults$outcome_def +) +DatabaseConnector::insertTable( + connection = con, + databaseSchema = 'main', + tableName = 'i_tar_def', + data = executeResults$tar_def +) +DatabaseConnector::insertTable( + connection = con, + databaseSchema = 'main', + tableName = 'i_age_group_def', + data = executeResults$age_group_def +) +DatabaseConnector::insertTable( + connection = con, + databaseSchema = 'main', + tableName = 'i_subgroup_def', + data = executeResults$subgroup_def ) - -} diff --git a/tests/resources/cDatabase/databaseFile.sqlite b/tests/resources/cDatabase/databaseFile.sqlite index fe336c21f12ea6cce6e1eccbfc5d63517f42c1ae..17914e9fa261dfcb3eb467a690e49e3e6a91b18c 100644 GIT binary patch delta 3189 zcmeHJ-*4MQ9JiCScHAaz*OjQWYmHcGq88LF>LyKPt($lyS{nz){UshQZsK-<=Es}_ z(I>CnCI(MH#NMXy2Ozju5T~^6I*hFBcl6`En_h&&rKLXE1y1o*3YbM%%r}r`V zn5{Yh31O%Qce&l8qF$^_Dt|ezl$fAl{|KWWL8RZ%=T2#?fluJ1lQ(jR35_wK@iY_O zkfq$9hdP6iu0@<)?0n08hpZAm6O-+CU5n89f=j)=>^Ev=>0j3jglOUth(o;fSu`nIG$6vRB>!-Du?zQ5*BHbS^Z{#iC0N8h4A96hQf0Idw2`7JZw{ zVH9t8j$>mGYb?SqSth|Phvya|T%^)*(Elog+4Vf3-%C;mCb~rE*dze@FLu9q_DwE`ctGOpt(QKiR`>Z2Sc-+@_ZR delta 889 zcmZozAkgrDZ-TU-31x{&RPFYTI4q*;XUPeZFAPIypz|NjpnwOuO znOKrol%86mU|0-fl%(dRFf-?umL%urrYacQ@0=%+*TDf`I zH|JfL%+C&T6vJGG$vh7v*!TpwjTz=n7BncIJoiEV-DxO@=Dg*WxOcqU3a!zVu9?(U3 zDf#6{PEAZtMKuQ`0C5YN0qH=er=kT8R18^VJur+R;Z>QMScGI#L26NPeqM2WVo7{a zW^s0W0WenJp^PSpArqgHSXqos3s?eKc|6#fcxWhK*8`J8(gzblwF4%Kq;T^3$5QG@ z{LH-M%#_qTU_vWOEJ=+oFf=eIsD#LKZT|S!iG6#;8|Dt?=H2hwcfVuYzWW`M>p=kH Cj2P(v diff --git a/tests/testthat/test-characterization-incidence.R b/tests/testthat/test-characterization-incidence.R index fb78f7c..28bcc86 100644 --- a/tests/testthat/test-characterization-incidence.R +++ b/tests/testthat/test-characterization-incidence.R @@ -24,11 +24,11 @@ shiny::testServer( # need to test generate in ns("input-selection") session$setInputs( outcomeIds = outcomes()[1], - databaseSelector = databases, - ageIds = ages, - sexIds = sex, - startYears = startYear[1], - tars = sortedTars[1] + databaseSelector = ciOptions$databases, + ageIds = c(1),#ciOptions$ages, + sexIds = ciOptions$sex, + startYears = ciOptions$startYear[1], + tars = ciOptions$sortedTars[1] ) # before generation the reactives should be NULL @@ -44,17 +44,15 @@ shiny::testServer( # when generate is true the reactives should be populated testthat::expect_true(!is.null(incidenceRateTarFilter())) testthat::expect_true(!is.null(incidenceRateCalendarFilter())) - testthat::expect_true(!is.null(incidenceRateAgeFilter())) + testthat::expect_true(!is.null(incidenceRateAgeFilter())) # fails testthat::expect_true(!is.null(incidenceRateGenderFilter())) testthat::expect_true(!is.null(incidenceRateDbFilter())) testthat::expect_true(!is.null(outcomeIds())) testthat::expect_true(outcomeIds() == outcomes()[1]) - testthat::expect_true(inherits(options, 'list')) - # should have results after generate - testthat::expect_true(!is.null(extractedData())) + testthat::expect_true(!is.null(extractedData())) # fails idata <- getIncidenceData(