From fd927c2141c5f64f64bbb84cb4bac20a14963fcf Mon Sep 17 00:00:00 2001 From: Admin_mschuemi Date: Thu, 12 Jan 2023 03:33:59 -0500 Subject: [PATCH 1/8] Minor fixes --- R/Database.R | 3 ++- R/DechallengeRechallenge.R | 4 ++-- R/HelperFunctions.R | 9 +++++++++ R/RunCharacterization.R | 2 +- R/TimeToEvent.R | 2 +- tests/testthat/test-runCharacterization.R | 3 ++- 6 files changed, 17 insertions(+), 6 deletions(-) diff --git a/R/Database.R b/R/Database.R index 9bba302..64d5946 100644 --- a/R/Database.R +++ b/R/Database.R @@ -306,7 +306,8 @@ getResultTables <- function(){ 'settings', 'resultsDataModelSpecification.csv', package = 'Characterization' - ) + ), + show_col_types = FALSE )$table_name ) ) diff --git a/R/DechallengeRechallenge.R b/R/DechallengeRechallenge.R index 5159c68..2858411 100644 --- a/R/DechallengeRechallenge.R +++ b/R/DechallengeRechallenge.R @@ -84,7 +84,7 @@ computeDechallengeRechallengeAnalyses <- function( # check inputs errorMessages <- checkmate::makeAssertCollection() - .checkConnectionDetails(connectionDetails) + .checkConnectionDetails(connectionDetails, errorMessages) .checkCohortDetails( cohortDatabaseSchema = targetDatabaseSchema, cohortTable = targetTable, @@ -215,7 +215,7 @@ computeRechallengeFailCaseSeriesAnalyses <- function( # check inputs errorMessages <- checkmate::makeAssertCollection() - .checkConnectionDetails(connectionDetails) + .checkConnectionDetails(connectionDetails, errorMessages) .checkCohortDetails( cohortDatabaseSchema = targetDatabaseSchema, cohortTable = targetTable, diff --git a/R/HelperFunctions.R b/R/HelperFunctions.R index 5dd9ed8..cddab3d 100644 --- a/R/HelperFunctions.R +++ b/R/HelperFunctions.R @@ -29,11 +29,20 @@ connectionDetails, errorMessages ) { + if (is(connectionDetails, "connectionDetails")) { checkmate::assertClass( x = connectionDetails, classes = "connectionDetails", add = errorMessages ) + } else { + checkmate::assertClass( + x = connectionDetails, + classes = "ConnectionDetails", + add = errorMessages + ) + + } } .checkDechallengeRechallengeSettings <- function( diff --git a/R/RunCharacterization.R b/R/RunCharacterization.R index 7408111..4ce2889 100644 --- a/R/RunCharacterization.R +++ b/R/RunCharacterization.R @@ -79,7 +79,7 @@ saveCharacterizationSettings <- function( fileName = fileName ) - return(fileName) + invisible(fileName) } #' Load the characterization settings previously saved as a json file diff --git a/R/TimeToEvent.R b/R/TimeToEvent.R index b86ae48..3c9d7b9 100644 --- a/R/TimeToEvent.R +++ b/R/TimeToEvent.R @@ -82,7 +82,7 @@ computeTimeToEventAnalyses <- function( # check inputs errorMessages <- checkmate::makeAssertCollection() - .checkConnectionDetails(connectionDetails) + .checkConnectionDetails(connectionDetails, errorMessages) .checkCohortDetails( cohortDatabaseSchema = targetDatabaseSchema, cohortTable = targetTable, diff --git a/tests/testthat/test-runCharacterization.R b/tests/testthat/test-runCharacterization.R index c5c4dbb..f502702 100644 --- a/tests/testthat/test-runCharacterization.R +++ b/tests/testthat/test-runCharacterization.R @@ -126,7 +126,8 @@ test_that("runCharacterizationAnalyses", { file.exists(file.path(tempFolder, "tracker.csv")) ) tracker <- readr::read_csv( - file = file.path(tempFolder, "tracker.csv") + file = file.path(tempFolder, "tracker.csv"), + show_col_types = FALSE ) testthat::expect_equal(nrow(tracker), 6) From 6bb8b180625c92a496f3a5116fac1668f4a04ecf Mon Sep 17 00:00:00 2001 From: jreps Date: Thu, 12 Jan 2023 08:57:00 -0500 Subject: [PATCH 2/8] bug fixes - changing .sql to .sqlite - fixing tracker appending --- R/Database.R | 2 +- R/RunCharacterization.R | 9 ++++----- 2 files changed, 5 insertions(+), 6 deletions(-) diff --git a/R/Database.R b/R/Database.R index 9bba302..5f6ecd6 100644 --- a/R/Database.R +++ b/R/Database.R @@ -47,7 +47,7 @@ createSqliteDatabase <- function( connectionDetails <- DatabaseConnector::createConnectionDetails( dbms = 'sqlite', - server = file.path(sqliteLocation, 'sqlite.sql') + server = file.path(sqliteLocation, 'sqlite.sqlite') ) connection <- DatabaseConnector::connect( connectionDetails = connectionDetails diff --git a/R/RunCharacterization.R b/R/RunCharacterization.R index 7408111..e5c3696 100644 --- a/R/RunCharacterization.R +++ b/R/RunCharacterization.R @@ -190,7 +190,6 @@ runCharacterizationAnalyses <- function( databaseId = databaseId ) - append <- file.exists(file.path(saveDirectory, "tracker.csv")) # log that run was successful readr::write_csv( @@ -201,7 +200,7 @@ runCharacterizationAnalyses <- function( date_time = as.character(Sys.time()) ), file = file.path(saveDirectory, "tracker.csv"), - append = append + append = file.exists(file.path(saveDirectory, "tracker.csv")) ) insertAndromedaToDatabase( @@ -247,7 +246,7 @@ runCharacterizationAnalyses <- function( date_time = as.character(Sys.time()) ), file = file.path(saveDirectory, "tracker.csv"), - append = append + append = file.exists(file.path(saveDirectory, "tracker.csv")) ) insertAndromedaToDatabase( @@ -292,7 +291,7 @@ runCharacterizationAnalyses <- function( date_time = as.character(Sys.time()) ), file = file.path(saveDirectory, "tracker.csv"), - append = append + append = file.exists(file.path(saveDirectory, "tracker.csv")) ) insertAndromedaToDatabase( @@ -342,7 +341,7 @@ runCharacterizationAnalyses <- function( date_time = as.character(Sys.time()) ), file = file.path(saveDirectory, "tracker.csv"), - append = append + append = file.exists(file.path(saveDirectory, "tracker.csv")) ) insertAndromedaToDatabase( From 8d9829d93f5e9ebf5a3fd0893e1aff37caa0d48a Mon Sep 17 00:00:00 2001 From: jreps Date: Thu, 12 Jan 2023 13:08:57 -0500 Subject: [PATCH 3/8] updating the way cohort definition ids are created - updating the way cohort definition ids are created in aggregate covariates. --- DESCRIPTION | 4 +- R/AggregateCovariates.R | 106 +++++------- R/Database.R | 2 + R/RunCharacterization.R | 76 ++++++--- R/SaveLoad.R | 69 +++++++- .../resultsDataModelSpecification.csv | 12 +- .../sql/sql_server/DropAggregateCovariate.sql | 3 + inst/sql/sql_server/ResultTables.sql | 10 +- .../createTargetOutcomeCombinations.sql | 161 +++++++++++++----- tests/testthat/test-aggregateCovariate.R | 16 +- tests/testthat/test-runCharacterization.R | 26 ++- 11 files changed, 335 insertions(+), 150 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index ddfccce..57de4fe 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Package: Characterization Type: Package Title: Characterizations of Cohorts -Version: 0.0.4 -Date: 2022-12-14 +Version: 0.0.5 +Date: 2023-01-12 Authors@R: c( person("Jenna", "Reps", , "reps@ohdsi.org", role = c("aut", "cre")), person("Patrick", "Ryan", , "ryan@ohdsi.org", role = c("aut")) diff --git a/R/AggregateCovariates.R b/R/AggregateCovariates.R index 1df8b2b..725beb0 100644 --- a/R/AggregateCovariates.R +++ b/R/AggregateCovariates.R @@ -35,11 +35,25 @@ createAggregateCovariateSettings <- function( covariateSettings ){ - # check cohortIds is a vector of int/double - + errorMessages <- checkmate::makeAssertCollection() + # check targetIds is a vector of int/double + .checkCohortIds( + cohortIds = targetIds, + type = 'target', + errorMessages = errorMessages + ) # check outcomeIds is a vector of int/double + .checkCohortIds( + cohortIds = outcomeIds, + type = 'outcome', + errorMessages = errorMessages + ) + + # TODO check TAR - #check TAR + # TODO check covariateSettings + + checkmate::reportAssertions(errorMessages) # create list result <- list( @@ -86,6 +100,7 @@ computeAggregateCovariateAnalyses <- function( ) { # check inputs + start <- Sys.time() connection <- DatabaseConnector::connect( @@ -150,64 +165,28 @@ computeAggregateCovariateAnalyses <- function( ) } - # settings: - # run_id, database_id, covariate_setting_json, - # riskWindowStart, startAnchor, riskWindowEnd, endAnchor - # combined_cohort_id, target_cohort_id, outcome_cohort_id, - # type - +# cohort details: - result$settings <- DatabaseConnector::querySql( + result$cohortDetails <- DatabaseConnector::querySql( connection = connection, sql = SqlRender::translate( - sql = " - select distinct - cohort_definition_id as combined_cohort_id, - target_id as target_cohort_id, - outcome_id as outcome_cohort_id, - cohort_type - from #target_with_outcome - - union - - select distinct - cohort_definition_id as combined_cohort_id, - target_id as target_cohort_id, - outcome_id as outcome_cohort_id, - cohort_type - from #target_nooutcome - - union - - select distinct - cohort_definition_id + 2 as combined_cohort_id, - target_id as target_cohort_id, - outcome_id as outcome_cohort_id, - 'OnT' as cohort_type - from #target_with_outcome - - union - - select distinct - cohort_definition_id*100000 as combined_cohort_id, - cohort_definition_id as target_cohort_id, - 0 as outcome_cohort_id, - 'T' as cohort_type - from #targets_agg - - union - - select distinct - cohort_definition_id*100000 as combined_cohort_id, - 0 as target_cohort_id, - cohort_definition_id as outcome_cohort_id, - 'O' as cohort_type - from #outcomes_agg - ;", + sql = " select * from #cohort_details;", targetDialect = connectionDetails$dbms ), snakeCaseToCamelCase = T - ) + ) %>% + dplyr::mutate( + runId = !!runId, + databaseId = !!databaseId + ) %>% + dplyr::relocate( + "databaseId", + "runId" + ) + + # settings: + # run_id, database_id, covariate_setting_json, + # riskWindowStart, startAnchor, riskWindowEnd, endAnchor covariateSettingsJson <- as.character( ParallelLogger::convertSettingsToJson( @@ -215,15 +194,14 @@ computeAggregateCovariateAnalyses <- function( ) ) - result$settings <- result$settings %>% - dplyr::mutate( - runId = !!runId, - databaseId = !!databaseId, - covariateSettingJson = !!covariateSettingsJson, - riskWindowStart = !!aggregateCovariateSettings$riskWindowStart, - startAnchor = !!aggregateCovariateSettings$startAnchor, - riskWindowEnd = !!aggregateCovariateSettings$riskWindowEnd , - endAnchor = !!aggregateCovariateSettings$endAnchor + result$settings <- data.frame( + runId = runId, + databaseId = databaseId, + covariateSettingJson = covariateSettingsJson, + riskWindowStart = aggregateCovariateSettings$riskWindowStart, + startAnchor = aggregateCovariateSettings$startAnchor, + riskWindowEnd = aggregateCovariateSettings$riskWindowEnd , + endAnchor = aggregateCovariateSettings$endAnchor ) sql <- SqlRender::loadRenderTranslateSql( diff --git a/R/Database.R b/R/Database.R index 89fe085..520b95e 100644 --- a/R/Database.R +++ b/R/Database.R @@ -202,6 +202,8 @@ createCharacterizationTables <- function( connection = conn, sql = renderedSql ) + + # add database migration here in the future } } diff --git a/R/RunCharacterization.R b/R/RunCharacterization.R index fb69e38..df98e3c 100644 --- a/R/RunCharacterization.R +++ b/R/RunCharacterization.R @@ -177,39 +177,51 @@ runCharacterizationAnalyses <- function( if (!is.null(characterizationSettings$timeToEventSettings)) { for (i in 1:length(characterizationSettings$timeToEventSettings)) { + message("Running time to event analysis ", i) - result <- computeTimeToEventAnalyses( - connectionDetails = connectionDetails, - targetDatabaseSchema = targetDatabaseSchema, - targetTable = targetTable, - outcomeDatabaseSchema = outcomeDatabaseSchema, - outcomeTable = outcomeTable, - tempEmulationSchema = tempEmulationSchema, - cdmDatabaseSchema = cdmDatabaseSchema, - timeToEventSettings = characterizationSettings$timeToEventSettings[[i]], - databaseId = databaseId + + result <- tryCatch( + { + computeTimeToEventAnalyses( + connectionDetails = connectionDetails, + targetDatabaseSchema = targetDatabaseSchema, + targetTable = targetTable, + outcomeDatabaseSchema = outcomeDatabaseSchema, + outcomeTable = outcomeTable, + tempEmulationSchema = tempEmulationSchema, + cdmDatabaseSchema = cdmDatabaseSchema, + timeToEventSettings = characterizationSettings$timeToEventSettings[[i]], + databaseId = databaseId + ) + }, + error = function(e) { + message(e); + return(NULL) + } ) + if (!is.null(result)) { + # log that run was sucessful + readr::write_csv( + x = data.frame( + analysis_type = "timeToEvent", + run_id = i, + database_id = databaseId, + date_time = as.character(Sys.time()) + ), + file = file.path(saveDirectory, "tracker.csv"), + append = file.exists(file.path(saveDirectory, "tracker.csv")) + ) - # log that run was successful - readr::write_csv( - x = data.frame( - analysis_type = "timeToEvent", - run_id = i, - database_id = databaseId, - date_time = as.character(Sys.time()) - ), - file = file.path(saveDirectory, "tracker.csv"), - append = file.exists(file.path(saveDirectory, "tracker.csv")) - ) + insertAndromedaToDatabase( + connection = conn, + databaseSchema = "main", + tableName = "time_to_event", + andromedaObject = result$timeToEvent, + tablePrefix = tablePrefix + ) + } - insertAndromedaToDatabase( - connection = conn, - databaseSchema = "main", - tableName = "time_to_event", - andromedaObject = result$timeToEvent, - tablePrefix = tablePrefix - ) } } @@ -352,6 +364,14 @@ runCharacterizationAnalyses <- function( tablePrefix = tablePrefix ) + insertAndromedaToDatabase( + connection = conn, + databaseSchema = "main", + tableName = "cohort_details", + andromedaObject = result$cohortDetails, + tablePrefix = tablePrefix + ) + insertAndromedaToDatabase( connection = conn, databaseSchema = "main", diff --git a/R/SaveLoad.R b/R/SaveLoad.R index b089e56..73b5ca6 100644 --- a/R/SaveLoad.R +++ b/R/SaveLoad.R @@ -372,6 +372,72 @@ exportAggregateCovariateToCsv <- function( dir.create(saveDirectory, recursive = T) } + # settings + Andromeda::batchApply( + tbl = result$settings, + fun = function(x) { + + append <- file.exists( + file.path( + saveDirectory, + "settings.csv" + ) + ) + + dat <- as.data.frame( + x %>% + dplyr::collect() + ) + + colnames(dat) <- SqlRender::camelCaseToSnakeCase( + string = colnames(dat) + ) + + readr::write_csv( + x = dat, + file = file.path( + saveDirectory, + "settings.csv" + ), + append = append + ) + + } + ) + + # cohort details + Andromeda::batchApply( + tbl = result$cohortDetails, + fun = function(x) { + + append <- file.exists( + file.path( + saveDirectory, + "cohort_details.csv" + ) + ) + + dat <- as.data.frame( + x %>% + dplyr::collect() + ) + + colnames(dat) <- SqlRender::camelCaseToSnakeCase( + string = colnames(dat) + ) + + readr::write_csv( + x = dat, + file = file.path( + saveDirectory, + "cohort_details.csv" + ), + append = append + ) + + } + ) + # analysisRef Andromeda::batchApply( tbl = result$analysisRef, @@ -506,7 +572,8 @@ exportAggregateCovariateToCsv <- function( invisible( file.path( saveDirectory, - c( + c("cohort_details.csv", + "settings.csv", "analysis_ref.csv", "covariate_ref.csv", "covariates.csv", diff --git a/inst/settings/resultsDataModelSpecification.csv b/inst/settings/resultsDataModelSpecification.csv index 2e5459a..721940e 100644 --- a/inst/settings/resultsDataModelSpecification.csv +++ b/inst/settings/resultsDataModelSpecification.csv @@ -82,11 +82,13 @@ covariates_continuous,p_90_value,float,Y,N,N,N,N,The 90th percentile settings,run_id,int,Y,Y,N,N,N,The run identifier settings,database_id,varchar(100),Y,Y,N,N,N,The database identifier settings,covariate_setting_json,varchar(max),Y,N,N,N,N,The covariate settings JSON -settings,combined_cohort_id,int,Y,N,N,N,N,The combined cohort id -settings,cohort_type,varchar(10),Y,N,N,N,N,The cohort type -settings,target_cohort_id,int,Y,N,N,N,N,The target cohort id -settings,outcome_cohort_id,int,Y,N,N,N,N,The outcome cohort id settings,risk_window_start,int,Y,N,N,N,N,The risk window start settings,risk_window_end,int,Y,N,N,N,N,The risk window end settings,start_anchor,varchar(15),Y,N,N,N,N,The start anchor -settings,end_anchor,varchar(15),Y,N,N,N,N,The end anchor \ No newline at end of file +settings,end_anchor,varchar(15),Y,N,N,N,N,The end anchor +cohort_details,run_id,int,Y,Y,N,N,N,The run identifier +cohort_details,database_id,varchar(100),Y,Y,N,N,N,The database identifier +cohort_details,cohort_definition_id,int,Y,N,N,N,N,The study cohort id +cohort_details,cohort_type,varchar(10),Y,N,N,N,N,The cohort type +cohort_details,target_cohort_id,int,Y,N,N,N,N,The target cohort id +cohort_details,outcome_cohort_id,int,Y,N,N,N,N,The outcome cohort id diff --git a/inst/sql/sql_server/DropAggregateCovariate.sql b/inst/sql/sql_server/DropAggregateCovariate.sql index 6407945..fb46e83 100644 --- a/inst/sql/sql_server/DropAggregateCovariate.sql +++ b/inst/sql/sql_server/DropAggregateCovariate.sql @@ -6,6 +6,9 @@ DROP TABLE #targets_agg; TRUNCATE TABLE #outcomes_agg; DROP TABLE #outcomes_agg; +TRUNCATE TABLE #cohort_details; +DROP TABLE #cohort_details; + TRUNCATE TABLE #target_with_outcome; DROP TABLE #target_with_outcome; diff --git a/inst/sql/sql_server/ResultTables.sql b/inst/sql/sql_server/ResultTables.sql index 344536c..95f47ae 100644 --- a/inst/sql/sql_server/ResultTables.sql +++ b/inst/sql/sql_server/ResultTables.sql @@ -62,8 +62,14 @@ CREATE TABLE @my_schema.@table_prefixsettings ( risk_window_start int, start_anchor varchar(15), risk_window_end int, - end_anchor varchar(15), - combined_cohort_id int, + end_anchor varchar(15) +); + +-- added this table +CREATE TABLE @my_schema.@table_prefixcohort_details ( + run_id int NOT NULL, + database_id varchar(100), + cohort_definition_id int, target_cohort_id int, outcome_cohort_id int, cohort_type varchar(10) diff --git a/inst/sql/sql_server/createTargetOutcomeCombinations.sql b/inst/sql/sql_server/createTargetOutcomeCombinations.sql index 9d59169..c354232 100644 --- a/inst/sql/sql_server/createTargetOutcomeCombinations.sql +++ b/inst/sql/sql_server/createTargetOutcomeCombinations.sql @@ -1,31 +1,89 @@ --need to know indication/target/outcome tuples +drop table if exists #targets_agg; select * into #targets_agg from @target_database_schema.@target_table where cohort_definition_id in (@target_ids); +drop table if exists #outcomes_agg; select * into #outcomes_agg from @outcome_database_schema.@outcome_table where cohort_definition_id in (@outcome_ids); +-- create all the cohort details +drop table if exists #cohort_details; + +select *, +ROW_NUMBER() OVER (ORDER BY cohort_type, target_cohort_id, outcome_cohort_id) as cohort_definition_id +into #cohort_details +from + +( +select distinct +t.cohort_definition_id as target_cohort_id, +o.cohort_definition_id as outcome_cohort_id, +'TnO' as cohort_type +from +(select distinct cohort_definition_id from #targets_agg) as t +CROSS JOIN +(select distinct cohort_definition_id from #outcomes_agg) as o + +union + +select distinct +t.cohort_definition_id as target_cohort_id, +o.cohort_definition_id as outcome_cohort_id, +'OnT' as cohort_type +from +(select distinct cohort_definition_id from #targets_agg) as t +CROSS JOIN +(select distinct cohort_definition_id from #outcomes_agg) as o + +union + +select distinct +t.cohort_definition_id as target_cohort_id, +o.cohort_definition_id as outcome_cohort_id, +'TnOc' as cohort_type +from +(select distinct cohort_definition_id from #targets_agg) as t +CROSS JOIN +(select distinct cohort_definition_id from #outcomes_agg) as o + +union + +select distinct +t.cohort_definition_id as target_cohort_id, +0 as outcome_cohort_id, +'T' as cohort_type +from (select distinct cohort_definition_id from #targets_agg) as t + +union + +select distinct +0 as target_cohort_id, +o.cohort_definition_id as outcome_cohort_id, +'O' as cohort_type +from (select distinct cohort_definition_id from #outcomes_agg) as o + +) temp; + -- 1) get all the people with the outcome in TAR +drop table if exists #target_with_outcome; + +-- TnO select t.subject_id, t.cohort_start_date, t.cohort_end_date, o.cohort_start_date as outcome_start_date, o.cohort_end_date as outcome_end_date, -t.cohort_definition_id as target_id, -o.cohort_definition_id as outcome_id, -'TnO' as cohort_type, -t.cohort_definition_id*100000 + -o.cohort_definition_id*10 + -- use row_number of o? -1 as cohort_definition_id +t.cohort_definition_id as target_cohort_id, +o.cohort_definition_id as outcome_cohort_id into #target_with_outcome -from -#targets_agg t inner join #outcomes_agg o +from #targets_agg t inner join #outcomes_agg o on t.subject_id = o.subject_id where -- outcome starts before TAR end @@ -37,25 +95,20 @@ o.cohort_start_date >= dateadd(day, @tar_start, t.@tar_start_anchor); -- 2) get all the people without the outcome in TAR drop table if exists #target_nooutcome; -create table #target_nooutcome as select t.subject_id, t.cohort_start_date, t.cohort_end_date, -t.cohort_definition_id as target_id, -o.outcome_id as outcome_id, -'TnOc' as cohort_type, -t.cohort_definition_id*100000 + -o.outcome_id*10 + -2 as cohort_definition_id -from -#targets_agg t +t.cohort_definition_id as target_cohort_id, +o.cohort_definition_id as outcome_cohort_id +into #target_nooutcome +from #targets_agg t CROSS JOIN -( select distinct cohort_definition_id as outcome_id from #outcomes_agg) o +( select distinct cohort_definition_id from #outcomes_agg) o left outer join #target_with_outcome two -on t.cohort_definition_id = two.target_id +on t.cohort_definition_id = two.target_cohort_id and t.subject_id = two.subject_id -and o.outcome_id = two.outcome_id +and o.cohort_definition_id = two.outcome_cohort_id where two.subject_id IS NULL; -- Final: select into #agg_cohorts @@ -67,33 +120,45 @@ from -- T with O indexed at T select -subject_id, -cohort_start_date, -cohort_end_date, -cohort_definition_id -- ends in 1 -from #target_with_outcome +tno.subject_id, +tno.cohort_start_date, +tno.cohort_end_date, +cd.cohort_definition_id +from #target_with_outcome tno +INNER JOIN #cohort_details cd +on cd.target_cohort_id = tno.target_cohort_id +and cd.outcome_cohort_id = tno.outcome_cohort_id +and cd.cohort_type = 'TnO' union -- T with O indexed at O select -subject_id, -outcome_start_date as cohort_start_date, -outcome_end_date as cohort_end_date, -cohort_definition_id + 2 -- making it end in 3 -from #target_with_outcome +tno.subject_id, +tno.outcome_start_date as cohort_start_date, +tno.outcome_end_date as cohort_end_date, +cd.cohort_definition_id +from #target_with_outcome tno +INNER JOIN #cohort_details cd +on cd.target_cohort_id = tno.target_cohort_id +and cd.outcome_cohort_id = tno.outcome_cohort_id +and cd.cohort_type = 'TnOc' union -- T without O select -subject_id, -cohort_start_date, -cohort_end_date, -cohort_definition_id -- ends in 2 -from #target_nooutcome +tnoc.subject_id, +tnoc.cohort_start_date, +tnoc.cohort_end_date, +cd.cohort_definition_id +from #target_nooutcome tnoc +INNER JOIN #cohort_details cd +on cd.target_cohort_id = tnoc.target_cohort_id +and cd.outcome_cohort_id = tnoc.outcome_cohort_id +and cd.cohort_type = 'TnOc' union @@ -102,20 +167,26 @@ union select distinct * from ( select -subject_id, -cohort_start_date, -cohort_end_date, -cohort_definition_id*100000 -from #targets_agg +t.subject_id, +t.cohort_start_date, +t.cohort_end_date, +cd.cohort_definition_id +from #targets_agg as t +INNER JOIN #cohort_details cd +on cd.target_cohort_id = t.cohort_definition_id +and cd.cohort_type = 'T' union select -subject_id, -cohort_start_date, -cohort_end_date, -cohort_definition_id*100000 -from #outcomes_agg +o.subject_id, +o.cohort_start_date, +o.cohort_end_date, +cd.cohort_definition_id +from #outcomes_agg as o +INNER JOIN #cohort_details cd +on cd.outcome_cohort_id = o.cohort_definition_id +and cd.cohort_type = 'O' ) temp_ts ) temp_ts2; diff --git a/tests/testthat/test-aggregateCovariate.R b/tests/testthat/test-aggregateCovariate.R index 8f20da7..9a2423d 100644 --- a/tests/testthat/test-aggregateCovariate.R +++ b/tests/testthat/test-aggregateCovariate.R @@ -65,8 +65,20 @@ test_that("computeAggregateCovariateAnalyses", { "analysisRef", "covariateRef", "covariates", - "covariatesContinuous" - )) == 4 + "covariatesContinuous", + "settings", + "cohortDetails" + )) == 6 + ) + + # check cohortDetails + testthat::expect_true( + length(unique(as.data.frame(agc$cohortDetails)$cohortDefinitionId)) == + nrow(as.data.frame(agc$cohortDetails)) + ) + + testthat::expect_true( + nrow(as.data.frame(agc$cohortDetails)) == 13 # 4 T/Os, 3 TnO, 3 TnOc, 3 OnT ) # test saving/loading diff --git a/tests/testthat/test-runCharacterization.R b/tests/testthat/test-runCharacterization.R index f502702..5f3dbc9 100644 --- a/tests/testthat/test-runCharacterization.R +++ b/tests/testthat/test-runCharacterization.R @@ -135,7 +135,7 @@ test_that("runCharacterizationAnalyses", { connectionDetailsT <- DatabaseConnector::createConnectionDetails( dbms = "sqlite", - server = file.path(tempFolder, "sqliteCharacterization", "sqlite.sql") + server = file.path(tempFolder, "sqliteCharacterization", "sqlite.sqlite") ) exportDatabaseToCsv( @@ -149,4 +149,28 @@ test_that("runCharacterizationAnalyses", { testthat::expect_true( length(dir(file.path(tempFolder, "csv"))) > 0 ) + + # check cohort details is saved + testthat::expect_true( + file.exists(file.path(tempFolder, "csv", "cohort_details.csv")) + ) + testthat::expect_true( + file.exists(file.path(tempFolder, "csv", "settings.csv")) + ) + testthat::expect_true( + file.exists(file.path(tempFolder, "csv", "analysis_ref.csv")) + ) + testthat::expect_true( + file.exists(file.path(tempFolder, "csv", "covariate_ref.csv")) + ) + testthat::expect_true( + file.exists(file.path(tempFolder, "csv", "dechallenge_rechallenge.csv")) + ) + testthat::expect_true( + file.exists(file.path(tempFolder, "csv", "rechallenge_fail_case_series.csv")) + ) + testthat::expect_true( + file.exists(file.path(tempFolder, "csv", "time_to_event.csv")) + ) + }) From e91a73c3a01912ac616e8e9afa353e7a27157447 Mon Sep 17 00:00:00 2001 From: Admin_mschuemi Date: Fri, 13 Jan 2023 02:35:58 -0500 Subject: [PATCH 4/8] Updating GitHub Actions. Adding weekly check of main --- .github/workflows/R_CMD_check_Hades.yaml | 84 +++++++------------ .../workflows/R_CMD_check_main_weekly.yaml | 67 +++++++++++++++ .github/workflows/nightly_cleanup_Hades.yml | 18 ---- 3 files changed, 98 insertions(+), 71 deletions(-) create mode 100644 .github/workflows/R_CMD_check_main_weekly.yaml delete mode 100644 .github/workflows/nightly_cleanup_Hades.yml diff --git a/.github/workflows/R_CMD_check_Hades.yaml b/.github/workflows/R_CMD_check_Hades.yaml index dae92ec..5068891 100644 --- a/.github/workflows/R_CMD_check_Hades.yaml +++ b/.github/workflows/R_CMD_check_Hades.yaml @@ -20,7 +20,7 @@ jobs: fail-fast: false matrix: config: - - {os: windows-latest, r: 'release'} # Does not appear to have Java 32-bit, hence the --no-multiarch + - {os: windows-latest, r: 'release'} - {os: macOS-latest, r: 'release'} - {os: ubuntu-20.04, r: 'release', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"} @@ -43,75 +43,46 @@ jobs: CDM5_SQL_SERVER_PASSWORD: ${{ secrets.CDM5_SQL_SERVER_PASSWORD }} CDM5_SQL_SERVER_SERVER: ${{ secrets.CDM5_SQL_SERVER_SERVER }} CDM5_SQL_SERVER_USER: ${{ secrets.CDM5_SQL_SERVER_USER }} + CDM5_REDSHIFT_CDM_SCHEMA: ${{ secrets.CDM5_REDSHIFT_CDM_SCHEMA }} + CDM5_REDSHIFT_OHDSI_SCHEMA: ${{ secrets.CDM5_REDSHIFT_OHDSI_SCHEMA }} + CDM5_REDSHIFT_PASSWORD: ${{ secrets.CDM5_REDSHIFT_PASSWORD }} + CDM5_REDSHIFT_SERVER: ${{ secrets.CDM5_REDSHIFT_SERVER }} + CDM5_REDSHIFT_USER: ${{ secrets.CDM5_REDSHIFT_USER }} + CDM5_SPARK_USER: ${{ secrets.CDM5_SPARK_USER }} + CDM5_SPARK_PASSWORD: ${{ secrets.CDM5_SPARK_PASSWORD }} + CDM5_SPARK_CONNECTION_STRING: ${{ secrets.CDM5_SPARK_CONNECTION_STRING }} steps: - uses: actions/checkout@v2 - - uses: r-lib/actions/setup-r@v1 + - uses: r-lib/actions/setup-r@v2 with: r-version: ${{ matrix.config.r }} - - uses: r-lib/actions/setup-tinytex@v1 + - uses: r-lib/actions/setup-tinytex@v2 - - uses: r-lib/actions/setup-pandoc@v1 + - uses: r-lib/actions/setup-pandoc@v2 - - name: Query dependencies - run: | - install.packages('remotes') - saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2) - writeLines(sprintf("R-%i.%i", getRversion()$major, getRversion()$minor), ".github/R-version") - shell: Rscript {0} - - - name: Cache R packages - if: runner.os != 'Windows' - uses: actions/cache@v2 - with: - path: ${{ env.R_LIBS_USER }} - key: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-${{ hashFiles('.github/depends.Rds') }} - restore-keys: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1- - - - name: Install system dependencies + - name: Install system requirements if: runner.os == 'Linux' run: | + sudo apt-get install -y libssh-dev + Rscript -e 'install.packages("remotes")' while read -r cmd do eval sudo $cmd done < <(Rscript -e 'writeLines(remotes::system_requirements("ubuntu", "20.04"))') - - name: Install libssh - if: runner.os == 'Linux' - run: | - sudo apt-get install libssh-dev - - - name: Install dependencies - run: | - remotes::install_deps(dependencies = TRUE, INSTALL_opts=c("--no-multiarch")) - remotes::install_cran("rcmdcheck") - shell: Rscript {0} - - - name: Install covr - if: runner.os == 'macOS' - run: | - remotes::install_cran("covr") - shell: Rscript {0} - - - name: Remove check folder if exists - if: runner.os == 'macOS' - run: unlink("check", recursive = TRUE) - shell: Rscript {0} - - - name: Check - env: - _R_CHECK_CRAN_INCOMING_REMOTE_: false - run: rcmdcheck::rcmdcheck(args = c("--no-manual", "--as-cran", "--no-multiarch"), error_on = "warning", check_dir = "check") - shell: Rscript {0} + - uses: r-lib/actions/setup-r-dependencies@v2 + with: + extra-packages: any::rcmdcheck + needs: check - - name: Upload check results - if: failure() - uses: actions/upload-artifact@v2 + - uses: r-lib/actions/check-r-package@v2 with: - name: ${{ runner.os }}-r${{ matrix.config.r }}-results - path: check + args: 'c("--no-manual", "--as-cran")' + error-on: '"warning"' + check-dir: '"check"' - name: Upload source package if: success() && runner.os == 'macOS' && github.event_name != 'pull_request' && github.ref == 'refs/heads/main' @@ -120,6 +91,12 @@ jobs: name: package_tarball path: check/*.tar.gz + - name: Install covr + if: runner.os == 'macOS' + run: | + install.packages("covr") + shell: Rscript {0} + - name: Test coverage if: runner.os == 'macOS' run: covr::codecov() @@ -163,7 +140,7 @@ jobs: draft: false prerelease: false - - uses: r-lib/actions/setup-r@v1 + - uses: r-lib/actions/setup-r@v2 if: ${{ env.new_version != '' }} - name: Install drat @@ -192,3 +169,4 @@ jobs: if: ${{ env.new_version != '' }} run: | curl --data "build=true" -X POST https://registry.hub.docker.com/u/ohdsi/broadsea-methodslibrary/trigger/f0b51cec-4027-4781-9383-4b38b42dd4f5/ + diff --git a/.github/workflows/R_CMD_check_main_weekly.yaml b/.github/workflows/R_CMD_check_main_weekly.yaml new file mode 100644 index 0000000..5e928a1 --- /dev/null +++ b/.github/workflows/R_CMD_check_main_weekly.yaml @@ -0,0 +1,67 @@ +on: + schedule: + - cron: '0 14 * * 0' # every Sunday at 2pm UTC + +name: 'R check' + +jobs: + R-CMD-check-main: + runs-on: ${{ matrix.config.os }} + + name: ${{ matrix.config.os }} (${{ matrix.config.r }}) + + strategy: + fail-fast: false + matrix: + config: + - {os: macOS-latest, r: 'release'} + + env: + GITHUB_PAT: ${{ secrets.GH_TOKEN }} + R_REMOTES_NO_ERRORS_FROM_WARNINGS: true + RSPM: ${{ matrix.config.rspm }} + CDM5_ORACLE_CDM_SCHEMA: ${{ secrets.CDM5_ORACLE_CDM_SCHEMA }} + CDM5_ORACLE_OHDSI_SCHEMA: ${{ secrets.CDM5_ORACLE_OHDSI_SCHEMA }} + CDM5_ORACLE_PASSWORD: ${{ secrets.CDM5_ORACLE_PASSWORD }} + CDM5_ORACLE_SERVER: ${{ secrets.CDM5_ORACLE_SERVER }} + CDM5_ORACLE_USER: ${{ secrets.CDM5_ORACLE_USER }} + CDM5_POSTGRESQL_CDM_SCHEMA: ${{ secrets.CDM5_POSTGRESQL_CDM_SCHEMA }} + CDM5_POSTGRESQL_OHDSI_SCHEMA: ${{ secrets.CDM5_POSTGRESQL_OHDSI_SCHEMA }} + CDM5_POSTGRESQL_PASSWORD: ${{ secrets.CDM5_POSTGRESQL_PASSWORD }} + CDM5_POSTGRESQL_SERVER: ${{ secrets.CDM5_POSTGRESQL_SERVER }} + CDM5_POSTGRESQL_USER: ${{ secrets.CDM5_POSTGRESQL_USER }} + CDM5_SQL_SERVER_CDM_SCHEMA: ${{ secrets.CDM5_SQL_SERVER_CDM_SCHEMA }} + CDM5_SQL_SERVER_OHDSI_SCHEMA: ${{ secrets.CDM5_SQL_SERVER_OHDSI_SCHEMA }} + CDM5_SQL_SERVER_PASSWORD: ${{ secrets.CDM5_SQL_SERVER_PASSWORD }} + CDM5_SQL_SERVER_SERVER: ${{ secrets.CDM5_SQL_SERVER_SERVER }} + CDM5_SQL_SERVER_USER: ${{ secrets.CDM5_SQL_SERVER_USER }} + CDM5_REDSHIFT_CDM_SCHEMA: ${{ secrets.CDM5_REDSHIFT_CDM_SCHEMA }} + CDM5_REDSHIFT_OHDSI_SCHEMA: ${{ secrets.CDM5_REDSHIFT_OHDSI_SCHEMA }} + CDM5_REDSHIFT_PASSWORD: ${{ secrets.CDM5_REDSHIFT_PASSWORD }} + CDM5_REDSHIFT_SERVER: ${{ secrets.CDM5_REDSHIFT_SERVER }} + CDM5_REDSHIFT_USER: ${{ secrets.CDM5_REDSHIFT_USER }} + CDM5_SPARK_USER: ${{ secrets.CDM5_SPARK_USER }} + CDM5_SPARK_PASSWORD: ${{ secrets.CDM5_SPARK_PASSWORD }} + CDM5_SPARK_CONNECTION_STRING: ${{ secrets.CDM5_SPARK_CONNECTION_STRING }} + + steps: + - uses: actions/checkout@v2 + + - uses: r-lib/actions/setup-r@v2 + with: + r-version: ${{ matrix.config.r }} + + - uses: r-lib/actions/setup-tinytex@v2 + + - uses: r-lib/actions/setup-pandoc@v2 + + - uses: r-lib/actions/setup-r-dependencies@v2 + with: + extra-packages: any::rcmdcheck + needs: check + + - uses: r-lib/actions/check-r-package@v2 + with: + args: 'c("--no-manual", "--as-cran")' + error-on: '"warning"' + check-dir: '"check"' diff --git a/.github/workflows/nightly_cleanup_Hades.yml b/.github/workflows/nightly_cleanup_Hades.yml deleted file mode 100644 index 80af7c7..0000000 --- a/.github/workflows/nightly_cleanup_Hades.yml +++ /dev/null @@ -1,18 +0,0 @@ -name: 'nightly artifacts cleanup' -on: - schedule: - - cron: '0 1 * * *' # every night at 1 am UTC - -jobs: - remove-old-artifacts: - runs-on: ubuntu-latest - timeout-minutes: 10 - - steps: - - name: Remove old artifacts - uses: c-hive/gha-remove-artifacts@v1 - with: - age: '7 days' - # Optional inputs - # skip-tags: true - skip-recent: 1 From f23027fef37590089a74fd216223734acce3ae15 Mon Sep 17 00:00:00 2001 From: Admin_mschuemi Date: Fri, 13 Jan 2023 02:37:52 -0500 Subject: [PATCH 5/8] Removing Andromeda from remotes because it is in CRAN. Removing FE from installation instructions because remotes will automatically install it. --- DESCRIPTION | 1 - vignettes/InstallationGuide.Rmd | 1 - 2 files changed, 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 57de4fe..a971d29 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -32,7 +32,6 @@ Suggests: markdown, withr Remotes: - ohdsi/Andromeda, ohdsi/FeatureExtraction, ohdsi/Eunomia NeedsCompilation: no diff --git a/vignettes/InstallationGuide.Rmd b/vignettes/InstallationGuide.Rmd index ec89a3e..9552cfe 100644 --- a/vignettes/InstallationGuide.Rmd +++ b/vignettes/InstallationGuide.Rmd @@ -61,7 +61,6 @@ Note that the latest develop branch could contain bugs, please report them to us To install using `remotes` run: ```{r, echo = TRUE, message = FALSE, warning = FALSE,tidy=FALSE,eval=FALSE} install.packages("remotes") -remotes::install_github("OHDSI/FeatureExtraction") remotes::install_github("OHDSI/Characterization") ``` From 7f86f52670cf0f0736927bca16a6a0a4b970fc8d Mon Sep 17 00:00:00 2001 From: Admin_mschuemi Date: Fri, 13 Jan 2023 02:39:21 -0500 Subject: [PATCH 6/8] Minor fixes --- R/Characterization.R | 1 + R/Database.R | 94 +++++++++++----------- R/DechallengeRechallenge.R | 4 +- README.md | 2 + vignettes/UsingCharacterizationPackage.Rmd | 2 +- 5 files changed, 53 insertions(+), 50 deletions(-) diff --git a/R/Characterization.R b/R/Characterization.R index 3885f20..20b810e 100644 --- a/R/Characterization.R +++ b/R/Characterization.R @@ -18,5 +18,6 @@ "_PACKAGE" #' @importFrom rlang .data +#' @importFrom methods is #' @importFrom dplyr %>% NULL diff --git a/R/Database.R b/R/Database.R index 520b95e..ff44a49 100644 --- a/R/Database.R +++ b/R/Database.R @@ -30,50 +30,50 @@ #' #' @export createSqliteDatabase <- function( - sqliteLocation = tempdir() + sqliteLocation = tempdir() ){ sqliteLocation <- file.path( sqliteLocation, 'sqliteCharacterization' - ) + ) if(!dir.exists(sqliteLocation )){ dir.create( path = sqliteLocation, recursive = T - ) + ) } -connectionDetails <- DatabaseConnector::createConnectionDetails( - dbms = 'sqlite', - server = file.path(sqliteLocation, 'sqlite.sqlite') + connectionDetails <- DatabaseConnector::createConnectionDetails( + dbms = 'sqlite', + server = file.path(sqliteLocation, 'sqlite.sqlite') ) -connection <- DatabaseConnector::connect( - connectionDetails = connectionDetails + connection <- DatabaseConnector::connect( + connectionDetails = connectionDetails ) -return(connection) + return(connection) } # move Andromeda to sqlite database insertAndromedaToDatabase <- function( - connection, - databaseSchema, - tableName, - andromedaObject, - tempEmulationSchema, - bulkLoad = T, - tablePrefix = 'c_' + connection, + databaseSchema, + tableName, + andromedaObject, + tempEmulationSchema, + bulkLoad = T, + tablePrefix = 'c_' ){ errorMessages <- checkmate::makeAssertCollection() .checkTablePrefix( tablePrefix = tablePrefix, errorMessages = errorMessages - ) + ) checkmate::reportAssertions(errorMessages) - message('Inserting Andromeda table into Datbase table ', tablePrefix, tableName) + message('Inserting Andromeda table into database table ', tablePrefix, tableName) Andromeda::batchApply( tbl = andromedaObject, @@ -120,28 +120,28 @@ insertAndromedaToDatabase <- function( #' #' @export createCharacterizationTables <- function( - conn, - resultSchema, - targetDialect = 'postgresql', - deleteExistingTables = T, - createTables = T, - tablePrefix = 'c_', - tempEmulationSchema = getOption("sqlRenderTempEmulationSchema") + conn, + resultSchema, + targetDialect = 'postgresql', + deleteExistingTables = T, + createTables = T, + tablePrefix = 'c_', + tempEmulationSchema = getOption("sqlRenderTempEmulationSchema") ){ errorMessages <- checkmate::makeAssertCollection() .checkTablePrefix( tablePrefix = tablePrefix, errorMessages = errorMessages - ) + ) checkmate::reportAssertions(errorMessages) if(deleteExistingTables){ message('Deleting existing tables') tables <- getResultTables() - tables <- paste0(toupper(tablePrefix),tables) + tables <- paste0(tablePrefix, tables) - alltables <- toupper( + alltables <- tolower( DatabaseConnector::getTableNames( connection = conn, databaseSchema = resultSchema @@ -164,7 +164,7 @@ createCharacterizationTables <- function( DatabaseConnector::executeSql( connection = conn, sql = sql - ) + ) sql <- 'DROP TABLE @my_schema.@table' sql <- SqlRender::render( @@ -180,7 +180,7 @@ createCharacterizationTables <- function( DatabaseConnector::executeSql( connection = conn, sql = sql - ) + ) } } @@ -201,7 +201,7 @@ createCharacterizationTables <- function( DatabaseConnector::executeSql( connection = conn, sql = renderedSql - ) + ) # add database migration here in the future } @@ -230,20 +230,21 @@ createCharacterizationTables <- function( #' #' @export exportDatabaseToCsv <- function( - connectionDetails, - resultSchema, - targetDialect, - tablePrefix = "c_", - filePrefix = NULL, - tempEmulationSchema = NULL, - saveDirectory + connectionDetails, + resultSchema, + targetDialect, + tablePrefix = "c_", + filePrefix = NULL, + tempEmulationSchema = NULL, + saveDirectory ){ errorMessages <- checkmate::makeAssertCollection() + .checkConnectionDetails(connectionDetails, errorMessages) .checkTablePrefix( tablePrefix = tablePrefix, errorMessages = errorMessages - ) + ) checkmate::reportAssertions(errorMessages) if (is.null(filePrefix)) { @@ -253,17 +254,17 @@ exportDatabaseToCsv <- function( # connect to result database connection <- DatabaseConnector::connect( connectionDetails = connectionDetails - ) + ) on.exit( DatabaseConnector::disconnect(connection) - ) + ) # create the folder to save the csv files if(!dir.exists(saveDirectory)){ dir.create( path = saveDirectory, recursive = T - ) + ) } # get the table names using the function in uploadToDatabase.R @@ -282,18 +283,18 @@ exportDatabaseToCsv <- function( sql = sql, targetDialect = targetDialect, tempEmulationSchema = tempEmulationSchema - ) + ) result <- DatabaseConnector::querySql( connection = connection, sql = sql, snakeCaseToCamelCase = F - ) + ) result <- formatDouble(result) # save the results as a csv readr::write_csv( x = result, - file = file.path(saveDirectory, paste0(tolower(filePrefix), tolower(table),'.csv')) + file = file.path(saveDirectory, paste0(tolower(filePrefix), table,'.csv')) ) } @@ -302,7 +303,7 @@ exportDatabaseToCsv <- function( getResultTables <- function(){ return( - unique(toupper( + unique( readr::read_csv( file = system.file( 'settings', @@ -312,7 +313,6 @@ getResultTables <- function(){ show_col_types = FALSE )$table_name ) - ) ) } diff --git a/R/DechallengeRechallenge.R b/R/DechallengeRechallenge.R index 2858411..1059e7c 100644 --- a/R/DechallengeRechallenge.R +++ b/R/DechallengeRechallenge.R @@ -306,8 +306,8 @@ computeRechallengeFailCaseSeriesAnalyses <- function( message( paste0( "Computing dechallenge failed case series for ", - length(dechallengeRechallengeSettings$targetCohortDefinitionIds), " target ids and ", - length(dechallengeRechallengeSettings$outcomeCohortDefinitionIds),"outcome ids took ", + length(dechallengeRechallengeSettings$targetCohortDefinitionIds), " target IDs and ", + length(dechallengeRechallengeSettings$outcomeCohortDefinitionIds)," outcome IDs took ", signif(delta, 3), " ", attr(delta, "units") ) diff --git a/README.md b/README.md index bab5205..05b19e2 100644 --- a/README.md +++ b/README.md @@ -4,6 +4,8 @@ Characterization [![Build Status](https://github.com/OHDSI/Characterization/workflows/R-CMD-check/badge.svg)](https://github.com/OHDSI/Characterization/actions?query=workflow%3AR-CMD-check) [![codecov.io](https://codecov.io/github/OHDSI/Characterization/coverage.svg?branch=main)](https://codecov.io/github/OHDSI/Characterization?branch=main) +Characterization is part of [HADES](https://ohdsi.github.io/Hades/). + Introduction ============ diff --git a/vignettes/UsingCharacterizationPackage.Rmd b/vignettes/UsingCharacterizationPackage.Rmd index 022c8e2..d2ebdb3 100644 --- a/vignettes/UsingCharacterizationPackage.Rmd +++ b/vignettes/UsingCharacterizationPackage.Rmd @@ -310,7 +310,7 @@ This will create an SQLITE database with all the analyses saved into the saveDir ```{r eval=FALSE} connectionDetailsT <- DatabaseConnector::createConnectionDetails( dbms = 'sqlite', - server = file.path(tempdir(),'example','sqliteCharacterization', 'sqlite') + server = file.path(tempdir(),'example','sqliteCharacterization', 'sqlite.sqlite') ) exportDatabaseToCsv( From 2b04ad1a2938cb858792d0a7d77c692bb794ea8d Mon Sep 17 00:00:00 2001 From: Admin_mschuemi Date: Fri, 13 Jan 2023 02:52:33 -0500 Subject: [PATCH 7/8] Updating checkout version as suggested by GA warnings --- .github/workflows/R_CMD_check_Hades.yaml | 2 +- .github/workflows/R_CMD_check_main_weekly.yaml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/R_CMD_check_Hades.yaml b/.github/workflows/R_CMD_check_Hades.yaml index 5068891..386f45b 100644 --- a/.github/workflows/R_CMD_check_Hades.yaml +++ b/.github/workflows/R_CMD_check_Hades.yaml @@ -53,7 +53,7 @@ jobs: CDM5_SPARK_CONNECTION_STRING: ${{ secrets.CDM5_SPARK_CONNECTION_STRING }} steps: - - uses: actions/checkout@v2 + - uses: actions/checkout@v3 - uses: r-lib/actions/setup-r@v2 with: diff --git a/.github/workflows/R_CMD_check_main_weekly.yaml b/.github/workflows/R_CMD_check_main_weekly.yaml index 5e928a1..099df33 100644 --- a/.github/workflows/R_CMD_check_main_weekly.yaml +++ b/.github/workflows/R_CMD_check_main_weekly.yaml @@ -45,7 +45,7 @@ jobs: CDM5_SPARK_CONNECTION_STRING: ${{ secrets.CDM5_SPARK_CONNECTION_STRING }} steps: - - uses: actions/checkout@v2 + - uses: actions/checkout@v3 - uses: r-lib/actions/setup-r@v2 with: From 73416ee2e85328088457302d54210e4a3454ff0e Mon Sep 17 00:00:00 2001 From: jreps Date: Fri, 13 Jan 2023 15:05:00 -0500 Subject: [PATCH 8/8] adding input checks for settings - adding input checks for settings --- R/AggregateCovariates.R | 27 ++++++++++++++++++++++++++- R/DechallengeRechallenge.R | 23 +++++++++++++++++++++++ R/HelperFunctions.R | 13 +++++++++++++ 3 files changed, 62 insertions(+), 1 deletion(-) diff --git a/R/AggregateCovariates.R b/R/AggregateCovariates.R index 1df8b2b..1269b40 100644 --- a/R/AggregateCovariates.R +++ b/R/AggregateCovariates.R @@ -35,9 +35,34 @@ createAggregateCovariateSettings <- function( covariateSettings ){ - # check cohortIds is a vector of int/double + errorMessages <- checkmate::makeAssertCollection() + # check targetIds is a vector of int/double + .checkCohortIds( + cohortIds = targetIds, + type = 'target', + errorMessages = errorMessages + ) # check outcomeIds is a vector of int/double + .checkCohortIds( + cohortIds = outcomeIds, + type = 'outcome', + errorMessages = errorMessages + ) + + # check TAR + .checkTimeAtRisk( + riskWindowStart = riskWindowStart, + startAnchor = startAnchor, + riskWindowEnd = riskWindowEnd, + endAnchor = endAnchor, + errorMessages = errorMessages + ) + # check covariateSettings + .checkCovariateSettings( + covariateSettings = covariateSettings, + errorMessages = errorMessages + ) #check TAR diff --git a/R/DechallengeRechallenge.R b/R/DechallengeRechallenge.R index 5159c68..8d79e1f 100644 --- a/R/DechallengeRechallenge.R +++ b/R/DechallengeRechallenge.R @@ -45,6 +45,29 @@ createDechallengeRechallengeSettings <- function( type = 'outcome', errorMessages = errorMessages ) + + # check dechallengeStopInterval is numeric + checkmate::assertNumeric( + x = dechallengeStopInterval, + lower = 0, + finite = TRUE, + any.missing = FALSE, + len = 1, + .var.name = 'dechallengeStopInterval', + add = errorMessages + ) + + # check dechallengeEvaluationWindowl is numeric + checkmate::assertNumeric( + x = dechallengeEvaluationWindow, + lower = 0, + finite = TRUE, + any.missing = FALSE, + len = 1, + .var.name = 'dechallengeEvaluationWindow', + add = errorMessages + ) + checkmate::reportAssertions(errorMessages) # create data.frame with all combinations diff --git a/R/HelperFunctions.R b/R/HelperFunctions.R index 5dd9ed8..3cc9edc 100644 --- a/R/HelperFunctions.R +++ b/R/HelperFunctions.R @@ -219,3 +219,16 @@ add = errorMessages ) } + + + +.checkCovariateSettings <- function( + covariateSettings, + errorMessages +) { + checkmate::assertClass( + x = covariateSettings, + classes = "covariateSettings", + add = errorMessages + ) +}