diff --git a/DESCRIPTION b/DESCRIPTION index 7e55026..f6c1d9b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Package: Characterization Type: Package Title: Implement Descriptive Studies Using the Common Data Model -Version: 3.0.1 -Date: 2026-4-15 +Version: 4.0.0 +Date: 2026-7-15 Authors@R: c( person("Jenna", "Reps", , "jreps@its.jnj.com", role = c("aut", "cre")), person("Patrick", "Ryan", , "ryan@ohdsi.org", role = c("aut")), @@ -39,6 +39,6 @@ Suggests: shiny, withr NeedsCompilation: no -RoxygenNote: 7.3.2 Encoding: UTF-8 VignetteBuilder: knitr +Config/roxygen2/version: 8.0.0 diff --git a/NAMESPACE b/NAMESPACE index 0d0c6b2..afa5c5e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,9 +2,6 @@ export(cleanIncremental) export(cleanNonIncremental) -export(computeDechallengeRechallengeAnalyses) -export(computeRechallengeFailCaseSeriesAnalyses) -export(computeTimeToEventAnalyses) export(createCaseSeriesSettings) export(createCharacterizationSettings) export(createCharacterizationTables) @@ -12,6 +9,7 @@ export(createDechallengeRechallengeSettings) export(createDuringCovariateSettings) export(createRiskFactorSettings) export(createSqliteDatabase) +export(createStudyPopulationSettings) export(createTargetBaselineSettings) export(createTimeToEventSettings) export(exampleOmopConnectionDetails) diff --git a/NEWS.md b/NEWS.md index 9ff17ea..b66f97b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,18 @@ +Characterization 4.0.0 +====================== +- [enhancement] replaced targetId inputs to the settings with studyPopulationSettings that lets you specify + min prior observation, first in n days, age, date, gender and nesting cohort restrictions. +- [enhancement] outcome washout in risk factor is now used to combine outcome cohort entries that are within outcome washout days +- [enhancement] improved attrition capture: can now see fill attrition for study population +- [enhancement] changed csv file output to split up attrition into case_attrition and target_attrition, added + case_counts and target_counts and added time_to_event_settings/dechallenge_rechallenge_settings that + let user quickly see what study population and outcome pairs were included. +- [bug fix] fixed issues when dividing by zero in SMD calculation + +Characterization 3.0.2 +====================== +- Replacing IFNULL with ISNULL as SQL server errors with IFNULL + Characterization 3.0.1 ====================== - Fix issue with uploading results into database for shiny viewer (spacing was added to csv and causing issues and continuous covariates that are floats were incorrectly bigints) diff --git a/R/CaseSeries.R b/R/CaseSeries.R index 0c6ec96..1b6e6b2 100644 --- a/R/CaseSeries.R +++ b/R/CaseSeries.R @@ -16,15 +16,13 @@ #' Create aggregate covariate study settings #' -#' @param targetIds A list of cohortIds for the target cohorts +#' @param studyPopulationSettings A List of object created using \code{createStudyPopulationSettings} that specifies target cohorts and inclusion criteria #' @param outcomeIds A list of cohortIds for the outcome cohorts -#' @param limitToFirstInNDays whether to limit each target cohort to the first entry into the cohort per N days per subject -#' @param minPriorObservation The minimum time (in days) in the database a patient in the target cohorts must be observed prior to index -#' @param outcomeWashoutDays Patients with the outcome within outcomeWashout days prior to index are excluded from the risk factor analysis +#' @param outcomeWashoutDays A single integer value. Patients with the outcome within outcomeWashout days prior to index are excluded from the risk factor analysis #' @template timeAtRisk #' @param caseCovariateSettings An object created using \code{createDuringCovariateSettings} -#' @param casePreTargetDuration The number of days prior to case index we use for FeatureExtraction -#' @param casePostOutcomeDuration The number of days prior to case index we use for FeatureExtraction +#' @param casePreTargetDuration A single integer value. The number of days prior to case index we use for FeatureExtraction +#' @param casePostOutcomeDuration A single integer value. The number of days prior to case index we use for FeatureExtraction #' @family Aggregate #' @return #' A list with the settings @@ -32,10 +30,12 @@ #' @examples #' #' caseSeriesSetting <- createCaseSeriesSettings( -#' targetIds = c(1,2), +#' studyPopulationSettings = createStudyPopulationSettings( +#' targetIds = c(1,2), +#' minPriorObservation = 365, +#' limitToFirstInNDays = 365 +#' ), #' outcomeIds = c(3), -#' limitToFirstInNDays = 365, -#' minPriorObservation = 365, #' outcomeWashoutDays = 90, #' riskWindowStart = 1, #' startAnchor = "cohort start", @@ -47,10 +47,8 @@ #' #' @export createCaseSeriesSettings <- function( - targetIds, + studyPopulationSettings, outcomeIds, - limitToFirstInNDays = 99999, - minPriorObservation = 0, outcomeWashoutDays = 0, riskWindowStart = 1, startAnchor = "cohort start", @@ -70,11 +68,11 @@ createCaseSeriesSettings <- function( ) { errorMessages <- checkmate::makeAssertCollection() # check targetIds is a vector of int/double - .checkCohortIds( - cohortIds = targetIds, - type = "target", - errorMessages = errorMessages - ) + #.checkCohortIds( + # cohortIds = targetIds, + # type = "target", + # errorMessages = errorMessages + #) # check outcomeIds is a vector of int/double .checkCohortIds( cohortIds = outcomeIds, @@ -82,6 +80,11 @@ createCaseSeriesSettings <- function( errorMessages = errorMessages ) + # check outcomeWashoutDays is length 1 + if (length(outcomeWashoutDays) > 1) { + stop("Please add one outcomeWashoutDays per setting") + } + # check TAR - EFF edit if (length(riskWindowStart) > 1) { stop("Please add one time-at-risk per setting") @@ -95,10 +98,10 @@ createCaseSeriesSettings <- function( ) # check minPriorObservation - .checkMinPriorObservation( - minPriorObservation = minPriorObservation, - errorMessages = errorMessages - ) + #.checkMinPriorObservation( + # minPriorObservation = minPriorObservation, + # errorMessages = errorMessages + #) # add check for outcomeWashoutDays and nlimitToFirstInNDays @@ -125,10 +128,10 @@ createCaseSeriesSettings <- function( checkmate::reportAssertions(errorMessages) # check unique Ts and Os - if (length(targetIds) != length(unique(targetIds))) { - message("targetIds have duplicates - making unique") - targetIds <- unique(targetIds) - } + #if (length(targetIds) != length(unique(targetIds))) { + # message("targetIds have duplicates - making unique") + # targetIds <- unique(targetIds) + #} if (length(outcomeIds) != length(unique(outcomeIds))) { message("outcomeIds have duplicates - making unique") outcomeIds <- unique(outcomeIds) @@ -137,9 +140,7 @@ createCaseSeriesSettings <- function( # create list result <- list( - targetIds = targetIds, - limitToFirstInNDays = limitToFirstInNDays, - minPriorObservation = minPriorObservation, + studyPopulationSettings = combineStudyPopulationSettings(studyPopulationSettings), outcomeIds = outcomeIds, outcomeWashoutDays = outcomeWashoutDays, riskWindowStart = riskWindowStart, @@ -168,8 +169,8 @@ computeCaseSeriesAnalyses <- function( characterizationDatabaseSchema, characterizationTable, # contains char cohorts - targetSettingsTable, # contains map between settings and char cohort id caseSettingsTable, # contains map between settings and case id + caseCountTable, # new tempEmulationSchema = getOption("sqlRenderTempEmulationSchema"), settings, @@ -180,6 +181,7 @@ computeCaseSeriesAnalyses <- function( minCellCount = 0, progressBar = interactive(), executionId, + minCaseSize = minCaseSize, ...) { if(missing(outputFolder)){ @@ -199,34 +201,32 @@ computeCaseSeriesAnalyses <- function( start <- Sys.time() message("Case series analysis: Finding temp Ids") - targetIds <- lookupTargets( - connection = connection, - lookupDatabaseSchema = characterizationDatabaseSchema, - lookupTableName = targetSettingsTable, - tempEmulationSchema = tempEmulationSchema, - targetIds = paste0(unique(settings$targetIds), collapse = ','), - limitToFirstInNDays = settings$limitToFirstInNDays, - minPriorObservation = settings$minPriorObservation - ) - caseIds <- lookupCases( connection = connection, lookupDatabaseSchema = characterizationDatabaseSchema, lookupTableName = caseSettingsTable, + countTable = caseCountTable, tempEmulationSchema = tempEmulationSchema, - characterizationTargetIds = paste0(unique(targetIds$characterizationTargetId), collapse = ','), + characterizationTargetIds = paste0(unique(settings$characterizationTargetId), collapse = ','), outcomeIds = paste0(unique(settings$outcomeIds), collapse = ','), outcomeWashoutDays = settings$outcomeWashoutDays, startAnchor = settings$startAnchor, riskWindowStart = settings$riskWindowStart, endAnchor = settings$endAnchor, - riskWindowEnd = settings$riskWindowEnd + riskWindowEnd = settings$riskWindowEnd, + minCaseSize = minCaseSize, + applyMinSizeToNonCases = FALSE ) completionTime <- Sys.time() - start message(paste0("Case series analysis: Finding temp Ids took ", round(completionTime, digits = 1), " ", units(completionTime))) + if(nrow(caseIds) == 0){ + message('No case cohorts of minCaseSize') + return(invisible(TRUE)) + } + ## 4) run FE with all the cohorts of interest - ideally inserting the aggregate features into a new table start <- Sys.time() message("Case series analysis: Running FeatureExtraction") @@ -239,10 +239,10 @@ computeCaseSeriesAnalyses <- function( cohortIds = c(caseIds$characterizationCaseId*10+3, caseIds$characterizationCaseId*10+4, caseIds$characterizationCaseId*10+5), - rowIdField = 'row_number', + rowIdField = 'row_id', covariateSettings = ParallelLogger::convertJsonToSettings(settings$covariateSettings), aggregated = TRUE, - minCharacterizationMean = minCharacterizationMean, + minCharacterizationMean = 0, #minCharacterizationMean, exportToTable = TRUE, targetDatabaseSchema = NULL, @@ -275,7 +275,8 @@ computeCaseSeriesAnalyses <- function( caseIds$characterizationCaseId*10+4, caseIds$characterizationCaseId*10+5), collapse = ','), - min_count = minCovariateCount + min_count = minCovariateCount, + min_characterization_mean = minCharacterizationMean ) tryCatch( @@ -342,8 +343,9 @@ computeCaseSeriesAnalyses <- function( snakeCaseToCamelCase = TRUE ) - result$targetSettings <- targetIds - result$caseSettings <- caseIds + # TODO Removed + ##result$targetSettings <- targetIds + ##result$caseSettings <- caseIds completionTime <- Sys.time() - start message(paste0("Case series analysis: Downloading took ", round(completionTime, digits = 1), " ", units(completionTime))) @@ -403,9 +405,7 @@ getCaseSeriesJobs <- function( FUN = function(outcomeId){ data.frame( - targetId = unique(characterizationSettings[[i]]$targetIds), - limitToFirstInNDays = characterizationSettings[[i]]$limitToFirstInNDays, - minPriorObservation = characterizationSettings[[i]]$minPriorObservation, + characterizationTargetId = unique(characterizationSettings[[i]]$characterizationTargetIds), outcomeId = outcomeId, outcomeWashoutDays = unique(characterizationSettings[[i]]$outcomeWashoutDays), @@ -428,10 +428,9 @@ getCaseSeriesJobs <- function( settings <- c() if(nrow(caseSeriesCombinations) > 0 ){ - jobCols <- c("targetId") + jobCols <- c("characterizationTargetId") settingCols <- c( - "limitToFirstInNDays", "minPriorObservation", "outcomeWashoutDays", "riskWindowStart", "startAnchor", "riskWindowEnd", "endAnchor", @@ -469,10 +468,8 @@ getCaseSeriesJobs <- function( functionName = "computeCaseSeriesAnalyses", settings = as.character(ParallelLogger::convertSettingsToJson( list( - targetIds = unique(restrictedData$targetId[ind]), + characterizationTargetIds = unique(restrictedData$characterizationTargetId[ind]), outcomeIds = unique(restrictedData$outcomeId[ind]), - minPriorObservation = unique(restrictedData$minPriorObservation[ind]), - limitToFirstInNDays = unique(restrictedData$limitToFirstInNDays[ind]), outcomeWashoutDays = unique(restrictedData$outcomeWashoutDays[ind]), riskWindowStart = unique(restrictedData$riskWindowStart[ind]), diff --git a/R/CohortGeneration.R b/R/CohortGeneration.R index 15faf64..02ae543 100644 --- a/R/CohortGeneration.R +++ b/R/CohortGeneration.R @@ -10,6 +10,8 @@ generateCohorts <- function( targetTable, outcomeDatabaseSchema, outcomeTable, + nestingCohortDatabaseSchema = targetDatabaseSchema, + nestingCohortTable = targetTable, outputDatabaseSchema = targetDatabaseSchema, outputTable = 'characterization_cohort', cdmDatabaseSchema, @@ -25,9 +27,16 @@ generateCohorts <- function( # tables names characterizationTableWithHash <- paste0(outputTable, '_',settingHash, '_', dbHash) + outcomeEraTableWithHash <- paste0('outcome_era', '_',settingHash, '_', dbHash) + targetSettingsTableWithHash <- paste0('target_settings', '_',settingHash, '_', dbHash) + targetAttritionTableWithHash <- paste0('target_attrition', '_',settingHash, '_', dbHash) + targetCountTableWithHash <- paste0('target_count', '_',settingHash, '_', dbHash) + caseSettingsTableWithHash <- paste0('case_settings', '_',settingHash, '_', dbHash) - attritionTableWithHash <- paste0('attrition', '_',settingHash, '_', dbHash) + caseAttritionTableWithHash <- paste0('case_attrition', '_',settingHash, '_', dbHash) + caseCountTableWithHash <- paste0('case_count', '_',settingHash, '_', dbHash) + cohortJobs <- getCohortJobs( characterizationSettings, @@ -58,12 +67,13 @@ generateCohorts <- function( # upload settings: # 1) target_settings cohortJobs$targets if(!is.null(cohortJobs$targets)){ + DatabaseConnector::insertTable( connection = connection, databaseSchema = outputDatabaseSchema, tableName = targetSettingsTableWithHash, - dropTableIfExists = TRUE, - createTable = TRUE, + dropTableIfExists = TRUE, # changed from FALSE, + createTable = TRUE, # changed from FALSE, data = cohortJobs$targets, camelCaseToSnakeCase = TRUE, progressBar = progressBar @@ -94,7 +104,11 @@ generateCohorts <- function( tempEmulationSchema = tempEmulationSchema, characterization_schema = outputDatabaseSchema, characterization_table = characterizationTableWithHash, - attrition_table = attritionTableWithHash + target_attrition_table = targetAttritionTableWithHash, + target_count_table = targetCountTableWithHash, + case_attrition_table = caseAttritionTableWithHash, + case_count_table = caseCountTableWithHash, + outcome_era_table = outcomeEraTableWithHash ) DatabaseConnector::executeSql(connection, sql, progressBar = progressBar) @@ -113,7 +127,7 @@ generateCohorts <- function( x = tracker ) - } else{ + } else{ # replace with readr read? tracker <- utils::read.csv(file.path(executionPath,'cohort_job_tracker.csv')) } @@ -134,7 +148,11 @@ generateCohorts <- function( tempEmulationSchema = tempEmulationSchema, characterization_schema = outputDatabaseSchema, characterization_table = characterizationTableWithHash, - attrition_table = attritionTableWithHash + target_attrition_table = targetAttritionTableWithHash, + target_count_table = targetCountTableWithHash, + case_attrition_table = caseAttritionTableWithHash, + case_count_table = caseCountTableWithHash, + outcome_era_table = outcomeEraTableWithHash ) DatabaseConnector::executeSql(connection, sql, progressBar = progressBar) @@ -161,7 +179,10 @@ generateCohorts <- function( connectionDetails = connectionDetails, cdmDatabaseSchema = cdmDatabaseSchema, characterizationTable = characterizationTableWithHash, - attritionTable = attritionTableWithHash, + targetAttritionTable = targetAttritionTableWithHash, + caseAttritionTable = caseAttritionTableWithHash, + targetCountTable = targetCountTableWithHash, + caseCountTable = caseCountTableWithHash, targetSettingsTable = targetSettingsTableWithHash, caseSettingsTable = caseSettingsTableWithHash, characterizationDatabaseSchema = outputDatabaseSchema, @@ -170,6 +191,8 @@ generateCohorts <- function( targetTable = targetTable, outcomeDatabaseSchema = outcomeDatabaseSchema, outcomeTable = outcomeTable, + nestingCohortDatabaseSchema = nestingCohortDatabaseSchema, + nestingCohortTable = nestingCohortTable, incremental = incremental, mode = mode, @@ -180,7 +203,10 @@ generateCohorts <- function( executionPath = executionPath, settings = ParallelLogger::convertJsonToSettings(cohortJobs$jobs[i,"settings"]), - jobId = cohortJobs$jobs[i, "jobId"] + jobId = cohortJobs$jobs[i, "jobId"], + + outcomeEraTable = outcomeEraTableWithHash + ) } @@ -200,7 +226,11 @@ return(list( characterizationTable = characterizationTableWithHash, targetSettingsTable = targetSettingsTableWithHash, caseSettingsTable = caseSettingsTableWithHash, - attritionTable = attritionTableWithHash + targetAttritionTable = targetAttritionTableWithHash, + caseAttritionTable = caseAttritionTableWithHash, + targetCountTable = targetCountTableWithHash, + caseCountTable = caseCountTableWithHash, + outcomeEraTable = outcomeEraTableWithHash ) ) } @@ -226,60 +256,16 @@ runCohortGenerationInParallel <- function(x){ getCohortJobs <- function( characterizationSettings, mode, - nTargetJobs # not currently used + nTargetJobs ){ message('Extracting cohort jobs') - targets <- c() + targets <- characterizationSettings$characterizationTargetLookup cases <- c() - # Extracting Target Baseline targets - if(!is.null(characterizationSettings$targetBaselineSettings)){ - - tempTargets <- do.call( - what = 'rbind', - args = lapply( - X = characterizationSettings$targetBaselineSettings, - FUN = function(x){ - data.frame( - targetId = x$targetIds, - limitToFirstInNDays = x$limitToFirstInNDays, - minPriorObservation = x$minPriorObservation - ) - } - ) - ) - - targets <- rbind( - targets, - tempTargets - ) - - } - - # Extracting Risk Factor targets and cases if(!is.null(characterizationSettings$riskFactorSettings)){ - tempTargets <- do.call( - what = 'rbind', - args = lapply( - X = characterizationSettings$riskFactorSettings, - FUN = function(x){ - data.frame( - targetId = x$targetIds, - limitToFirstInNDays = x$limitToFirstInNDays, - minPriorObservation = x$minPriorObservation - ) - } - ) - ) - - targets <- rbind( - targets, - tempTargets - ) - tempCases <- do.call( what = 'rbind', args = lapply( @@ -288,19 +274,18 @@ getCohortJobs <- function( do.call( what = 'rbind', lapply( - X = unique(x$targetIds), + X = unique(x$characterizationTargetIds), FUN = function(y){ data.frame( - targetId = y, - limitToFirstInNDays = x$limitToFirstInNDays, - minPriorObservation = x$minPriorObservation, + characterizationTargetId = y, outcomeId = x$outcomeIds, outcomeWashoutDays = x$outcomeWashoutDays, riskWindowStart = x$riskWindowStart, startAnchor = x$startAnchor, riskWindowEnd = x$riskWindowEnd, endAnchor = x$endAnchor, - runtype = 'risk-factor' + riskFactorSettings = 1, + caseSeriesSettings = 0 ) } ) @@ -319,25 +304,6 @@ getCohortJobs <- function( # Extracting Case Series cases if(!is.null(characterizationSettings$caseSeriesSettings)){ - tempTargets <- do.call( - what = 'rbind', - args = lapply( - X = characterizationSettings$caseSeriesSettings, - FUN = function(x){ - data.frame( - targetId = x$targetIds, - limitToFirstInNDays = x$limitToFirstInNDays, - minPriorObservation = x$minPriorObservation - ) - } - ) - ) - - targets <- rbind( - targets, - tempTargets - ) - tempCases <- do.call( what = 'rbind', args = lapply( @@ -346,19 +312,18 @@ getCohortJobs <- function( do.call( what = 'rbind', lapply( - X = unique(x$targetIds), + X = unique(x$characterizationTargetIds), FUN = function(y){ data.frame( - targetId = y, - limitToFirstInNDays = x$limitToFirstInNDays, - minPriorObservation = x$minPriorObservation, + characterizationTargetId = y, outcomeId = x$outcomeIds, outcomeWashoutDays = x$outcomeWashoutDays, riskWindowStart = x$riskWindowStart, startAnchor = x$startAnchor, riskWindowEnd = x$riskWindowEnd, endAnchor = x$endAnchor, - runtype = 'case-series' + riskFactorSettings = 0, + caseSeriesSettings = 1 ) } ) @@ -379,25 +344,28 @@ getCohortJobs <- function( if(!is.null(nrow(targets))){ jobCols <- c("targetId") + settingsCols <- c("limitToFirstInNDays", "minPriorObservation", + "nestingCohortId", "minAge", "maxAge", + "studyStart", "studyEnd", "genderConceptIds") jobSettings <- targets %>% + dplyr::ungroup() %>% dplyr::select(dplyr::all_of(jobCols)) %>% dplyr::distinct() + jobSettings$nTargetJobs <- rep(1:nTargetJobs, ceiling(nrow(jobSettings) / nTargetJobs))[1:nrow(jobSettings)] targets <- merge(targets, jobSettings, by = jobCols) targets <- unique(targets) %>% dplyr::inner_join( y = targets %>% - dplyr::distinct(.data$limitToFirstInNDays, .data$minPriorObservation) %>% - dplyr::arrange(.data$limitToFirstInNDays, .data$minPriorObservation) %>% + dplyr::select(dplyr::all_of(settingsCols)) %>% + dplyr::distinct() %>% + dplyr::arrange(dplyr::pick(dplyr::all_of(settingsCols))) %>% dplyr::mutate( settingId = dplyr::row_number() ), - by = c("limitToFirstInNDays", "minPriorObservation") - ) %>% - dplyr::mutate( - characterizationTargetId = dplyr::row_number()*10 + by = settingsCols ) @@ -407,7 +375,7 @@ getCohortJobs <- function( toi <- targets %>% dplyr::filter(.data$settingId == !!setId) - settingVal <- toi[1,c("limitToFirstInNDays", "minPriorObservation")] + settingVal <- toi[1,settingsCols] for (i in unique(toi$nTargetJobs)) { ind <- toi$nTargetJobs== i @@ -419,7 +387,13 @@ getCohortJobs <- function( settingId = setId, targetIds = unique(toi$targetId[ind]), limitToFirstInNDays = unique(toi$limitToFirstInNDays[ind]), - minPriorObservation = unique(toi$minPriorObservation[ind]) + minPriorObservation = unique(toi$minPriorObservation[ind]), + nestingCohortId = unique(toi$nestingCohortId[ind]), + minAge = unique(toi$minAge[ind]), + maxAge = unique(toi$maxAge[ind]), + studyStart = unique(toi$studyStart[ind]), + studyEnd = unique(toi$studyEnd[ind]), + genderConceptIds = unique(toi$genderConceptIds[ind]) ))), jobId = paste("targets",i, paste0(settingVal, collapse = "_"), sep = "_") )) @@ -429,17 +403,40 @@ getCohortJobs <- function( } + # add in job for outcome eras per washout + # only run if there are cases and mode is not Efficient + # since efficient mode doesnt need the outcomes + # THIS NEEDS TO BE RUN BEFOR NON-CASE generation + if(!is.null(nrow(cases))){ + if(mode != 'Efficient'){ + ooi <- unique(cases[, c('outcomeId', 'outcomeWashoutDays')]) + for(outcomeWashoutDay in unique(ooi$outcomeWashoutDays)){ + jobs <- rbind(jobs, data.frame( + functionName = 'generateOutcomeEras', + settings = as.character(ParallelLogger::convertSettingsToJson(list( + outcomeIds = ooi$outcomeId[ooi$outcomeWashoutDays == outcomeWashoutDay], + outcomeWashoutDays = outcomeWashoutDay + ) + )), + jobId = paste("outcome_eras",i,outcomeWashoutDay, sep = "_") + )) + } + } + } + + if(!is.null(nrow(cases))){ cases <- unique(cases) %>% dplyr::group_by( - .data$targetId,.data$limitToFirstInNDays, .data$minPriorObservation, + .data$characterizationTargetId, .data$outcomeWashoutDays, .data$outcomeId, .data$riskWindowStart,.data$startAnchor, .data$riskWindowEnd, .data$endAnchor ) %>% dplyr::summarize( - runtype = paste(.data$runtype, collapse = ',') + riskFactorSettings = max(.data$riskFactorSettings), + caseSeriesSettings = max(.data$caseSeriesSettings) ) %>% dplyr::ungroup() %>% dplyr::inner_join( @@ -457,16 +454,21 @@ getCohortJobs <- function( "riskWindowStart", "startAnchor", "riskWindowEnd", "endAnchor") ) %>% - dplyr::inner_join( - y = targets %>% - dplyr::select("characterizationTargetId", "targetId","limitToFirstInNDays", "minPriorObservation", "nTargetJobs"), - by = c("targetId","limitToFirstInNDays", "minPriorObservation") - ) %>% - dplyr::select(-"targetId",-"limitToFirstInNDays", -"minPriorObservation") %>% + dplyr::distinct() %>% dplyr::mutate( characterizationCaseId = dplyr::row_number() ) + # add nTargetJobs using characterizationTargetId + jobCols <- c("characterizationTargetId") + jobSettings <- cases %>% + dplyr::ungroup() %>% + dplyr::select(dplyr::all_of(jobCols)) %>% + dplyr::distinct() + + jobSettings$nTargetJobs <- rep(1:nTargetJobs, ceiling(nrow(jobSettings) / nTargetJobs))[1:nrow(jobSettings)] + cases <- merge(cases, jobSettings, by = jobCols) + message(paste0('Adding ', length(unique(cases$settingId))*length(unique(cases$nTargetJobs)) ,' Case Cohort Jobs containing ', nrow(cases), ' case cohorts')) nNonCase <- 0 @@ -493,8 +495,8 @@ getCohortJobs <- function( startAnchor = unique(coi$startAnchor[ind]), riskWindowEnd = unique(coi$riskWindowEnd[ind]), endAnchor = unique(coi$endAnchor[ind]), - generateRiskFactors = length(grep('risk-factor', unique(coi$runtype[ind]))) > 0 , - generateCaseSeries = length(grep('case-series', unique(coi$runtype[ind]))) > 0 + generateRiskFactors = max(coi$riskFactorSettings[ind]) , + generateCaseSeries = max(coi$caseSeriesSettings[ind]) ) )), jobId = paste("cases",i, paste0(settingVal, collapse = "_"), sep = "_") @@ -502,7 +504,8 @@ getCohortJobs <- function( if(mode != 'Efficient'){ - if(length(grep('risk-factor', unique(coi$runtype[ind]))) > 0){ + + if(max(coi$riskFactorSettings[ind]) == 1){ nNonCase <- nNonCase + 1 jobs <- rbind(jobs, data.frame( functionName = 'generateNonCases', @@ -528,6 +531,7 @@ getCohortJobs <- function( } + # removing nTargetJobs if(!is.null(nrow(targets))){ targets <- targets %>% dplyr::select(-"nTargetJobs") @@ -551,7 +555,8 @@ generateTargets <- function( connectionDetails, cdmDatabaseSchema, characterizationTable, - attritionTable, + targetAttritionTable, + targetCountTable, targetSettingsTable, characterizationDatabaseSchema, tempEmulationSchema, @@ -559,6 +564,8 @@ generateTargets <- function( targetTable, outcomeDatabaseSchema, outcomeTable, + nestingCohortDatabaseSchema, + nestingCohortTable, progressBar = interactive(), executionPath, settings, @@ -582,16 +589,28 @@ generateTargets <- function( characterization_schema = characterizationDatabaseSchema, characterization_table = characterizationTable, - attrition_table = attritionTable, + target_attrition_table = targetAttritionTable, + target_count_table = targetCountTable, target_settings_schema = characterizationDatabaseSchema, target_settings_table = targetSettingsTable, limit_to_first_in_n_days = settings$limitToFirstInNDays, min_prior_observation = settings$minPriorObservation, + nesting_cohort_id = settings$nestingCohortId, + min_age = settings$minAge, + max_age = settings$maxAge, + gender_concept_ids = settings$genderConceptIds, + study_start = settings$studyStart, + study_end = settings$studyEnd, + cohort_ids = paste0(settings$targetIds, collapse = ','), cohort_schema = targetDatabaseSchema, cohort_table = targetTable, + + nesting_schema = nestingCohortDatabaseSchema, + nesting_table = nestingCohortTable, + cdm_database_schema = cdmDatabaseSchema ) @@ -624,7 +643,8 @@ generateCases <- function( connectionDetails, cdmDatabaseSchema, characterizationTable, - attritionTable, + caseAttritionTable, + caseCountTable, targetSettingsTable, caseSettingsTable, characterizationDatabaseSchema, @@ -658,7 +678,8 @@ generateCases <- function( characterization_schema = characterizationDatabaseSchema, characterization_table = characterizationTable, - attrition_table = attritionTable, + #case_attrition_table = caseAttritionTable, + case_count_table = caseCountTable, case_settings_schema = characterizationDatabaseSchema, case_settings_table = caseSettingsTable, @@ -706,7 +727,9 @@ generateNonCases <- function( connectionDetails, cdmDatabaseSchema, characterizationTable, - attritionTable, + outcomeEraTable, + caseAttritionTable, + caseCountTable, targetSettingsTable, caseSettingsTable, characterizationDatabaseSchema, @@ -738,12 +761,14 @@ generateNonCases <- function( characterization_schema = characterizationDatabaseSchema, characterization_table = characterizationTable, - attrition_table = attritionTable, + case_attrition_table = caseAttritionTable, + case_count_table = caseCountTable, case_settings_schema = characterizationDatabaseSchema, case_settings_table = caseSettingsTable, outcome_cohort_ids = paste0(settings$outcomeIds, collapse = ','), characterization_target_ids = paste0(settings$characterizationTargetIds, collapse = ','), + outcome_era_table = outcomeEraTable, outcome_washout = settings$outcomeWashoutDays, risk_window_start = settings$riskWindowStart, start_anchor = settings$startAnchor, @@ -780,6 +805,73 @@ generateNonCases <- function( return(invisible(TRUE)) } +generateOutcomeEras <- function( + connectionDetails, + cdmDatabaseSchema, + characterizationTable, + caseAttritionTable, + caseCountTable, + targetSettingsTable, + caseSettingsTable, + characterizationDatabaseSchema, + tempEmulationSchema, + targetDatabaseSchema, + targetTable, + outcomeDatabaseSchema, + outcomeTable, + progressBar = interactive(), + executionPath, + settings, + jobId, + mode, + incremental, + outcomeEraTable, + ... +){ + + message(paste("Creating outcome eras for washout ", settings$outcomeWashoutDays)) + start <- Sys.time() + + connection <- DatabaseConnector::connect(connectionDetails) + on.exit(DatabaseConnector::disconnect(connection)) + + sql <- SqlRender::loadRenderTranslateSql( + sqlFilename = 'OutcomeEras.sql', + packageName = 'Characterization', + dbms = attributes(connection)$dbms, + tempEmulationSchema = tempEmulationSchema, + characterization_schema = characterizationDatabaseSchema, + outcome_era_table = outcomeEraTable, + outcome_ids = paste0(settings$outcomeIds, collapse = ','), + outcome_washout = settings$outcomeWashoutDays, + cohort_schema = outcomeDatabaseSchema, + cohort_table = outcomeTable + ) + + DatabaseConnector::executeSql( + connection = connection, + sql = sql, + progressBar = progressBar, + reportOverallTime = FALSE + ) + completionTime <- Sys.time() - start + + if(incremental){ + readr::write_csv( + file = file.path(executionPath,'cohort_job_tracker.csv'), + x = data.frame( + jobId = jobId, + completeDate = date() + ), + append = TRUE + ) + } + message(paste0("Creating Outcome Eras: took ", round(completionTime, digits = 1), " ", units(completionTime))) + + return(invisible(TRUE)) + +} + dropCohorts <- function( @@ -802,7 +894,12 @@ dropCohorts <- function( characterizationTableWithHash <- paste0(outputTable, '_',settingHash, '_', dbHash) targetSettingsTableWithHash <- paste0('target_settings', '_',settingHash, '_', dbHash) caseSettingsTableWithHash <- paste0('case_settings', '_',settingHash, '_', dbHash) - attritionTableWithHash <- paste0('attrition', '_',settingHash, '_', dbHash) + targetAttritionTableWithHash <- paste0('target_attrition', '_',settingHash, '_', dbHash) + caseAttritionTableWithHash <- paste0('case_attrition', '_',settingHash, '_', dbHash) + targetCountTableWithHash <- paste0('target_count', '_',settingHash, '_', dbHash) + caseCountTableWithHash <- paste0('case_count', '_',settingHash, '_', dbHash) + outcomeEraTableWithHash <- paste0('outcome_era', '_',settingHash, '_', dbHash) + sql <- SqlRender::loadRenderTranslateSql( sqlFilename = 'DropTargetCohortTable.sql', @@ -811,9 +908,13 @@ dropCohorts <- function( tempEmulationSchema = tempEmulationSchema, characterization_schema = outputDatabaseSchema, characterization_table = characterizationTableWithHash, - attrition_table = attritionTableWithHash, + target_attrition_table = targetAttritionTableWithHash, + case_attrition_table = caseAttritionTableWithHash, + target_count_table = targetCountTableWithHash, + case_count_table = caseCountTableWithHash, target_settings_table = targetSettingsTableWithHash, - case_settings_table = caseSettingsTableWithHash + case_settings_table = caseSettingsTableWithHash, + outcome_era_table = outcomeEraTableWithHash ) DatabaseConnector::executeSql(connection, sql, progressBar = progressBar) diff --git a/R/Database.R b/R/Database.R index 000e1f2..9e71648 100644 --- a/R/Database.R +++ b/R/Database.R @@ -81,7 +81,11 @@ createSqliteDatabase <- function( #' #conDet <- exampleOmopConnectionDetails() #' #' #tteSet <- createTimeToEventSettings( -#' #targetIds = c(1,2), +#' # studyPopulationSettings = createStudyPopulationSettings( +#' # targetIds = c(1,2), +#' # limitToFirstInNDays = 0, +#' # minPriorObservation = 0 +#' # ), #' # outcomeIds = 3 #' # ) #' @@ -327,9 +331,10 @@ migrateDataModel <- function( migrator$executeMigrations() migrator$finalize() - ParallelLogger::logInfo("Updating version number") + ParallelLogger::logInfo(paste0("Updating version number to ", utils::packageVersion("Characterization") )) updateVersionSql <- SqlRender::loadRenderTranslateSql("UpdateVersionNumber.sql", packageName = utils::packageName(), + version_number = utils::packageVersion("Characterization"), database_schema = databaseSchema, table_prefix = tablePrefix, dbms = connectionDetails$dbms diff --git a/R/DechallengeRechallenge.R b/R/DechallengeRechallenge.R index 18e9d04..2832d7e 100644 --- a/R/DechallengeRechallenge.R +++ b/R/DechallengeRechallenge.R @@ -16,7 +16,7 @@ #' Create dechallenge rechallenge study settings #' -#' @param targetIds A list of cohortIds for the target cohorts +#' @param studyPopulationSettings An object created using \code{createStudyPopulationSettings} of a list of \code{createStudyPopulationSettings} that specifies cohort inclusion criteria #' @param outcomeIds A list of cohortIds for the outcome cohorts #' @param dechallengeStopInterval An integer specifying the how much time to add to the cohort_end when determining whether the event starts during cohort and ends after #' @param dechallengeEvaluationWindow An integer specifying the period of time after the cohort_end when you cannot see an outcome for a dechallenge success @@ -27,24 +27,29 @@ #' #' @examples #' drSet <- createDechallengeRechallengeSettings( -#' targetIds = c(1,2), +#' studyPopulationSettings = createStudyPopulationSettings( +#' targetIds = c(1,2), +#' limitToFirstInNDays = 0, +#' minPriorObservation = 0 +#' ), #' outcomeIds = 3 #' ) #' #' #' @export createDechallengeRechallengeSettings <- function( - targetIds, + studyPopulationSettings, outcomeIds, dechallengeStopInterval = 30, - dechallengeEvaluationWindow = 30) { + dechallengeEvaluationWindow = 30 + ) { errorMessages <- checkmate::makeAssertCollection() # check targetIds is a vector of int/double - .checkCohortIds( - cohortIds = targetIds, - type = "target", - errorMessages = errorMessages - ) + #.checkCohortIds( + # cohortIds = targetIds, + # type = "target", + # errorMessages = errorMessages + #) # check outcomeIds is a vector of int/double .checkCohortIds( cohortIds = outcomeIds, @@ -78,8 +83,8 @@ createDechallengeRechallengeSettings <- function( # create data.frame with all combinations result <- list( - targetCohortDefinitionIds = targetIds, - outcomeCohortDefinitionIds = outcomeIds, + studyPopulationSettings = combineStudyPopulationSettings(studyPopulationSettings), + outcomeIds = outcomeIds, dechallengeStopInterval = dechallengeStopInterval, dechallengeEvaluationWindow = dechallengeEvaluationWindow ) @@ -88,47 +93,15 @@ createDechallengeRechallengeSettings <- function( return(result) } -#' Compute dechallenge rechallenge study -#' -#' @template ConnectionDetails -#' @template TargetOutcomeTables -#' @template TempEmulationSchema -#' @param settings The settings for the timeToEvent study -#' @param databaseId An identifier for the database (string) -#' @param outputFolder A directory to save the results as csv files -#' @param minCellCount The minimum cell value to display, values less than this will be replaced by -1 -#' @param progressBar Whether to display a progress bar while the analysis is running -#' @param ... extra inputs -#' @family DechallengeRechallenge -#' -#' @return -#' An \code{Andromeda::andromeda()} object containing the dechallenge rechallenge results -#' -#' @examples -#' -#' conDet <- exampleOmopConnectionDetails() -#' -#' drSet <- createDechallengeRechallengeSettings( -#' targetIds = c(1,2), -#' outcomeIds = 3 -#' ) -#' -#' computeDechallengeRechallengeAnalyses( -#' connectionDetails = conDet, -#' targetDatabaseSchema = 'main', -#' targetTable = 'cohort', -#' settings = drSet, -#' outputFolder = tempdir() -#' ) -#' -#' -#' @export + computeDechallengeRechallengeAnalyses <- function( connectionDetails = NULL, - targetDatabaseSchema, - targetTable, + targetDatabaseSchema, # not needed + targetTable, # not needed outcomeDatabaseSchema = targetDatabaseSchema, outcomeTable = targetTable, + characterizationDatabaseSchema, # updated + characterizationTable, # updated tempEmulationSchema = getOption("sqlRenderTempEmulationSchema"), settings, databaseId = "database 1", @@ -145,8 +118,8 @@ computeDechallengeRechallengeAnalyses <- function( errorMessages <- checkmate::makeAssertCollection() .checkConnectionDetails(connectionDetails, errorMessages) .checkCohortDetails( - cohortDatabaseSchema = targetDatabaseSchema, - cohortTable = targetTable, + cohortDatabaseSchema = characterizationDatabaseSchema, + cohortTable = characterizationTable, type = "target", errorMessages = errorMessages ) @@ -160,10 +133,10 @@ computeDechallengeRechallengeAnalyses <- function( tempEmulationSchema = tempEmulationSchema, errorMessages = errorMessages ) - .checkDechallengeRechallengeSettings( - settings = settings, - errorMessages = errorMessages - ) + #.checkDechallengeRechallengeSettings( + # settings = settings, + # errorMessages = errorMessages + #) valid <- checkmate::reportAssertions( collection = errorMessages @@ -189,12 +162,12 @@ computeDechallengeRechallengeAnalyses <- function( dbms = connection@dbms, tempEmulationSchema = tempEmulationSchema, database_id = databaseId, - target_database_schema = targetDatabaseSchema, - target_table = targetTable, + characterization_database_schema = characterizationDatabaseSchema, # updated + characterization_table = characterizationTable, # updated, outcome_database_schema = outcomeDatabaseSchema, outcome_table = outcomeTable, - target_ids = paste(settings$targetCohortDefinitionIds, sep = "", collapse = ","), - outcome_ids = paste(settings$outcomeCohortDefinitionIds, sep = "", collapse = ","), + characterization_target_ids = paste(settings$characterizationTargetIds, sep = "", collapse = ","), + outcome_ids = paste(settings$outcomeIds, sep = "", collapse = ","), dechallenge_stop_interval = settings$dechallengeStopInterval, dechallenge_evaluation_window = settings$dechallengeEvaluationWindow ) @@ -237,8 +210,8 @@ computeDechallengeRechallengeAnalyses <- function( message( paste0( "Computing dechallenge rechallenge for ", - length(settings$targetCohortDefinitionIds), " target ids and ", - length(settings$outcomeCohortDefinitionIds), " outcome ids took ", + length(settings$characterizationTargetIds), " target ids and ", + length(settings$outcomeIds), " outcome ids took ", signif(delta, 3), " ", attr(delta, "units") ) @@ -256,48 +229,15 @@ computeDechallengeRechallengeAnalyses <- function( } -#' Compute fine the subjects that fail the dechallenge rechallenge study -#' -#' @template ConnectionDetails -#' @template TargetOutcomeTables -#' @template TempEmulationSchema -#' @param settings The settings for the timeToEvent study -#' @param databaseId An identifier for the database (string) -#' @param showSubjectId if F then subject_ids are hidden (recommended if sharing results) -#' @param outputFolder A directory to save the results as csv files -#' @param minCellCount The minimum cell value to display, values less than this will be replaced by -1 -#' @param progressBar Whether to display a progress bar while the analysis is running -#' @param executionId a unique id for the run -#' @param ... extra inputs -#' @family DechallengeRechallenge -#' -#' @return -#' An \code{Andromeda::andromeda()} object with the case series details of the failed rechallenge -#' -#' @examples -#' -#' conDet <- exampleOmopConnectionDetails() -#' -#' drSet <- createDechallengeRechallengeSettings( -#' targetIds = c(1,2), -#' outcomeIds = 3 -#' ) -#' -#' computeRechallengeFailCaseSeriesAnalyses( -#' connectionDetails = conDet, -#' targetDatabaseSchema = 'main', -#' targetTable = 'cohort', -#' settings = drSet, -#' outputFolder = tempdir() -#' ) -#' -#' @export computeRechallengeFailCaseSeriesAnalyses <- function( connectionDetails = NULL, targetDatabaseSchema, targetTable, outcomeDatabaseSchema = targetDatabaseSchema, outcomeTable = targetTable, + characterizationDatabaseSchema, # updated + characterizationTable, # updated + targetSettingsTable, # added tempEmulationSchema = getOption("sqlRenderTempEmulationSchema"), settings, databaseId = "database 1", @@ -330,10 +270,10 @@ computeRechallengeFailCaseSeriesAnalyses <- function( tempEmulationSchema = tempEmulationSchema, errorMessages = errorMessages ) - .checkDechallengeRechallengeSettings( - settings = settings, - errorMessages = errorMessages - ) + #.checkDechallengeRechallengeSettings( + # settings = settings, + # errorMessages = errorMessages + #) valid <- checkmate::reportAssertions(errorMessages) @@ -350,6 +290,9 @@ computeRechallengeFailCaseSeriesAnalyses <- function( DatabaseConnector::disconnect(connection) ) + # TODO: lookup targetIds based on settings$studyPopulationSettings + + message("Computing dechallenge rechallenge fails results") sql <- SqlRender::loadRenderTranslateSql( sqlFilename = "RechallengeFailCaseSeries.sql", @@ -357,12 +300,15 @@ computeRechallengeFailCaseSeriesAnalyses <- function( dbms = connection@dbms, tempEmulationSchema = tempEmulationSchema, database_id = databaseId, + characterization_database_schema = characterizationDatabaseSchema, # updated + characterization_table = characterizationTable, # updated + target_settings = targetSettingsTable, #updated target_database_schema = targetDatabaseSchema, target_table = targetTable, outcome_database_schema = outcomeDatabaseSchema, outcome_table = outcomeTable, - target_ids = paste(settings$targetCohortDefinitionIds, sep = "", collapse = ","), - outcome_ids = paste(settings$outcomeCohortDefinitionIds, sep = "", collapse = ","), + characterization_target_ids = paste(settings$characterizationTargetIds, sep = "", collapse = ","), + outcome_ids = paste(settings$outcomeIds, sep = "", collapse = ","), dechallenge_stop_interval = settings$dechallengeStopInterval, dechallenge_evaluation_window = settings$dechallengeEvaluationWindow, show_subject_id = showSubjectId @@ -406,8 +352,8 @@ computeRechallengeFailCaseSeriesAnalyses <- function( message( paste0( "Computing dechallenge failed case series for ", - length(settings$targetCohortDefinitionIds), " target IDs and ", - length(settings$outcomeCohortDefinitionIds), " outcome IDs took ", + length(settings$characterizationTargetIds), " target IDs and ", + length(settings$outcomeIds), " outcome IDs took ", signif(delta, 3), " ", attr(delta, "units") ) @@ -432,11 +378,11 @@ getDechallengeRechallengeJobs <- function( return(NULL) } ind <- 1:length(characterizationSettings) - targetIds <- lapply(ind, function(i) { - characterizationSettings[[i]]$targetCohortDefinitionIds + characterizationTargetIds <- lapply(ind, function(i) { + characterizationSettings[[i]]$characterizationTargetIds }) outcomeIds <- lapply(ind, function(i) { - characterizationSettings[[i]]$outcomeCohortDefinitionIds + characterizationSettings[[i]]$outcomeIds }) dechallengeStopIntervals <- lapply(ind, function(i) { characterizationSettings[[i]]$dechallengeStopInterval @@ -451,10 +397,10 @@ getDechallengeRechallengeJobs <- function( what = "rbind", args = lapply( - 1:length(targetIds), + 1:length(characterizationTargetIds), function(i) { result <- expand.grid( - targetId = targetIds[[i]], + characterizationTargetId = characterizationTargetIds[[i]], outcomeId = outcomeIds[[i]] ) result$dechallengeStopInterval <- dechallengeStopIntervals[[i]] @@ -467,7 +413,7 @@ getDechallengeRechallengeJobs <- function( tcount <- nrow( combinations %>% dplyr::count( - .data$targetId, + .data$characterizationTargetId, .data$dechallengeStopInterval, .data$dechallengeEvaluationWindow ) @@ -490,12 +436,12 @@ getDechallengeRechallengeJobs <- function( if (tcount >= ocount) { threadDf <- combinations %>% dplyr::count( - .data$targetId, + .data$characterizationTargetId, .data$dechallengeStopInterval, .data$dechallengeEvaluationWindow ) threadDf$nTargetJobs <- rep(1:nTargetJobs, ceiling(tcount / nTargetJobs))[1:tcount] - mergeColumn <- c("targetId", "dechallengeStopInterval", "dechallengeEvaluationWindow") + mergeColumn <- c("characterizationTargetId", "dechallengeStopInterval", "dechallengeEvaluationWindow") } else { threadDf <- combinations %>% dplyr::count( @@ -508,43 +454,75 @@ getDechallengeRechallengeJobs <- function( } combinations <- merge(combinations, threadDf, by = mergeColumn) - sets <- lapply( - X = 1:max(threadDf$nTargetJobs), - FUN = function(i) { - createDechallengeRechallengeSettings( - targetIds = unique(combinations$targetId[combinations$nTargetJobs == i]), - outcomeIds = unique(combinations$outcomeId[combinations$nTargetJobs == i]), - dechallengeStopInterval = unique(combinations$dechallengeStopInterval[combinations$nTargetJobs == i]), - dechallengeEvaluationWindow = unique(combinations$dechallengeEvaluationWindow[combinations$nTargetJobs == i]) - ) - } - ) + + + # create settings based on dechallengeStopInterval/dechallengeEvaluationWindow + + settingCols <- c("dechallengeStopInterval", "dechallengeEvaluationWindow") + executionSettings <- combinations %>% + dplyr::select(dplyr::all_of(settingCols)) %>% + dplyr::distinct() %>% + dplyr::mutate( + settingId = dplyr::row_number() + ) + combinations <- merge(combinations, executionSettings, by = settingCols) + # recreate settings settings <- c() - for (i in 1:length(sets)) { - settings <- rbind( - settings, - data.frame( - functionName = "computeDechallengeRechallengeAnalyses", - settings = as.character(ParallelLogger::convertSettingsToJson( - sets[[i]] - )), - executionFolder = paste0("dr_", i), - jobId = paste0("dr_", i) + for (settingId in unique(combinations$settingId)) { + for (targetJobId in unique(combinations$nTargetJobs)){ + + restrictedCombo <- combinations %>% + dplyr::filter(.data$settingId == !!settingId) %>% + dplyr::filter(.data$nTargetJobs == !!targetJobId) + + + settings <- rbind( + settings, + data.frame( + functionName = "computeDechallengeRechallengeAnalyses", + settings = as.character(ParallelLogger::convertSettingsToJson( + list( + characterizationTargetIds = unique(restrictedCombo$characterizationTargetId), + outcomeIds = unique(restrictedCombo$outcomeId), + dechallengeStopInterval = unique(restrictedCombo$dechallengeStopInterval), + dechallengeEvaluationWindow = unique(restrictedCombo$dechallengeEvaluationWindow) + ) + )), + executionFolder = paste("dr", targetJobId, + unique(restrictedCombo$dechallengeStopInterval), + unique(restrictedCombo$dechallengeEvaluationWindow), + sep = '_'), + jobId = paste("dr", targetJobId, + unique(restrictedCombo$dechallengeStopInterval), + unique(restrictedCombo$dechallengeEvaluationWindow), + sep = '_') + ) ) - ) - settings <- rbind( - settings, - data.frame( - functionName = "computeRechallengeFailCaseSeriesAnalyses", - settings = as.character(ParallelLogger::convertSettingsToJson( - sets[[i]] - )), - executionFolder = paste0("rfcs_", i), - jobId = paste0("rfcs_", i) + settings <- rbind( + settings, + data.frame( + functionName = "computeRechallengeFailCaseSeriesAnalyses", + settings = as.character(ParallelLogger::convertSettingsToJson( + list( + characterizationTargetIds = unique(restrictedCombo$characterizationTargetId), + outcomeIds = unique(restrictedCombo$outcomeId), + dechallengeStopInterval = unique(restrictedCombo$dechallengeStopInterval), + dechallengeEvaluationWindow = unique(restrictedCombo$dechallengeEvaluationWindow) + ) + )), + executionFolder = paste("rfcs", targetJobId, + unique(restrictedCombo$dechallengeStopInterval), + unique(restrictedCombo$dechallengeEvaluationWindow), + sep = '_'), + jobId = paste("rfcs", targetJobId, + unique(restrictedCombo$dechallengeStopInterval), + unique(restrictedCombo$dechallengeEvaluationWindow), + sep = '_') + ) ) - ) + } } return(settings) diff --git a/R/ExportingCsvFiles.R b/R/ExportingCsvFiles.R index 0e04d11..08135cd 100644 --- a/R/ExportingCsvFiles.R +++ b/R/ExportingCsvFiles.R @@ -508,208 +508,119 @@ exportAttrition <- function( minCellCount = 0 ){ - # load attrition - if(file.exists(file.path(executionPath, 'attrition', 'result'))){ - andromeda <- Andromeda::loadAndromeda(file.path(executionPath, 'attrition', 'result')) + # export target attrition + if(file.exists(file.path(executionPath, 'target_attrition', 'result'))){ + andromeda <- Andromeda::loadAndromeda(file.path(executionPath, 'target_attrition', 'result')) - # load case series - if(file.exists(file.path(outputFolder, paste0(csvFilePrefix, 'case_settings', '.csv')))){ - andromeda$caseSettings <- utils::read.csv(file.path(outputFolder, paste0(csvFilePrefix, 'case_settings', '.csv'))) - } - - # load targets - if(file.exists(file.path(outputFolder, paste0(csvFilePrefix, 'target_settings', '.csv')))){ - andromeda$targetSettings <- utils::read.csv(file.path(outputFolder, paste0(csvFilePrefix, 'target_settings', '.csv'))) - } - - # if no case or target settings then return - if(is.null(andromeda$caseSettings) & is.null(andromeda$targetSettings)){ - message('No target and/or case setting found but these are required to process attrition') - return(invisible(FALSE)) - } + # censor + data <- andromeda$target_attrition %>% dplyr::mutate( + nEvents = ifelse(.data$nEvents < !!minCellCount & .data$nEvents > 0, -1*minCellCount, .data$nEvents), + nPeople = ifelse(.data$nPeople < !!minCellCount & .data$nPeople > 0, -1*minCellCount, .data$nPeople) + ) %>% + dplyr::collect() - # process the attrition into useful numbers with minCellCount - - if(is.null(andromeda$caseSettings) & !is.null(andromeda$targetSettings)){ - message('Found targets only to do attrition for...') + colnames(data) <- SqlRender::camelCaseToSnakeCase(colnames(data)) - targets <- andromeda$attrition %>% - dplyr::inner_join( - y = andromeda$targetSettings %>% - dplyr::mutate( - cohortDefinitionId = .data$characterization_target_id, - databaseId = .data$database_id, - settingId = .data$setting_id - ), - by = c("cohortDefinitionId", "databaseId", "settingId") + # save the attrition + utils::write.csv( + x = data, + file = file.path(outputFolder, paste0(csvFilePrefix, 'target_attrition', '.csv')), + row.names = FALSE ) + } - # apply censoring - targets <- targets %>% - dplyr::mutate( - n = ifelse(.data$n < !!minCellCount, -1*minCellCount, .data$n) - ) %>% - dplyr::select("cohortDefinitionId", "attrReason", "n", "databaseId", "settingId") + # export case attrition + if(file.exists(file.path(executionPath, 'case_attrition', 'result'))){ + andromeda <- Andromeda::loadAndromeda(file.path(executionPath, 'case_attrition', 'result')) - andromeda$attritionProcessed <- targets + # censor + data <- andromeda$case_attrition %>% dplyr::mutate( + nEvents = ifelse(.data$nEvents < !!minCellCount & .data$nEvents > 0, -1*minCellCount, .data$nEvents), + nPeople = ifelse(.data$nPeople < !!minCellCount & .data$nPeople > 0, -1*minCellCount, .data$nPeople) + ) %>% + dplyr::collect() - } + colnames(data) <- SqlRender::camelCaseToSnakeCase(colnames(data)) - if(!is.null(andromeda$caseSettings) & !is.null(andromeda$targetSettings)){ - message('Found cases and targets to do attrition for...') - - targets <- andromeda$attrition %>% - dplyr::inner_join( - y = andromeda$targetSettings %>% - dplyr::mutate( - cohortDefinitionId = .data$characterization_target_id, - databaseId = .data$database_id, - settingId = .data$setting_id - ), - by = c("cohortDefinitionId", "databaseId", "settingId") - ) + # save the attrition + utils::write.csv( + x = data, + file = file.path(outputFolder, paste0(csvFilePrefix, 'case_attrition', '.csv')), + row.names = FALSE + ) + } - cases <- andromeda$attrition %>% - dplyr::inner_join( - andromeda$caseSettings %>% - dplyr::mutate( - cohortDefinitionId = .data$characterization_case_id*10+1, - databaseId = .data$database_id, - settingId = .data$setting_id - ), - by = c("cohortDefinitionId", "databaseId", "settingId") - ) + return(invisible(TRUE)) +} - nonCases <- cases %>% - dplyr::mutate( - n_cases = .data$n, - targetDefinitionId = .data$characterization_target_id - ) %>% - dplyr::select("cohortDefinitionId","targetDefinitionId", "databaseId", "settingId", "n_cases") %>% - dplyr::inner_join( - targets %>% - dplyr::mutate( - n_targets = .data$n, - targetDefinitionId = .data$cohortDefinitionId - ) %>% - dplyr::select("targetDefinitionId","databaseId", "settingId", "n_targets"), - by = c("targetDefinitionId", "databaseId", "settingId") - ) %>% - dplyr::left_join( - andromeda$attrition %>% - dplyr::mutate( - cohortDefinitionId = .data$cohortDefinitionId-1, - n_excludes = .data$n - ) %>% - dplyr::select( - "cohortDefinitionId","databaseId", "settingId", "n_excludes" - ), - by = c("cohortDefinitionId","databaseId","settingId") - ) %>% - dplyr::select(-"targetDefinitionId") %>% - dplyr::group_by( - .data$cohortDefinitionId,.data$databaseId, .data$settingId - ) %>% - dplyr::summarise( - n_cases = max(.data$n_cases, na.rm = TRUE), - n_non_cases = max(.data$n_targets, na.rm = TRUE) - sum(.data$n_excludes, na.rm = TRUE), - n_excluded = sum(.data$n_excludes, na.rm = TRUE) - ) - # apply censoring - targets <- targets %>% - dplyr::mutate( - n = ifelse(.data$n < !!minCellCount, -1*minCellCount, .data$n) - ) %>% - dplyr::select("cohortDefinitionId", "attrReason", "n", "databaseId", "settingId") +exportCounts <- function( + executionPath, + outputFolder, + csvFilePrefix = 'c_', + minCellCount = 0 +){ - andromeda$attritionProcessed <- targets + # export target attrition + if(file.exists(file.path(executionPath, 'target_counts', 'result'))){ + andromeda <- Andromeda::loadAndromeda(file.path(executionPath, 'target_counts', 'result')) + # censor + data <- andromeda$target_counts %>% dplyr::mutate( + nEvents = ifelse(.data$nEvents < !!minCellCount & .data$nEvents > 0, -1*minCellCount, .data$nEvents), + nPeople = ifelse(.data$nPeople < !!minCellCount & .data$nPeople > 0, -1*minCellCount, .data$nPeople) + ) %>% + dplyr::collect() - cases <- cases %>% - dplyr::mutate( - n = ifelse(.data$n < !!minCellCount, -1*minCellCount, .data$n) - ) %>% - dplyr::select("cohortDefinitionId", "attrReason", "n", "databaseId", "settingId") - Andromeda::appendToTable( - tbl = andromeda$attritionProcessed, - data = cases - ) + colnames(data) <- SqlRender::camelCaseToSnakeCase(colnames(data)) - nonCasesTemp <- nonCases %>% - dplyr::mutate( - cohortDefinitionId = .data$cohortDefinitionId+1, - attrReason = 'Non-cases', - n = ifelse(.data$n_non_cases < !!minCellCount, -1*minCellCount, .data$n_non_cases) - ) %>% - dplyr::select("cohortDefinitionId", "attrReason", "n", "databaseId", "settingId") + # save the attrition + utils::write.csv( + x = data, + file = file.path(outputFolder, paste0(csvFilePrefix, 'target_counts', '.csv')), + row.names = FALSE + ) + } - Andromeda::appendToTable( - tbl = andromeda$attritionProcessed, - data = nonCasesTemp - ) + # export case attrition + if(file.exists(file.path(executionPath, 'case_counts', 'result'))){ + andromeda <- Andromeda::loadAndromeda(file.path(executionPath, 'case_counts', 'result')) + + # censor if the cases or non-cases are < min count + remove <- andromeda$case_counts %>% dplyr::filter( + .data$nEvents < !!minCellCount & .data$nEvents > 0, + .data$nPeople < !!minCellCount & .data$nPeople > 0 + ) %>% + dplyr::select("characterizationCaseId") %>% + dplyr::distinct() %>% + dplyr::mutate( + filter = TRUE + ) %>% + dplyr::collect() - excluded <- nonCases %>% - dplyr::mutate( - cohortDefinitionId = .data$cohortDefinitionId+1, - attrReason = 'Total excluded', - n = ifelse(.data$n_excluded < !!minCellCount, -1*minCellCount, .data$n_excluded) + data <- andromeda$case_counts %>% + dplyr::left_join( + y = remove, + by = "characterizationCaseId", + copy = TRUE ) %>% - dplyr::select("cohortDefinitionId", "attrReason", "n", "databaseId", "settingId") - - Andromeda::appendToTable( - tbl = andromeda$attritionProcessed, - data = excluded - ) - - # individual exlcusions that all above minCellCount - - exclusionIds <- excluded %>% - dplyr::select("cohortDefinitionId") %>% - dplyr::pull() - - excludedIndividual <- as.data.frame(andromeda$attrition %>% - dplyr::filter(.data$cohortDefinitionId %in% !!exclusionIds)) - - if(nrow(excludedIndividual) > 0 ){ - - cohortDefinitionIdsToUncensor <- excludedIndividual %>% - dplyr::group_by( - .data$cohortDefinitionId, .data$databaseId, .data$settingId - ) %>% - dplyr::summarise( - uncensor = sum(.data$n > !!minCellCount, na.rm = TRUE) == dplyr::n() - ) %>% - dplyr::filter(.data$uncensor) %>% - dplyr::select("cohortDefinitionId") %>% - dplyr::pull() - - if(length(cohortDefinitionIdsToUncensor) > 0){ - extras <- andromeda$attrition %>% - dplyr::filter(.data$cohortDefinitionId %in% !!cohortDefinitionIdsToUncensor) %>% - dplyr::select("cohortDefinitionId", "attrReason", "n", "databaseId", "settingId") - - Andromeda::appendToTable( - tbl = andromeda$attritionProcessed, - data = extras - ) - } - - } - - } + dplyr::mutate(filter = dplyr::if_else(is.na(.data$filter), FALSE,.data$filter)) %>% + dplyr::mutate( + nEvents = ifelse(.data$filter, NA, .data$nEvents), + nPeople = ifelse(.data$filter, NA, .data$nPeople) + ) %>% + dplyr::select(-"filter") %>% + dplyr::collect() - # change the column format - data <- as.data.frame(andromeda$attritionProcessed) colnames(data) <- SqlRender::camelCaseToSnakeCase(colnames(data)) # save the attrition utils::write.csv( x = data, - file = file.path(outputFolder, paste0(csvFilePrefix, 'attrition', '.csv')), + file = file.path(outputFolder, paste0(csvFilePrefix, 'case_counts', '.csv')), row.names = FALSE - ) + ) } return(invisible(TRUE)) diff --git a/R/HelperFunctions.R b/R/HelperFunctions.R index 16a44d7..a7a0a69 100644 --- a/R/HelperFunctions.R +++ b/R/HelperFunctions.R @@ -14,7 +14,6 @@ # See the License for the specific language governing permissions and # limitations under the License. - createExecutionIds <- function(size) { executionIds <- gsub(" ", "", gsub("[[:punct:]]", "", paste(Sys.time(), sample(1000000, size), sep = ""))) return(executionIds) diff --git a/R/LookupCohortSettings.R b/R/LookupCohortSettings.R index 82e42e5..b7cd270 100644 --- a/R/LookupCohortSettings.R +++ b/R/LookupCohortSettings.R @@ -1,55 +1,39 @@ -lookupTargets <- function( - connection, - lookupDatabaseSchema, - lookupTableName, - tempEmulationSchema, - targetIds = NULL, - limitToFirstInNDays = NULL, - minPriorObservation = NULL, - characterizationTargetId = NULL +minSizeCharacterizationIds <- function( + connection, + tempEmulationSchema, + characterizationTargetIds, + minTargetSize, + cohortDatabaseSchema, + targetCountTable ){ - sql <- " - SELECT - characterization_target_id, - target_id, - limit_to_first_in_n_days, - min_prior_observation - - FROM @lookup_schema.@lookup_table lt - {@use_char_id}?{ - WHERE lt.characterization_target_id in (@char_ids); - }:{ - WHERE lt.target_id in (@target_ids) - AND lt.limit_to_first_in_n_days = @limit_to_first_in_n_days - AND lt.min_prior_observation = @min_prior_observation; - } - " + sql <- "SELECT characterization_target_id + FROM @characterization_schema.@target_count_table + WHERE n_people >= @min_target_size + AND characterization_target_id in (@characterization_target_ids); + " sql <- SqlRender::render( sql = sql, - lookup_schema = lookupDatabaseSchema, - lookup_table = lookupTableName, - target_ids = paste0(targetIds, collapse = ','), - limit_to_first_in_n_days = limitToFirstInNDays, - min_prior_observation = minPriorObservation, - use_char_id = !is.null(characterizationTargetId), - char_ids = paste0(characterizationTargetId, collapse = ',') - ) + characterization_schema = cohortDatabaseSchema, + target_count_table = targetCountTable, + min_target_size = minTargetSize, + characterization_target_ids = paste0(characterizationTargetIds, collapse = ',') + ) sql <- SqlRender::translate( sql = sql, targetDialect = attributes(connection)$dbms, tempEmulationSchema = tempEmulationSchema - ) + ) - lookup <- DatabaseConnector::querySql( + res <- DatabaseConnector::querySql( connection = connection, sql = sql, snakeCaseToCamelCase = TRUE - ) + ) - return(lookup) + return(res) } @@ -57,6 +41,7 @@ lookupCases <- function( connection, lookupDatabaseSchema, lookupTableName, + countTable, # new tempEmulationSchema = tempEmulationSchema, characterizationTargetIds, outcomeIds, @@ -64,12 +49,14 @@ lookupCases <- function( startAnchor, riskWindowStart, endAnchor, - riskWindowEnd + riskWindowEnd, + minCaseSize = 0, # new + applyMinSizeToNonCases = FALSE ){ sql <- " SELECT - characterization_case_id, + lt.characterization_case_id, characterization_target_id, outcome_id, outcome_washout_days, @@ -79,26 +66,49 @@ lookupCases <- function( risk_window_end FROM @lookup_schema.@lookup_table lt - WHERE characterization_target_id in (@char_ids) - AND outcome_id in (@outcome_ids) - AND outcome_washout_days = @outcome_washout_days - AND start_anchor = '@start_anchor' - AND risk_window_start = @risk_window_start - AND end_anchor = '@end_anchor' - AND risk_window_end = @risk_window_end; + + INNER JOIN + (SELECT * FROM @lookup_schema.@case_count_table + WHERE cohort_type = 'Cases' + AND n_people >= @min_case_size + ) cct + ON lt.characterization_case_id = cct.characterization_case_id + + +{@non_case_min}?{ + INNER JOIN + + (SELECT * FROM @lookup_schema.@case_count_table + WHERE cohort_type = 'non-cases' + AND n_people >= @min_case_size + ) ncct + ON lt.characterization_case_id = ncct.characterization_case_id +} + + WHERE lt.characterization_target_id in (@char_ids) + AND lt.outcome_id in (@outcome_ids) + AND lt.outcome_washout_days = @outcome_washout_days + AND lt.start_anchor = '@start_anchor' + AND lt.risk_window_start = @risk_window_start + AND lt.end_anchor = '@end_anchor' + AND lt.risk_window_end = @risk_window_end + ; " sql <- SqlRender::render( sql = sql, lookup_schema = lookupDatabaseSchema, lookup_table = lookupTableName, + case_count_table = countTable, char_ids = paste0(characterizationTargetIds, collapse = ','), outcome_ids = paste0(outcomeIds, collapse = ','), outcome_washout_days = outcomeWashoutDays, start_anchor = startAnchor, risk_window_start = riskWindowStart, end_anchor = endAnchor, - risk_window_end = riskWindowEnd + risk_window_end = riskWindowEnd, + min_case_size = minCaseSize, + non_case_min = applyMinSizeToNonCases ) sql <- SqlRender::translate( diff --git a/R/RiskFactorAnalysis.R b/R/RiskFactorAnalysis.R index 31506f8..1004102 100644 --- a/R/RiskFactorAnalysis.R +++ b/R/RiskFactorAnalysis.R @@ -16,15 +16,11 @@ #' Create risk factor study settings #' -#' @param targetIds A list of cohortIds for the target cohorts +#' @param studyPopulationSettings A list of objects created using \code{createStudyPopulationSettings} that specifies target cohorts and inclusion criteria #' @param outcomeIds A list of cohortIds for the outcome cohorts -#' @param limitToFirstInNDays whether to limit each target cohort to the first entry into the cohort per N days per subject -#' @param minPriorObservation The minimum time (in days) in the database a patient in the target cohorts must be observed prior to index -#' @param outcomeWashoutDays Patients with the outcome within outcomeWashout days prior to index are excluded from the risk factor analysis +#' @param outcomeWashoutDays A single integer value. Patients with the outcome within outcomeWashout days prior to index are excluded from the risk factor analysis #' @template timeAtRisk #' @param covariateSettings An object created using \code{FeatureExtraction::createCovariateSettings} -#' @param minTargetSize The minimum size of the target cohorts for them to have aggregate covariates calculated -#' @param minTwithOSize The minimum size of the cohorts corresponding to patients in the target with the outcome during time-at-risk for them to have aggregate covariates calculated #' #' @family Aggregate #' @return @@ -33,9 +29,12 @@ #' @examples #' #' riskFactorSetting <- createRiskFactorSettings( -#' targetIds = c(1,2), +#' studyPopulationSettings = createStudyPopulationSettings( +#' targetIds = c(1,2), +#' minPriorObservation = 365, +#' limitToFirstInNDays = 99999 +#' ), #' outcomeIds = c(3), -#' minPriorObservation = 365, #' outcomeWashoutDays = 90, #' riskWindowStart = 1, #' startAnchor = "cohort start", @@ -45,11 +44,8 @@ #' #' @export createRiskFactorSettings <- function( - targetIds, + studyPopulationSettings, outcomeIds, - #? indicationIds - limitToFirstInNDays = 99999, - minPriorObservation = 0, outcomeWashoutDays = 0, riskWindowStart = 1, startAnchor = "cohort start", @@ -84,17 +80,15 @@ createRiskFactorSettings <- function( endDays = 0, longTermStartDays = -365, shortTermStartDays = -30 - ), - minTargetSize = 0, - minTwithOSize = 0 + ) ) { errorMessages <- checkmate::makeAssertCollection() # check targetIds is a vector of int/double - .checkCohortIds( - cohortIds = targetIds, - type = "target", - errorMessages = errorMessages - ) + #.checkCohortIds( + # cohortIds = targetIds, + # type = "target", + # errorMessages = errorMessages + #) # check outcomeIds is a vector of int/double .checkCohortIds( cohortIds = outcomeIds, @@ -102,6 +96,11 @@ createRiskFactorSettings <- function( errorMessages = errorMessages ) + # check outcomeWashoutDays is length 1 + if (length(outcomeWashoutDays) > 1) { + stop("Please add one outcomeWashoutDays per setting") + } + # check TAR - EFF edit if (length(riskWindowStart) > 1) { stop("Please add one time-at-risk per setting") @@ -131,20 +130,20 @@ createRiskFactorSettings <- function( } # check minPriorObservation - .checkMinPriorObservation( - minPriorObservation = minPriorObservation, - errorMessages = errorMessages - ) + #.checkMinPriorObservation( + # minPriorObservation = minPriorObservation, + # errorMessages = errorMessages + #) # add check for outcomeWashoutDays checkmate::reportAssertions(errorMessages) # check unique Ts and Os - if (length(targetIds) != length(unique(targetIds))) { - message("targetIds have duplicates - making unique") - targetIds <- unique(targetIds) - } + #if (length(targetIds) != length(unique(targetIds))) { + # message("targetIds have duplicates - making unique") + # targetIds <- unique(targetIds) + #} if (length(outcomeIds) != length(unique(outcomeIds))) { message("outcomeIds have duplicates - making unique") outcomeIds <- unique(outcomeIds) @@ -153,18 +152,14 @@ createRiskFactorSettings <- function( # create list result <- list( - targetIds = targetIds, - limitToFirstInNDays = limitToFirstInNDays, - minPriorObservation = minPriorObservation, + studyPopulationSettings = combineStudyPopulationSettings(studyPopulationSettings), outcomeIds = outcomeIds, outcomeWashoutDays = outcomeWashoutDays, riskWindowStart = riskWindowStart, startAnchor = gsub(' ', '_',startAnchor), riskWindowEnd = riskWindowEnd, endAnchor = gsub(' ', '_',endAnchor), - covariateSettings = covariateSettings, # risk factors - minTargetSize = minTargetSize, - minTwithOSize = minTwithOSize + covariateSettings = covariateSettings # risk factors ) class(result) <- "riskFactorSettings" @@ -188,8 +183,8 @@ computeRiskFactorAnalyses <- function( characterizationDatabaseSchema, characterizationTable, # contains char cohorts - targetSettingsTable, # contains map between settings and char cohort id caseSettingsTable, # contains map between settings and case id + caseCountTable, # new tempEmulationSchema = getOption("sqlRenderTempEmulationSchema"), settings, @@ -202,6 +197,7 @@ computeRiskFactorAnalyses <- function( progressBar = interactive(), mode, executionId, + minCaseSize, #new ...) { if(missing(outputFolder)){ @@ -222,28 +218,23 @@ computeRiskFactorAnalyses <- function( start <- Sys.time() message("Risk factor analysis: Finding temp Ids") - targetIds <- lookupTargets( - connection = connection, - lookupDatabaseSchema = characterizationDatabaseSchema, - lookupTableName = targetSettingsTable, - tempEmulationSchema = tempEmulationSchema, - targetIds = paste0(unique(settings$targetIds), collapse = ','), - limitToFirstInNDays = settings$limitToFirstInNDays, - minPriorObservation = settings$minPriorObservation - ) + # TODO update this using settings$studyPopulationSettings caseIds <- lookupCases( connection = connection, lookupDatabaseSchema = characterizationDatabaseSchema, lookupTableName = caseSettingsTable, + countTable = caseCountTable, tempEmulationSchema = tempEmulationSchema, - characterizationTargetIds = paste0(unique(targetIds$characterizationTargetId), collapse = ','), + characterizationTargetIds = paste0(unique(settings$characterizationTargetId), collapse = ','), outcomeIds = paste0(unique(settings$outcomeIds), collapse = ','), outcomeWashoutDays = settings$outcomeWashoutDays, startAnchor = settings$startAnchor, riskWindowStart = settings$riskWindowStart, endAnchor = settings$endAnchor, - riskWindowEnd = settings$riskWindowEnd + riskWindowEnd = settings$riskWindowEnd, + minCaseSize = minCaseSize, + applyMinSizeToNonCases = TRUE ) # generate the targets, cases and non-cases ids @@ -259,18 +250,12 @@ computeRiskFactorAnalyses <- function( completionTime <- Sys.time() - start message(paste0("Risk factor analysis: Finding temp Ids took ", round(completionTime, digits = 1), " ", units(completionTime))) + if(length(cohortIds) == 0){ + message('No cohorts with number of people >= minSize') + return(invisible(TRUE)) + } - - ## 2) get attrition - #start <- Sys.time() - #message("Risk factor analysis: Extracting cohort attritions") - # TODO get attrition from CohortGenerator when it is in there - - #completionTime <- Sys.time() - start - #message(paste0("Risk factor analysis: Extracting cohort attritions took ", round(completionTime, digits = 1), " ", units(completionTime))) - - - ## 3) run FE with all the cohorts of interest - ideally inserting the aggregate features into a new table + ## 2) run FE with all the cohorts of interest - ideally inserting the aggregate features into a new table start <- Sys.time() message("Risk factor analysis: Running FeatureExtraction") FeatureExtraction::getDbCovariateData( @@ -279,10 +264,10 @@ computeRiskFactorAnalyses <- function( cohortTable = characterizationTable, cohortDatabaseSchema = characterizationDatabaseSchema, cohortIds = cohortIds, - rowIdField = 'row_number', + rowIdField = 'row_id', covariateSettings = ParallelLogger::convertJsonToSettings(settings$covariateSettings), aggregated = TRUE, - minCharacterizationMean = minCharacterizationMean, + minCharacterizationMean = 0, #minCharacterizationMean, exportToTable = TRUE, targetDatabaseSchema = NULL, @@ -301,7 +286,7 @@ computeRiskFactorAnalyses <- function( - ## 4) for each target,exclude,cases join the tables and calculate the SMD + ## 3) for each target,exclude,cases join the tables and calculate the SMD start <- Sys.time() message("Risk factor analysis: Calculating SMD for binary") @@ -318,7 +303,8 @@ computeRiskFactorAnalyses <- function( characterization_fe_table = '#fe_covariate_rf', efficient_mode = mode == 'Efficient', smd_min = minSMD, - min_count = minCovariateCount + min_count = minCovariateCount, + min_characterization_mean = minCharacterizationMean ) result <- Andromeda::andromeda() @@ -387,8 +373,9 @@ computeRiskFactorAnalyses <- function( snakeCaseToCamelCase = TRUE ) - result$targetSettings <- targetIds - result$caseSettings <- caseIds + # TODO - what is this used for? + ##result$targetSettings <- settings$characterizationTargetId + ##result$caseSettings <- caseIds completionTime <- Sys.time() - start message(paste0("Risk factor analysis: Calculating SMD and downloading took ", round(completionTime, digits = 1), " ", units(completionTime))) @@ -449,9 +436,7 @@ getRiskFactorJobs <- function( FUN = function(outcomeId){ data.frame( - targetId = unique(characterizationSettings[[i]]$targetIds), - limitToFirstInNDays = characterizationSettings[[i]]$limitToFirstInNDays, - minPriorObservation = characterizationSettings[[i]]$minPriorObservation, + characterizationTargetId = unique(characterizationSettings[[i]]$characterizationTargetIds), outcomeId = outcomeId, outcomeWashoutDays = unique(characterizationSettings[[i]]$outcomeWashoutDays), @@ -471,9 +456,8 @@ getRiskFactorJobs <- function( settings <- c() if(nrow(riskFactorCombinations) > 0 ){ - jobCols <- c("targetId") + jobCols <- c("characterizationTargetId") settingCols <- c( - "limitToFirstInNDays", "minPriorObservation", "outcomeWashoutDays", "riskWindowStart", "startAnchor", "riskWindowEnd", "endAnchor" @@ -515,11 +499,8 @@ getRiskFactorJobs <- function( functionName = "computeRiskFactorAnalyses", settings = as.character(ParallelLogger::convertSettingsToJson( list( - targetIds = unique(restrictedData$targetId[ind]), + characterizationTargetIds = unique(restrictedData$characterizationTargetId[ind]), outcomeIds = unique(restrictedData$outcomeId[ind]), - minPriorObservation = unique(restrictedData$minPriorObservation[ind]), - limitToFirstInNDays = unique(restrictedData$limitToFirstInNDays[ind]), - outcomeWashoutDays = unique(restrictedData$outcomeWashoutDays[ind]), riskWindowStart = unique(restrictedData$riskWindowStart[ind]), startAnchor = unique(restrictedData$startAnchor[ind]), diff --git a/R/RunCharacterization.R b/R/RunCharacterization.R index a41413b..7f293d3 100644 --- a/R/RunCharacterization.R +++ b/R/RunCharacterization.R @@ -19,7 +19,11 @@ #' # example code #' #' drSet <- createDechallengeRechallengeSettings( -#' targetIds = c(1,2), +#' studyPopulationSettings = createStudyPopulationSettings( +#' targetIds = c(1,2), +#' limitToFirstInNDays = 0, +#' minPriorObservation = 0 +#' ), #' outcomeIds = 3 #' ) #' @@ -89,11 +93,85 @@ createCharacterizationSettings <- function( caseSeriesSettings = caseSeriesSettings ) + # update the settings replace the popSet with the characterizationTargetIds + settings <- addCharacterizationTargetIds( + settings = settings + ) + class(settings) <- "characterizationSettings" return(settings) } +# this function extracts all the target ids and subset logic then gives each a unique id +# then it replaces the sudyPopulationSettings with characterizationTargetIds +addCharacterizationTargetIds <- function(settings){ + + settingTypes <- c('timeToEventSettings', 'dechallengeRechallengeSettings', + 'targetBaselineSettings', 'riskFactorSettings', 'caseSeriesSettings') + + # extract out studyPopulationSettings + studyPopulationList <- list() + + for(settingType in settingTypes){ + if(!is.null(settings[[settingType]])){ + studyPopulationList <- append( + studyPopulationList, + lapply(settings[[settingType]], function(x){ + x$studyPopulationSettings %>% + dplyr::mutate( + timeToEventSettings = !!settingType == 'timeToEventSettings', + dechallengeRechallengeSettings = !!settingType == 'dechallengeRechallengeSettings', + targetBaselineSettings = !!settingType == 'targetBaselineSettings', + riskFactorSettings = !!settingType == 'riskFactorSettings', + caseSeriesSettings = !!settingType == 'caseSeriesSettings', + ) + }) + ) + } + } + + # get the unique target + subsets + studyPopulation <- unique(do.call('rbind', studyPopulationList)) %>% + dplyr::group_by(dplyr::across(-dplyr::all_of(settingTypes))) %>% + dplyr::summarise( + timeToEventSettings = any(.data$timeToEventSettings)*1, + dechallengeRechallengeSettings = any(.data$dechallengeRechallengeSettings)*1, + targetBaselineSettings = any(.data$targetBaselineSettings)*1, + riskFactorSettings = any(.data$riskFactorSettings)*1, + caseSeriesSettings = any(.data$caseSeriesSettings)*1, + .groups = "drop" + ) + # give a new id called characterizationTargetIds per target and subset + # characterizationTargetId always ends in 0 + studyPopulation$characterizationTargetId <- (1:nrow(studyPopulation))*10 + + settings$characterizationTargetLookup <- studyPopulation + + # Now update the settings to replace studyPopulationSettings with characterizationTargetIds + for(settingType in settingTypes){ + if(!is.null(settings[[settingType]])){ + + for(i in 1:length(settings[[settingType]])){ + + popSet <- settings[[settingType]][[i]]$studyPopulationSettings + settings[[settingType]][[i]]$studyPopulationSettings <- NULL + + studyPopulationInSetting <- merge( + x = popSet, + y = studyPopulation, + by = colnames(popSet) + ) + settings[[settingType]][[i]]$characterizationTargetIds <- unique(studyPopulationInSetting$characterizationTargetId) + + } + + } + }# end updating settings + + return(settings) +} + #' Save the characterization settings as a json #' @description @@ -111,7 +189,11 @@ createCharacterizationSettings <- function( #' #' @examples #' drSet <- createDechallengeRechallengeSettings( -#' targetIds = c(1,2), +#' studyPopulationSettings = createStudyPopulationSettings( +#' targetIds = c(1,2), +#' limitToFirstInNDays = 0, +#' minPriorObservation = 0 +#' ), #' outcomeIds = 3 #' ) #' @@ -156,7 +238,11 @@ saveCharacterizationSettings <- function( #' setPath <- file.path(tempdir(), 'charSet.json') #' #' drSet <- createDechallengeRechallengeSettings( -#' targetIds = c(1,2), +#' studyPopulationSettings = createStudyPopulationSettings( +#' targetIds = c(1,2), +#' limitToFirstInNDays = 0, +#' minPriorObservation = 0 +#' ), #' outcomeIds = 3 #' ) #' @@ -194,6 +280,8 @@ loadCharacterizationSettings <- function( #' @param connectionDetails The connection details to the database containing the OMOP CDM data #' @template TargetOutcomeTables #' @template TempEmulationSchema +#' @param nestingCohortTable The cohort table to extract the nesting cohort from +#' @param nestingCohortDatabaseSchema The schema containing the nestingCohortTable #' @param outputDatabaseSchema The schema where the characterization cohort table will be saved into #' @param outputTable The table name where the characterization cohort table will be saved into #' @param cdmDatabaseSchema The schema with the OMOP CDM data @@ -212,6 +300,8 @@ loadCharacterizationSettings <- function( #' @param minCovariateCount The minimum number of patients who must have the covariate when running aggregate covariates #' @param mode Select from Efficient (no exclusions to target based on washout)/CohortIncidence (excludes targets with outcome in washout if they have no time at risk)/PatientLevelPrediction (excludes targets with outcome during washout prior to index) #' @param minSMD The minimum standardized mean difference for the risk factor analysis +#' @param minTargetSize The minimum target size to be included in targetBaseline, riskFactor or caseSeries +#' @param minCaseSize The minimum case or non-case size to be included in riskFactor or caseSeries #' @family LargeScale #' #' @return @@ -222,7 +312,11 @@ loadCharacterizationSettings <- function( #' conDet <- exampleOmopConnectionDetails() #' #' tteSet <- createTimeToEventSettings( -#' targetIds = c(1,2), +#' studyPopulationSettings = createStudyPopulationSettings( +#' targetIds = c(1,2), +#' limitToFirstInNDays = 0, +#' minPriorObservation = 0 +#' ), #' outcomeIds = 3 #' ) #' @@ -248,6 +342,8 @@ runCharacterizationAnalyses <- function( targetTable, outcomeDatabaseSchema, outcomeTable, + nestingCohortTable = targetTable, + nestingCohortDatabaseSchema = targetDatabaseSchema, outputDatabaseSchema = targetDatabaseSchema, outputTable = 'characterization_cohort', tempEmulationSchema = getOption("sqlRenderTempEmulationSchema"), @@ -263,10 +359,12 @@ runCharacterizationAnalyses <- function( threads = 1, cohortGenerationThreads = NULL, nTargetJobs = 1, - minCharacterizationMean = 0.001, # is this global or within cov set? - minCovariateCount = 0, # is this global or within cov set? + minCharacterizationMean = 0.001, + minCovariateCount = 0, mode = 'CohortIncidence', - minSMD = 0 + minSMD = 0, + minTargetSize = 0, + minCaseSize = 0 ) { # inputs checks errorMessages <- checkmate::makeAssertCollection() @@ -426,6 +524,10 @@ runCharacterizationAnalyses <- function( targetTable = targetTable, outcomeDatabaseSchema = outcomeDatabaseSchema, outcomeTable = outcomeTable, + + nestingCohortTable = nestingCohortTable, + nestingCohortDatabaseSchema = nestingCohortDatabaseSchema, + outputDatabaseSchema = outputDatabaseSchema, outputTable = outputTable, cdmDatabaseSchema = cdmDatabaseSchema, @@ -447,17 +549,22 @@ runCharacterizationAnalyses <- function( connectionDetails = connectionDetails, tempEmulationSchema = tempEmulationSchema, outputDatabaseSchema = outputDatabaseSchema, - attritionTable = tableNames$attritionTable, + caseAttritionTable = tableNames$caseAttritionTable, + targetAttritionTable = tableNames$targetAttritionTable, + caseCountTable = tableNames$caseCountTable, + targetCountTable = tableNames$targetCountTable, targetSettingsTable = tableNames$targetSettingsTable, caseSettingsTable = tableNames$caseSettingsTable, dbHash = dbHash, mode = mode, minCharacterizationMean = minCharacterizationMean, minCovariateCount = minCovariateCount, - minSMD = minSMD + minSMD = minSMD, + minTargetSize = minTargetSize, + minCaseSize = minCaseSize ) - # Now loop over the jobs + # Now loop over the analysis jobs inputSettings <- list( connectionDetails = connectionDetails, targetDatabaseSchema = targetDatabaseSchema, @@ -477,8 +584,15 @@ runCharacterizationAnalyses <- function( # new inputs characterizationDatabaseSchema = outputDatabaseSchema, characterizationTable = tableNames$characterizationTable, + outcomeEraTable = tableNames$outcomeEraTable, targetSettingsTable = tableNames$targetSettingsTable, caseSettingsTable = tableNames$caseSettingsTable, + + targetCountTable = tableNames$targetCountTable, + caseCountTable = tableNames$caseCountTable, + minTargetSize = minTargetSize, + minCaseSize = minCaseSize, + mode = mode, minSMD = minSMD, executionId = executionId @@ -536,6 +650,12 @@ runCharacterizationAnalyses <- function( csvFilePrefix = csvFilePrefix, minCellCount = minCellCount ) + exportCounts( + executionPath = executionPath, + outputFolder = outputDirectory, + csvFilePrefix = csvFilePrefix, + minCellCount = minCellCount + ) invisible(outputDirectory) } @@ -656,7 +776,10 @@ exportSharedObjects <- function( connectionDetails, outputDatabaseSchema, tempEmulationSchema, - attritionTable, + caseAttritionTable, + targetAttritionTable, + caseCountTable, + targetCountTable, targetSettingsTable, caseSettingsTable, @@ -664,7 +787,9 @@ exportSharedObjects <- function( mode, minCharacterizationMean, minCovariateCount, - minSMD + minSMD, + minTargetSize = minTargetSize, + minCaseSize = minCaseSize ){ # add code here to save execution_settings, @@ -707,15 +832,125 @@ exportSharedObjects <- function( row.names = FALSE ) - # extract attrition, target_settings + + # extract target attrition + # export target attrition table + sql <- SqlRender::render( + sql = "SELECT * FROM @attrition_table;", + attrition_table = paste0(outputDatabaseSchema, '.' ,targetAttritionTable) + ) + sql <- SqlRender::translate( + sql = sql, + targetDialect = attributes(connection)$dbms, + tempEmulationSchema = tempEmulationSchema + ) + + andromeda <- Andromeda::andromeda() + + DatabaseConnector::querySqlToAndromeda( + connection = connection, + sql = sql, + andromeda = andromeda, + andromedaTableName = 'target_attrition', + snakeCaseToCamelCase = TRUE + ) + + addDbAndSettings( + andromeda = andromeda, + databaseId = databaseId, + settingId = executionId + ) + + saveCharacterizationAndromeda( + andromeda = andromeda, + outputFolder = file.path(executionPath, 'target_attrition') + ) + + # NEW to improve extraction + # extract tte and dechal settings to T/O pairs + # ============== + tte_settings <- extractSettings(characterizationSettings, type = 'timeToEventSettings') + tte_settings$database_id <- databaseId + tte_settings$setting_id <- executionId + utils::write.csv( + x = formatDouble(tte_settings), + file = file.path(saveLocation, paste0(tablePrefix,'time_to_event_settings.csv')), + row.names = FALSE + ) + + dcrc_settings <- extractSettings(characterizationSettings, type = 'dechallengeRechallengeSettings') + dcrc_settings$database_id <- databaseId + dcrc_settings$setting_id <- executionId + utils::write.csv( + x = formatDouble(dcrc_settings), + file = file.path(saveLocation, paste0(tablePrefix,'dechallenge_rechallenge_settings.csv')), + row.names = FALSE + ) + # ============== + + # export target settings table + sql <- SqlRender::render( + sql = "SELECT * FROM @target_settings_table;", + target_settings_table = paste0(outputDatabaseSchema, '.' ,targetSettingsTable) + ) + sql <- SqlRender::translate( + sql = sql, + targetDialect = attributes(connection)$dbms, + tempEmulationSchema = tempEmulationSchema + ) + data <- DatabaseConnector::querySql( + connection = connection, + sql = sql, + snakeCaseToCamelCase = FALSE + ) + data$database_id <- databaseId + data$setting_id <- executionId + utils::write.csv( + x = formatDouble(data), + file = file.path(saveLocation, paste0(tablePrefix,'target_settings.csv')), + row.names = FALSE + ) + + # export target count table + sql <- SqlRender::render( + sql = "SELECT * FROM @target_count_table;", + target_count_table = paste0(outputDatabaseSchema, '.' ,targetCountTable) + ) + sql <- SqlRender::translate( + sql = sql, + targetDialect = attributes(connection)$dbms, + tempEmulationSchema = tempEmulationSchema + ) + + andromeda <- Andromeda::andromeda() + + DatabaseConnector::querySqlToAndromeda( + connection = connection, + sql = sql, + andromeda = andromeda, + andromedaTableName = 'target_counts', + snakeCaseToCamelCase = TRUE + ) + + addDbAndSettings( + andromeda = andromeda, + databaseId = databaseId, + settingId = executionId + ) + + saveCharacterizationAndromeda( + andromeda = andromeda, + outputFolder = file.path(executionPath, 'target_counts') + ) + + # extract case attrition if(!is.null(characterizationSettings$caseSeriesSettings) | - !is.null(characterizationSettings$riskFactorSettings) | - !is.null(characterizationSettings$targetBaselineSettings)){ + !is.null(characterizationSettings$riskFactorSettings) ){ - # export attrition table + # export target attrition table sql <- SqlRender::render( - sql = "SELECT cohort_definition_id, attr_reason, n FROM @attrition_table;", - attrition_table = paste0(outputDatabaseSchema, '.' ,attritionTable) + sql = "SELECT * FROM @attrition_table;", + attrition_table = paste0(outputDatabaseSchema, '.' ,caseAttritionTable) ) sql <- SqlRender::translate( sql = sql, @@ -729,7 +964,7 @@ exportSharedObjects <- function( connection = connection, sql = sql, andromeda = andromeda, - andromedaTableName = 'attrition', + andromedaTableName = 'case_attrition', snakeCaseToCamelCase = TRUE ) @@ -741,13 +976,13 @@ exportSharedObjects <- function( saveCharacterizationAndromeda( andromeda = andromeda, - outputFolder = file.path(executionPath, 'attrition') + outputFolder = file.path(executionPath, 'case_attrition') ) - # export target settings table + # export case settings table sql <- SqlRender::render( - sql = "SELECT target_id, limit_to_first_in_n_days, min_prior_observation, characterization_target_id FROM @target_settings_table;", - target_settings_table = paste0(outputDatabaseSchema, '.' ,targetSettingsTable) + sql = "SELECT characterization_case_id, characterization_target_id, outcome_id, outcome_washout_days, risk_window_start, start_anchor, risk_window_end, end_anchor, risk_factor_settings, case_series_settings FROM @case_settings_table;", + case_settings_table = paste0(outputDatabaseSchema, '.' ,caseSettingsTable) ) sql <- SqlRender::translate( sql = sql, @@ -763,37 +998,40 @@ exportSharedObjects <- function( data$setting_id <- executionId utils::write.csv( x = formatDouble(data), - file = file.path(saveLocation, paste0(tablePrefix,'target_settings.csv')), + file = file.path(saveLocation, paste0(tablePrefix,'case_settings.csv')), row.names = FALSE ) - } - - # extract case_settings - if(!is.null(characterizationSettings$caseSeriesSettings) | - !is.null(characterizationSettings$riskFactorSettings) ){ - - # export target settings table + # export case count table sql <- SqlRender::render( - sql = "SELECT characterization_case_id, characterization_target_id, outcome_id, outcome_washout_days, risk_window_start, start_anchor, risk_window_end, end_anchor, runtype FROM @case_settings_table;", - case_settings_table = paste0(outputDatabaseSchema, '.' ,caseSettingsTable) + sql = "SELECT * FROM @case_count_table;", + case_count_table = paste0(outputDatabaseSchema, '.' ,caseCountTable) ) sql <- SqlRender::translate( sql = sql, targetDialect = attributes(connection)$dbms, tempEmulationSchema = tempEmulationSchema ) - data <- DatabaseConnector::querySql( + + andromeda <- Andromeda::andromeda() + + DatabaseConnector::querySqlToAndromeda( connection = connection, sql = sql, - snakeCaseToCamelCase = FALSE + andromeda = andromeda, + andromedaTableName = 'case_counts', + snakeCaseToCamelCase = TRUE ) - data$database_id <- databaseId - data$setting_id <- executionId - utils::write.csv( - x = formatDouble(data), - file = file.path(saveLocation, paste0(tablePrefix,'case_settings.csv')), - row.names = FALSE + + addDbAndSettings( + andromeda = andromeda, + databaseId = databaseId, + settingId = executionId + ) + + saveCharacterizationAndromeda( + andromeda = andromeda, + outputFolder = file.path(executionPath, 'case_counts') ) } @@ -807,7 +1045,9 @@ exportSharedObjects <- function( mode = mode, min_characterization_mean = minCharacterizationMean, min_covariate_count = minCovariateCount, - min_smd = minSMD + min_smd = minSMD, + min_target_size = minTargetSize, + min_case_size = minCaseSize ), file = file.path(saveLocation, paste0(tablePrefix,'execution_settings.csv')), row.names = FALSE @@ -817,3 +1057,33 @@ exportSharedObjects <- function( } + +extractSettings <- function(characterizationSettings, type = 'timeToEventSettings'){ + settings <- characterizationSettings[[type]] + + if(!is.null(settings)){ + + extractedSettings <- unique(do.call( + what = 'rbind', + args = lapply( + X = settings, + FUN = function(x){ + expand.grid( + characterization_target_id = as.integer(x$characterizationTargetIds), + outcome_id = as.integer(x$outcomeIds) + ) + } + ))) + + return(extractedSettings) + + } else{ + return( + data.frame( + characterization_target_id = 0, + outcome_id = 0 + )) + } + +} + diff --git a/R/StudyPopulation.R b/R/StudyPopulation.R new file mode 100644 index 0000000..a741256 --- /dev/null +++ b/R/StudyPopulation.R @@ -0,0 +1,112 @@ +#' create the study population settings +#' +#' @param targetIds A target cohort id or vector of target cohort ids to do the subsetting to +#' @param limitToFirstInNDays Should only the first exposure in N days per subject be included? +#' @param minPriorObservation The minimum required continuous observation time prior to index +#' date for a person to be included in the cohort. +#' @param nestingCohortId A cohort definition id to restrict the target cohort. Patient in the target cohort +#' are only included if they are also in the nesting cohort at index. +#' @param minAge The minimum age required to be in the target at index +#' @param maxAge The maximum age required to be in the target at index +#' @param studyStartDate The earliest date to be included into the target. Date format is 'yyyymmdd'. +#' @param studyEndDate The latest date to be included into the target. Date format is 'yyyymmdd'. +#' @param genderConceptIds A target cohort subject's gender concept to restrict to +#' @family helper +#' +#' @return +#' A data.frame containing all the settings required +#' for creating the study populations of interest +#' @examples +#' # Create study population settings with a washout period of 365 days and +#' # restricted to adults for target dates that occur for the first time in 365 days. +#' populationSettings <- createStudyPopulationSettings( +#' targetId = 1, +#' limitToFirstInNDays = 365, +#' minPriorObservation = 365, +#' minAge = 18 +#' ) +#' @export +createStudyPopulationSettings <- function( + targetIds, + limitToFirstInNDays = 0, + minPriorObservation = 0, + nestingCohortId = NULL, + minAge = NULL, + maxAge = NULL, + studyStartDate = NULL, + studyEndDate = NULL, + genderConceptIds = NULL + ) { + + if(!is.null(limitToFirstInNDays)){ + if(!inherits(limitToFirstInNDays, "numeric") & !inherits(limitToFirstInNDays, "integer")){ + stop('minPriorObservation must be numeric') + } + if(limitToFirstInNDays < 0){ + stop('limitToFirstInNDays must be 0 or more') + } + } else{ + stop('limitToFirstInNDays must be a numeric > 0 not NULL') + } + + if(!is.null(minPriorObservation)){ + if(!inherits(minPriorObservation, "numeric") & !inherits(minPriorObservation, "integer")){ + stop('minPriorObservation must be numeric') + } + if(minPriorObservation < 0){ + stop('minPriorObservation must be 0 or more') + } + } else{ + stop('minPriorObservation must be a numeric > 0 not NULL') + } + + if(!is.null(nestingCohortId)){ + if(!inherits(nestingCohortId, "numeric") & !inherits(nestingCohortId, "integer")){ + stop('nestingCohortId must be numeric or NULL') + } + } + + result <- unique(data.frame( + targetId = targetIds, + limitToFirstInNDays = limitToFirstInNDays, + minPriorObservation = minPriorObservation, + nestingCohortId = replaceNull(nestingCohortId, 0), + minAge = replaceNull(minAge,0), + maxAge = replaceNull(maxAge,9999), + studyStart = replaceNull(studyStartDate,''), #'yyyy/mm/dd', + studyEnd = replaceNull(studyEndDate,''), + genderConceptIds = paste0(sort(genderConceptIds), collapse= ',') + )) + + return(result) +} + + +replaceNull <- function(value, nullReplacement){ + if(is.null(value)){ + return(nullReplacement) + } else{ + return(value) + } +} + + +# take a list of studyPopulationSettings and remove redundancy +combineStudyPopulationSettings <- function(studyPopulationSettingslist){ + + if(inherits(studyPopulationSettingslist, "data.frame")){ + studyPopulationSettingslist <- list(studyPopulationSettingslist) + } + + for(i in 1:length(studyPopulationSettingslist)){ + if(!'targetId' %in% colnames(studyPopulationSettingslist[[i]])){ + stop('Incorrect studyPopulationSettingslist') + } + } + + combined <- unique(do.call('rbind', studyPopulationSettingslist)) + + return(combined) +} + + diff --git a/R/TargetAnalysis.R b/R/TargetAnalysis.R index f061ec7..d639d3e 100644 --- a/R/TargetAnalysis.R +++ b/R/TargetAnalysis.R @@ -1,8 +1,6 @@ #' Create target baseline aggregate covariate study settings #' -#' @param targetIds A list of cohortIds for the target cohorts -#' @param limitToFirstInNDays Whether to remove target cohort entries that occur within limitToFirstInNDays of a prior entry. limitToFirstInNDays = 99999 means limit to first entry. -#' @param minPriorObservation The minimum time (in days) in the database a patient in the target cohorts must be observed prior to index +#' @param studyPopulationSettings An object created using \code{createStudyPopulationSettings} or a list of \code{createStudyPopulationSettings} that specifies specific populations of interest #' @param covariateSettings An object created using \code{FeatureExtraction::createCovariateSettings} #' @family Aggregate #' @return @@ -11,16 +9,16 @@ #' @examples #' #' aggregateSetting <- createTargetBaselineSettings( -#' targetIds = c(1,2), +#' studyPopulationSettings = createStudyPopulationSettings( +#' targetIds = 1:2, #' limitToFirstInNDays = 99999, #' minPriorObservation = 365 +#' ) #' ) #' #' @export createTargetBaselineSettings <- function( - targetIds, - limitToFirstInNDays = 99999, - minPriorObservation = 0, + studyPopulationSettings, covariateSettings = FeatureExtraction::createCovariateSettings( useDemographicsGender = TRUE, useDemographicsAge = TRUE, @@ -56,11 +54,11 @@ createTargetBaselineSettings <- function( errorMessages <- checkmate::makeAssertCollection() # check targetIds is a vector of int/double - .checkCohortIds( - cohortIds = targetIds, - type = "target", - errorMessages = errorMessages - ) + #.checkCohortIds( + # cohortIds = targetIds, + # type = "target", + # errorMessages = errorMessages + #) # check covariateSettings .checkCovariateSettings( @@ -78,17 +76,11 @@ createTargetBaselineSettings <- function( stop("Temporal covariateSettings not supported by createAggregateCovariateSettings()") } - # check minPriorObservation - .checkMinPriorObservation( - minPriorObservation = minPriorObservation, - errorMessages = errorMessages - ) + # check studyPopulationSettings # create list result <- list( - targetIds = targetIds, - limitToFirstInNDays = limitToFirstInNDays, - minPriorObservation = minPriorObservation, + studyPopulationSettings = combineStudyPopulationSettings(studyPopulationSettings), covariateSettings = covariateSettings ) @@ -105,7 +97,6 @@ computeTargetBaselineAnalyses <- function( targetTable, characterizationDatabaseSchema, characterizationTable, # contains char cohorts - #attritionTable, targetSettingsTable, # contains map between settings and char cohort id tempEmulationSchema = getOption("sqlRenderTempEmulationSchema"), settings, @@ -115,6 +106,8 @@ computeTargetBaselineAnalyses <- function( progressBar = interactive(), minCharacterizationMean = 0.01, minCovariateCount = 0, + minTargetSize = 0, # added + targetCountTable, # added executionId, ...) { @@ -131,15 +124,14 @@ computeTargetBaselineAnalyses <- function( DatabaseConnector::disconnect(connection) ) - # first look up the cohort ids for the settings - cohorts <- lookupTargets( + # restrict to cohorts with min size + minSized <- minSizeCharacterizationIds( connection = connection, - lookupDatabaseSchema = characterizationDatabaseSchema, - lookupTableName = targetSettingsTable, tempEmulationSchema = tempEmulationSchema, - targetIds = settings$targetIds, - limitToFirstInNDays = settings$limitToFirstInNDays, - minPriorObservation = settings$minPriorObservation + characterizationTargetIds = settings$characterizationTargetIds, + minTargetSize = minTargetSize, + cohortDatabaseSchema = characterizationDatabaseSchema, + targetCountTable = targetCountTable ) # next run FE on cohortIds @@ -148,8 +140,8 @@ computeTargetBaselineAnalyses <- function( cdmDatabaseSchema = cdmDatabaseSchema, cohortDatabaseSchema = characterizationDatabaseSchema, cohortTable = characterizationTable, - cohortIds = unique(cohorts$characterizationTargetId), - covariateSettings = ParallelLogger::convertJsonToSettings(settings$covariateSettings), + cohortIds = minSized$characterizationTargetId, + covariateSettings = ParallelLogger::convertJsonToSettings(settings$covariateSettingsJson), cdmVersion = cdmVersion, aggregated = TRUE, minCharacterizationMean = minCharacterizationMean, @@ -196,7 +188,7 @@ computeTargetBaselineAnalyses <- function( result$targetCovariatesContinuous <- result$covariatesContinuous result$covariatesContinuous <- NULL - result$targetSettings <- cohorts + ##result$targetSettings <- cohorts # export to andromeda result <- addDbAndSettings( @@ -226,6 +218,8 @@ getTargetBaselineJobs <- function( } ind <- 1:length(characterizationSettings) + # characterizationTargetIds, covariateSettings + # target combinations targetCombinations <- do.call( what = "rbind", @@ -234,9 +228,7 @@ getTargetBaselineJobs <- function( 1:length(characterizationSettings), function(i) { result <- data.frame( - targetIds = unique(characterizationSettings[[i]]$targetIds), - limitToFirstInNDays = characterizationSettings[[i]]$limitToFirstInNDays, - minPriorObservation = characterizationSettings[[i]]$minPriorObservation, + characterizationTargetId = unique(characterizationSettings[[i]]$characterizationTargetIds), covariateSettingsJson = as.character(ParallelLogger::convertSettingsToJson(characterizationSettings[[i]]$covariateSettings)) ) return(result) @@ -246,8 +238,7 @@ getTargetBaselineJobs <- function( settings <- c() if (nrow(targetCombinations) > 0) { - jobCols <- c("targetIds") - settingCols <- c("minPriorObservation", "limitToFirstInNDays") + jobCols <- c("characterizationTargetId") # thread split - assign each target a treat jobSettings <- targetCombinations %>% @@ -256,45 +247,25 @@ getTargetBaselineJobs <- function( jobSettings$nTargetJobs <- rep(1:nTargetJobs, ceiling(nrow(jobSettings) / nTargetJobs))[1:nrow(jobSettings)] targetCombinations <- merge(targetCombinations, jobSettings, by = jobCols) - executionSettings <- targetCombinations %>% - dplyr::select(dplyr::all_of(settingCols)) %>% - dplyr::distinct() %>% - dplyr::mutate( - settingId = dplyr::row_number() - ) - - targetCombinations <- merge(targetCombinations, executionSettings, by = settingCols) - # recreate settings - for (settingId in unique(executionSettings$settingId)) { - settingVal <- executionSettings %>% - dplyr::filter(.data$settingId == !!settingId) %>% - dplyr::select(dplyr::all_of(settingCols)) - - restrictedData <- targetCombinations %>% - dplyr::inner_join(settingVal, by = settingCols) - - for (i in unique(restrictedData$nTargetJobs)) { - ind <- restrictedData$nTargetJobs== i + for (i in unique(targetCombinations$nTargetJobs)) { + ind <- targetCombinations$nTargetJobs== i settings <- rbind( settings, data.frame( functionName = "computeTargetBaselineAnalyses", settings = as.character(ParallelLogger::convertSettingsToJson( list( - targetIds = unique(restrictedData$targetId[ind]), - limitToFirstInNDays = unique(restrictedData$limitToFirstInNDays[ind]), - minPriorObservation = unique(restrictedData$minPriorObservation[ind]), - covariateSettingsJson = combineCovariateSettingsJsons(as.list(restrictedData$covariateSettingsJson[ind])) + characterizationTargetIds = unique(targetCombinations$characterizationTargetId[ind]), + covariateSettingsJson = combineCovariateSettingsJsons(as.list(targetCombinations$covariateSettingsJson[ind])) ) )), - executionFolder = paste("t", i, paste(settingVal, collapse = "_"), sep = "_"), - jobId = paste("t", i, paste(settingVal, collapse = "_"), sep = "_") + executionFolder = paste("t", i, sep = "_"), + jobId = paste("t", i, sep = "_") ) ) } } - } return(settings) } diff --git a/R/TimeToEvent.R b/R/TimeToEvent.R index 4a26613..5890e05 100644 --- a/R/TimeToEvent.R +++ b/R/TimeToEvent.R @@ -16,8 +16,9 @@ #' Create time to event study settings #' -#' @param targetIds A list of cohortIds for the target cohorts +#' @param studyPopulationSettings An object created using \code{createStudyPopulationSettings} or a list of \code{createStudyPopulationSettings} that specifies cohort inclusion criteria #' @param outcomeIds A list of cohortIds for the outcome cohorts +#' #' @family TimeToEvent #' #' @return @@ -27,23 +28,28 @@ #' # example code #' #' tteSet <- createTimeToEventSettings( -#' targetIds = c(1,2), +#' studyPopulationSettings = createStudyPopulationSettings( +#' targetIds = c(1,2), +#' limitToFirstInNDays = 0, +#' minPriorObservation = 0 +#' ), #' outcomeIds = 3 #' ) #' #' #' @export createTimeToEventSettings <- function( - targetIds, - outcomeIds) { + studyPopulationSettings, + outcomeIds +) { # check indicationIds errorMessages <- checkmate::makeAssertCollection() # check targetIds is a vector of int/double - .checkCohortIds( - cohortIds = targetIds, - type = "target", - errorMessages = errorMessages - ) + #.checkCohortIds( + # cohortIds = targetIds, + # type = "target", + # errorMessages = errorMessages + #) # check outcomeIds is a vector of int/double .checkCohortIds( cohortIds = outcomeIds, @@ -55,7 +61,7 @@ createTimeToEventSettings <- function( # create data.frame with all combinations result <- list( - targetIds = targetIds, + studyPopulationSettings = combineStudyPopulationSettings(studyPopulationSettings), outcomeIds = outcomeIds ) @@ -63,52 +69,15 @@ createTimeToEventSettings <- function( return(result) } -#' Compute time to event study -#' -#' @template ConnectionDetails -#' @template TargetOutcomeTables -#' @template TempEmulationSchema -#' @param cdmDatabaseSchema The database schema containing the OMOP CDM data -#' @param settings The settings for the timeToEvent study -#' @param databaseId An identifier for the database (string) -#' @param outputFolder A directory to save the results as csv files -#' @param minCellCount The minimum cell value to display, values less than this will be replaced by -1 -#' @param progressBar Whether to display a progress bar while the analysis is running -#' @param executionId a unique id for the run -#' @param ... extra inputs -#' @family TimeToEvent -#' -#' @return -#' An \code{Andromeda::andromeda()} object containing the time to event results. -#' -#' @examples -#' # example code -#' -#' conDet <- exampleOmopConnectionDetails() -#' -#' tteSet <- createTimeToEventSettings( -#' targetIds = c(1,2), -#' outcomeIds = 3 -#' ) -#' -#' result <- computeTimeToEventAnalyses( -#' connectionDetails = conDet, -#' targetDatabaseSchema = 'main', -#' targetTable = 'cohort', -#' cdmDatabaseSchema = 'main', -#' settings = tteSet, -#' outputFolder = file.path(tempdir(), 'tte') -#' ) -#' -#' -#' -#' @export + computeTimeToEventAnalyses <- function( connectionDetails = NULL, targetDatabaseSchema, targetTable, outcomeDatabaseSchema = targetDatabaseSchema, outcomeTable = targetTable, + characterizationDatabaseSchema, + characterizationTable, tempEmulationSchema = getOption("sqlRenderTempEmulationSchema"), cdmDatabaseSchema, settings, @@ -142,10 +111,10 @@ computeTimeToEventAnalyses <- function( tempEmulationSchema = tempEmulationSchema, errorMessages = errorMessages ) - .checkTimeToEventSettings( - settings = settings, - errorMessages = errorMessages - ) + #.checkTimeToEventSettings( + # settings = settings, + # errorMessages = errorMessages + #) valid <- checkmate::reportAssertions(errorMessages) @@ -163,7 +132,7 @@ computeTimeToEventAnalyses <- function( message("Uploading #cohort_settings") pairs <- expand.grid( - targetCohortDefinitionId = settings$targetIds, + characterizationTargetId = settings$characterizationTargetIds, outcomeCohortDefinitionId = settings$outcomeIds ) @@ -187,8 +156,8 @@ computeTimeToEventAnalyses <- function( tempEmulationSchema = tempEmulationSchema, database_id = databaseId, cdm_database_schema = cdmDatabaseSchema, - target_database_schema = targetDatabaseSchema, - target_table = targetTable, + characterization_schema = characterizationDatabaseSchema, + characterization_table = characterizationTable, outcome_database_schema = outcomeDatabaseSchema, outcome_table = outcomeTable ) @@ -263,8 +232,8 @@ getTimeToEventJobs <- function( return(NULL) } ind <- 1:length(characterizationSettings) - targetIds <- lapply(ind, function(i) { - characterizationSettings[[i]]$targetIds + characterizationTargetIds <- lapply(ind, function(i) { + characterizationSettings[[i]]$characterizationTargetIds }) outcomeIds <- lapply(ind, function(i) { characterizationSettings[[i]]$outcomeIds @@ -276,17 +245,17 @@ getTimeToEventJobs <- function( what = "rbind", args = lapply( - 1:length(targetIds), + 1:length(characterizationTargetIds), function(i) { expand.grid( - targetId = targetIds[[i]], + characterizationTargetIds = characterizationTargetIds[[i]], outcomeId = outcomeIds[[i]] ) } ) ) # find out whether more Ts or more Os - tcount <- length(unique(tnos$targetId)) + tcount <- length(unique(tnos$characterizationTargetIds)) ocount <- length(unique(tnos$outcomeId)) if (nTargetJobs > max(tcount, ocount)) { @@ -296,10 +265,10 @@ getTimeToEventJobs <- function( if (tcount >= ocount) { threadDf <- data.frame( - targetId = unique(tnos$targetId), + characterizationTargetIds = unique(tnos$characterizationTargetIds), nTargetJobs = rep(1:nTargetJobs, ceiling(tcount / nTargetJobs))[1:tcount] ) - mergeColumn <- "targetId" + mergeColumn <- "characterizationTargetIds" } else { threadDf <- data.frame( outcomeId = unique(tnos$outcomeId), @@ -312,8 +281,8 @@ getTimeToEventJobs <- function( sets <- lapply( X = 1:max(threadDf$nTargetJobs), FUN = function(i) { - createTimeToEventSettings( - targetIds = unique(tnos$targetId[tnos$nTargetJobs == i]), + list( + characterizationTargetIds = unique(tnos$characterizationTargetIds[tnos$nTargetJobs == i]), outcomeIds = unique(tnos$outcomeId[tnos$nTargetJobs == i]) ) } diff --git a/R/ViewShiny.R b/R/ViewShiny.R index 196cd80..d570635 100644 --- a/R/ViewShiny.R +++ b/R/ViewShiny.R @@ -16,7 +16,9 @@ #' conDet <- exampleOmopConnectionDetails() #' #' tteSet <- createTimeToEventSettings( -#' targetIds = c(1,2), +#' studyPopulationSettings = createStudyPopulationSettings( +#' targetIds = c(1,2) +#' ), #' outcomeIds = 3 #' ) #' @@ -139,7 +141,18 @@ prepareCharacterizationShiny <- function( tableName = "DATABASE_META_DATA", data = data.frame( databaseId = dbIds, - cdmSourceAbbreviation = paste0("database ", dbIds) + cdmSourceName = paste0("database ", dbIds), + cdmSourceAbbreviation = paste0("database ", dbIds), + cdmHolder = 'NA', + sourceDescription = 'NA', + sourceDocumentationReference = 'NA', + cdmEtlReference = 'NA', + sourceReleaseDate = 'NA', + cdmReleaseDate = 'NA', + cdmVersion = 'NA', + cdmVersionConceptId = 'NA', + vocabularyVersion = 'NA', + maxObsPeriodEndDate = 'NA' ), camelCaseToSnakeCase = TRUE ) @@ -153,33 +166,13 @@ prepareCharacterizationShiny <- function( connection = con, sql = paste0("select distinct TARGET_ID from ", tablePrefix, csvTablePrefix, "target_settings;"), snakeCaseToCamelCase = TRUE - )$targetCohortId, + )$targetId, DatabaseConnector::querySql( connection = con, sql = paste0("select distinct OUTCOME_ID from ", tablePrefix, csvTablePrefix, "case_settings;"), snakeCaseToCamelCase = TRUE - )$outcomeCohortId, - DatabaseConnector::querySql( - connection = con, - sql = paste0("select distinct TARGET_COHORT_DEFINITION_ID from ", tablePrefix, csvTablePrefix, "time_to_event;"), - snakeCaseToCamelCase = TRUE - )$targetCohortDefinitionId, - DatabaseConnector::querySql( - connection = con, - sql = paste0("select distinct OUTCOME_COHORT_DEFINITION_ID from ", tablePrefix, csvTablePrefix, "time_to_event;"), - snakeCaseToCamelCase = TRUE - )$outcomeCohortDefinitionId, - DatabaseConnector::querySql( - connection = con, - sql = paste0("select distinct TARGET_COHORT_DEFINITION_ID from ", tablePrefix, csvTablePrefix, "rechallenge_fail_case_series;"), - snakeCaseToCamelCase = TRUE - )$targetCohortDefinitionId, - DatabaseConnector::querySql( - connection = con, - sql = paste0("select distinct OUTCOME_COHORT_DEFINITION_ID from ", tablePrefix, csvTablePrefix, "rechallenge_fail_case_series;"), - snakeCaseToCamelCase = TRUE - )$outcomeCohortDefinitionId - ) + )$outcomeId + ) ) @@ -202,12 +195,74 @@ prepareCharacterizationShiny <- function( camelCaseToSnakeCase = TRUE ) - databaseIds <- DatabaseConnector::querySql( + } + + + # add the new subset table + if (!"cg_cohort_subset_definition" %in% tables) { + DatabaseConnector::insertTable( connection = con, - sql = paste0("select distinct DATABASE_ID from main.DATABASE_META_DATA;"), - snakeCaseToCamelCase = TRUE - )$databaseId + databaseSchema = "main", + tableName = "cg_cohort_subset_definition", + data = data.frame( + subsetDefinitionId = 1, + json = '{}' + ), + camelCaseToSnakeCase = TRUE + ) + } + + # add the new cohort count + if (!"cg_cohort_count" %in% tables) { + + dbIds <- unique( + c( + DatabaseConnector::querySql( + connection = con, + sql = paste0("select distinct DATABASE_ID from ", tablePrefix, csvTablePrefix, "analysis_ref;"), + snakeCaseToCamelCase = TRUE + )$databaseId, + DatabaseConnector::querySql( + connection = con, + sql = paste0("select distinct DATABASE_ID from ", tablePrefix, csvTablePrefix, "dechallenge_rechallenge;"), + snakeCaseToCamelCase = TRUE + )$databaseId, + DatabaseConnector::querySql( + connection = con, + sql = paste0("select distinct DATABASE_ID from ", tablePrefix, csvTablePrefix, "time_to_event;"), + snakeCaseToCamelCase = TRUE + )$databaseId + ) + ) + cohortIds <- unique( + c( + DatabaseConnector::querySql( + connection = con, + sql = paste0("select distinct TARGET_ID from ", tablePrefix, csvTablePrefix, "target_settings;"), + snakeCaseToCamelCase = TRUE + )$targetId, + DatabaseConnector::querySql( + connection = con, + sql = paste0("select distinct OUTCOME_ID from ", tablePrefix, csvTablePrefix, "case_settings;"), + snakeCaseToCamelCase = TRUE + )$outcomeId + ) + ) + + DatabaseConnector::insertTable( + connection = con, + databaseSchema = "main", + tableName = "cg_cohort_count", + data = data.frame( + cohortDefinitionId = cohortIds, + cohortId = cohortIds, + cohortEntries = rep(1000, length(cohortIds)), # fake + cohortSubjects = rep(1000, length(cohortIds)), # fake + databaseId = dbIds + ), + camelCaseToSnakeCase = TRUE + ) } diff --git a/README.md b/README.md index 24be26b..de05e6f 100644 --- a/README.md +++ b/README.md @@ -34,24 +34,32 @@ connectionDetails <- Characterization::exampleOmopConnectionDetails() targetIds <- c(1,2,4) outcomeIds <- c(3) - timeToEventSettings1 <- createTimeToEventSettings( - targetIds = 1, - outcomeIds = c(3,4) - ) - timeToEventSettings2 <- createTimeToEventSettings( - targetIds = 2, + timeToEventSettings <- createTimeToEventSettings( + studyPopulationSettings = createStudyPopulationSettings( + targetIds = c(1,2), + limitToFirstInNDays = 0, + minPriorObservation = 0 + ), outcomeIds = c(3,4) ) dechallengeRechallengeSettings <- createDechallengeRechallengeSettings( - targetIds = targetIds, + studyPopulationSettings = createStudyPopulationSettings( + targetIds = c(1,2), + limitToFirstInNDays = 0, + minPriorObservation = 0 + ), outcomeIds = outcomeIds, dechallengeStopInterval = 30, dechallengeEvaluationWindow = 31 ) riskFactorSettings1 <- createRiskFactorSettings( - targetIds = targetIds, + studyPopulationSettings = createStudyPopulationSettings( + targetIds = targetIds, + limitToFirstInNDays = 99999, # first exposure + minPriorObservation = 365 # requiring 365 days prior obs + ), outcomeIds = outcomeIds, riskWindowStart = 1, startAnchor = 'cohort start', @@ -65,7 +73,11 @@ targetIds <- c(1,2,4) ) riskFactorSettings2 <- createRiskFactorSettings( - targetIds = targetIds, + studyPopulationSettings = createStudyPopulationSettings( + targetIds = targetIds, + limitToFirstInNDays = 99999, # first exposure + minPriorObservation = 365 # requiring 365 days prior obs + ), outcomeIds = outcomeIds, riskWindowStart = 1, startAnchor = 'cohort start', @@ -78,8 +90,7 @@ targetIds <- c(1,2,4) characterizationSettings <- createCharacterizationSettings( timeToEventSettings = list( - timeToEventSettings1, - timeToEventSettings2 + timeToEventSettings ), dechallengeRechallengeSettings = list( dechallengeRechallengeSettings @@ -123,6 +134,10 @@ Installation 2. In R, use the following commands to download and install Characterization: ```r + # CRAN + install.packages('Characterization') + + # GitHub install.packages("remotes") remotes::install_github("ohdsi/Characterization") ``` diff --git a/inst/settings/resultsDataModelSpecification.csv b/inst/settings/resultsDataModelSpecification.csv index 0175359..fcefd14 100644 --- a/inst/settings/resultsDataModelSpecification.csv +++ b/inst/settings/resultsDataModelSpecification.csv @@ -1,192 +1,235 @@ -table_name,column_name,data_type,is_required,primary_key,empty_is_na,min_cell_count,description -time_to_event,database_id,varchar(100),Yes,Yes,No,No,The database identifier -time_to_event,target_cohort_definition_id,bigint,Yes,Yes,No,No,The cohort definition id for the target cohort -time_to_event,outcome_cohort_definition_id,bigint,Yes,Yes,No,No,The cohort definition id for the outcome cohort -time_to_event,outcome_type,varchar(100),Yes,Yes,No,No,Is the outvome a first occurrence or repeat -time_to_event,target_outcome_type,varchar(40),Yes,Yes,No,No,When does the outcome occur relative to target -time_to_event,time_to_event,int,Yes,Yes,No,No,The time (in days) from target index to outcome start -time_to_event,num_events,int,Yes,No,No,No,Number of events that occur during the specified time to event -time_to_event,time_scale,varchar(20),Yes,Yes,No,No,time scale for the number of events -rechallenge_fail_case_series,database_id,varchar(100),Yes,Yes,No,No,The database identifier -rechallenge_fail_case_series,dechallenge_stop_interval,int,Yes,Yes,No,No,The time period that É -rechallenge_fail_case_series,dechallenge_evaluation_window,int,Yes,Yes,No,No,The time period that É -rechallenge_fail_case_series,target_cohort_definition_id,bigint,Yes,Yes,No,No,The cohort definition id for the target cohort -rechallenge_fail_case_series,outcome_cohort_definition_id,bigint,Yes,Yes,No,No,The cohort definition id for the outcome cohort -rechallenge_fail_case_series,person_key,int,Yes,Yes,No,No,The dense rank for the patient (an identifier that is not the same as the database) -rechallenge_fail_case_series,subject_id,bigint,No,No,No,No,The person identifier for the failed case series (optional) -rechallenge_fail_case_series,dechallenge_exposure_number,int,Yes,Yes,No,No,The number of times a dechallenge has occurred -rechallenge_fail_case_series,dechallenge_exposure_start_date_offset,int,Yes,No,No,No,The offset for the dechallenge start (number of days after index) -rechallenge_fail_case_series,dechallenge_exposure_end_date_offset,int,Yes,No,No,No,The offset for the dechallenge end (number of days after index) -rechallenge_fail_case_series,dechallenge_outcome_number,int,Yes,Yes,No,No,The number of times an outcome has occurred during the dechallenge -rechallenge_fail_case_series,dechallenge_outcome_start_date_offset,int,Yes,No,No,No,The offset for the outcome start (number of days after index) -rechallenge_fail_case_series,rechallenge_exposure_number,int,Yes,Yes,No,No,The number of times a rechallenge exposure has occurred -rechallenge_fail_case_series,rechallenge_exposure_start_date_offset,int,Yes,No,No,No,The offset for the rechallenge start (number of days after index) -rechallenge_fail_case_series,rechallenge_exposure_end_date_offset,int,Yes,No,No,No,The offset for the rechallenge end (number of days after index) -rechallenge_fail_case_series,rechallenge_outcome_number,int,Yes,Yes,No,No,The number of times the outcome has occurred during the rechallenge -rechallenge_fail_case_series,rechallenge_outcome_start_date_offset,int,Yes,No,No,No,The offset for the outcome start (number of days after index) -dechallenge_rechallenge,database_id,varchar(100),Yes,Yes,No,No,The database identifier -dechallenge_rechallenge,dechallenge_stop_interval,int,Yes,Yes,No,No,The dechallenge stop interval -dechallenge_rechallenge,dechallenge_evaluation_window,int,Yes,Yes,No,No,The dechallenge evaluation window -dechallenge_rechallenge,target_cohort_definition_id,bigint,Yes,Yes,No,No,The cohort definition id for the target cohort -dechallenge_rechallenge,outcome_cohort_definition_id,bigint,Yes,Yes,No,No,The cohort definition id for the outcome cohort -dechallenge_rechallenge,num_exposure_eras,int,Yes,No,No,No,The number of exposure eras -dechallenge_rechallenge,num_persons_exposed,int,Yes,No,No,No,The number of persons exposed -dechallenge_rechallenge,num_cases,int,Yes,No,No,No,The number of cases -dechallenge_rechallenge,dechallenge_attempt,int,Yes,No,No,No,The number of dechallenge attempts -dechallenge_rechallenge,dechallenge_fail,int,Yes,No,No,No,The dechallenge fail count -dechallenge_rechallenge,dechallenge_success,int,Yes,No,No,No,The dechallenge success count -dechallenge_rechallenge,rechallenge_attempt,int,Yes,No,No,No,The rechallenge attempt count -dechallenge_rechallenge,rechallenge_fail,int,Yes,No,No,No,The rechallenge fail count -dechallenge_rechallenge,rechallenge_success,int,Yes,No,No,No,The rechallenge success count -dechallenge_rechallenge,pct_dechallenge_attempt,float,Yes,No,No,No,The percentage of dechallenge attempts -dechallenge_rechallenge,pct_dechallenge_success,float,Yes,No,No,No,The percentage of dechallenge success -dechallenge_rechallenge,pct_dechallenge_fail,float,Yes,No,No,No,The percentage of dechallenge fails -dechallenge_rechallenge,pct_rechallenge_attempt,float,Yes,No,No,No,The percentage of rechallenge attempts -dechallenge_rechallenge,pct_rechallenge_success,float,Yes,No,No,No,The percentage of rechallenge success -dechallenge_rechallenge,pct_rechallenge_fail,float,Yes,No,No,No,The percentage of rechallenge fails -analysis_ref,database_id,varchar(100),Yes,Yes,No,No,The database identifier -analysis_ref,setting_id,varchar(50),Yes,Yes,No,No,The run identifier -analysis_ref,analysis_id,int,Yes,Yes,No,No,The analysis identifier -analysis_ref,analysis_name,varchar,Yes,No,No,No,The analysis name -analysis_ref,domain_id,varchar,No,No,No,No,The domain id -analysis_ref,start_day,int,No,No,No,No,The start day -analysis_ref,end_day,int,No,No,No,No,The end day -analysis_ref,is_binary,varchar(1),No,No,No,No,Is this a binary analysis -analysis_ref,missing_means_zero,varchar(1),No,No,No,No,Missing means zero -covariate_ref,database_id,varchar(100),Yes,Yes,No,No,The database identifier -covariate_ref,setting_id,varchar(50),Yes,Yes,No,No,The run identifier -covariate_ref,covariate_id,bigint,Yes,Yes,No,No,The covariate identifier -covariate_ref,covariate_name,varchar,Yes,No,No,No,The covariate name -covariate_ref,analysis_id,int,Yes,No,No,No,The analysis identifier -covariate_ref,concept_id,bigint,Yes,No,No,No,The concept identifier -covariate_ref,value_as_concept_id,int,No,No,No,No,The value as concept_id for features created from observation or measurement values -covariate_ref,collisions,int,No,No,No,No,The number of collisions found for the covariate_id -target_covariates,database_id,varchar(100),Yes,Yes,No,No,The database identifier -target_covariates,setting_id,varchar(50),Yes,Yes,No,No,The run identifier -target_covariates,characterization_target_id,int,Yes,Yes,No,No,The characteriation target id -target_covariates,covariate_id,bigint,Yes,Yes,No,No,The covaraite id -target_covariates,sum_value,int,No,No,No,No,The sum value -target_covariates,average_value,float,No,No,No,No,The average value -target_covariates_continuous,database_id,varchar(100),Yes,Yes,No,No,The database identifier -target_covariates_continuous,setting_id,varchar(50),Yes,Yes,No,No,The run identifier -target_covariates_continuous,characterization_target_id,int,Yes,Yes,No,No,The characteriation target id -target_covariates_continuous,covariate_id,bigint,Yes,Yes,No,No,The covariate identifier -target_covariates_continuous,count_value,int,No,No,No,No,The count value -target_covariates_continuous,min_value,float,No,No,No,No,The min value -target_covariates_continuous,max_value,float,No,No,No,No,The max value -target_covariates_continuous,average_value,float,No,No,No,No,The average value -target_covariates_continuous,standard_deviation,float,No,No,No,No,The standard devidation -target_covariates_continuous,median_value,float,No,No,No,No,The median value -target_covariates_continuous,p_10_value,float,No,No,No,No,The 10th percentile -target_covariates_continuous,p_25_value,float,No,No,No,No,The 25th percentile -target_covariates_continuous,p_75_value,float,No,No,No,No,The 75th percentile -target_covariates_continuous,p_90_value,float,No,No,No,No,The 90th percentile -execution_settings,setting_id,varchar(50),Yes,Yes,No,No,The run identifier -execution_settings,database_id,varchar(100),Yes,Yes,No,No,The database identifier -execution_settings,database_hash,varchar(50),Yes,No,No,No, -execution_settings,mode,varchar(25),No,No,No,No,Whether Efficient/CohortIncidence/PatientLevelPrediction mode was used for risk factor non-cases -execution_settings,min_characterization_mean,float,No,No,No,No,The minimum fraction of patients who have a covariate for the covariate to be included in results -execution_settings,min_covariate_count,int,No,No,No,No,The minimum number of patients who have a covariate for the covariate to be included in results (useful if cohorts are small) -execution_settings,min_smd,float,No,No,No,No,The minimum standardized mean value a risk factor must have to be included in results -target_settings,setting_id,varchar(50),Yes,Yes,No,No,The run identifier -target_settings,database_id,varchar(100),Yes,Yes,No,No,The database identifier -target_settings,characterization_target_id,bigint,Yes,Yes,No,No,The target cohort id after inclusion criteria used internally by characterization -target_settings,target_id,bigint,No,No,No,No,The target cohort id -target_settings,limit_to_first_in_n_days,int,No,No,No,No,Target exposures are only included if they occur >= first_in_n_days days after the last exposure -target_settings,min_prior_observation,int,No,No,No,No,Target exposures with < min_prior_obs days observation before exposure are excluded -case_settings,setting_id,varchar(50),Yes,Yes,No,No,The run identifier -case_settings,database_id,varchar(100),Yes,Yes,No,No,The database identifier -case_settings,characterization_case_id,bigint,Yes,Yes,No,No,"The case cohort id that is unique per characterization_target_id, outcome_id, outcome_washout_days and time-at-risk settings" -case_settings,characterization_target_id,bigint,Yes,No,No,No,The target cohort id after inclusion criteria used internally by characterization -case_settings,outcome_id,bigint,No,No,No,No,The outcome cohort id -case_settings,outcome_washout_days,int,No,No,No,No,Outcome exposures with < outcome_washout_days days after the last outcome exposure are excluded -case_settings,start_anchor,varchar(15),No,No,No,No,The start anchor -case_settings,end_anchor,varchar(15),No,No,No,No,The end anchor -case_settings,risk_window_start,int,No,No,No,No,The risk window start -case_settings,risk_window_end,int,No,No,No,No,The risk window end -case_settings,runtype,varchar(50),No,No,No,No,Whether this case was used in risk-factor and/or case-series -case_series_settings,setting_id,varchar(50),Yes,Yes,No,No,The run identifier -case_series_settings,case_pre_target_duration,int,No,No,No,No,The number of days before target index to create the before target period in case series -case_series_settings,case_post_outcome_duration,int,No,No,No,No,The number of days after first outcome after target to create the after outcome period in case series -attrition,cohort_definition_id,bigint,Yes,Yes,No,No,The characterization cohort id -attrition,attr_reason,varchar(100),No,Yes,No,No,Description of cohort or removal -attrition,n,bigint,No,No,No,No,The number of people remaining or removed -attrition,database_id,varchar(100),Yes,Yes,No,No,The database identifier -attrition,setting_id,varchar(50),Yes,Yes,No,No,The run identifier -risk_factor_covariates,database_id,varchar(100),Yes,Yes,No,No,The database identifier -risk_factor_covariates,setting_id,varchar(50),Yes,Yes,No,No,The run identifier -risk_factor_covariates,characterization_case_id,bigint,Yes,Yes,No,No,"The case cohort id that is unique per characterization_target_id, outcome_id, outcome_washout_days and time-at-risk settings" -risk_factor_covariates,covariate_id,bigint,Yes,Yes,No,No,The covaraite id -risk_factor_covariates,non_case_sum_value,int,No,No,No,No,The sum value for the non-cases -risk_factor_covariates,non_case_average_value,float,No,No,No,No,The average value for the non-cases -risk_factor_covariates,case_sum_value,int,No,No,No,No,The sum value of the cases -risk_factor_covariates,case_average_value,float,No,No,No,No,The average value of the cases -risk_factor_covariates,standardized_mean_difference,float,No,No,No,No,The standardized mean difference for the covariate -risk_factor_covariates_continuous,database_id,varchar(100),Yes,Yes,No,No,The database identifier -risk_factor_covariates_continuous,setting_id,varchar(50),Yes,Yes,No,No,The run identifier -risk_factor_covariates_continuous,characterization_case_id,bigint,Yes,Yes,No,No,"The case cohort id that is unique per characterization_target_id, outcome_id, outcome_washout_days and time-at-risk settings" -risk_factor_covariates_continuous,covariate_id,bigint,Yes,Yes,No,No,The covariate identifier -risk_factor_covariates_continuous,case_count_value,int,No,No,No,No,The count value -risk_factor_covariates_continuous,case_min_value,float,No,No,No,No,The min value -risk_factor_covariates_continuous,case_max_value,float,No,No,No,No,The max value -risk_factor_covariates_continuous,case_average_value,float,No,No,No,No,The average value -risk_factor_covariates_continuous,case_standard_deviation,float,No,No,No,No,The standard devidation -risk_factor_covariates_continuous,case_median_value,float,No,No,No,No,The median value -risk_factor_covariates_continuous,case_p_10_value,float,No,No,No,No,The 10th percentile -risk_factor_covariates_continuous,case_p_25_value,float,No,No,No,No,The 25th percentile -risk_factor_covariates_continuous,case_p_75_value,float,No,No,No,No,The 75th percentile -risk_factor_covariates_continuous,case_p_90_value,float,No,No,No,No,The 90th percentile -risk_factor_covariates_continuous,non_case_count_value,int,No,No,No,No,The count value -risk_factor_covariates_continuous,non_case_min_value,float,No,No,No,No,The min value -risk_factor_covariates_continuous,non_case_max_value,float,No,No,No,No,The max value -risk_factor_covariates_continuous,non_case_average_value,float,No,No,No,No,The average value -risk_factor_covariates_continuous,non_case_standard_deviation,float,No,No,No,No,The standard devidation -risk_factor_covariates_continuous,non_case_median_value,float,No,No,No,No,The median value -risk_factor_covariates_continuous,non_case_p_10_value,float,No,No,No,No,The 10th percentile -risk_factor_covariates_continuous,non_case_p_25_value,float,No,No,No,No,The 25th percentile -risk_factor_covariates_continuous,non_case_p_75_value,float,No,No,No,No,The 75th percentile -risk_factor_covariates_continuous,non_case_p_90_value,float,No,No,No,No,The 90th percentile -risk_factor_covariates_continuous,standardized_mean_difference,float,No,No,No,No,The standardized mean difference for the covariate -case_series_covariates,database_id,varchar(100),Yes,Yes,No,No,The database identifier -case_series_covariates,setting_id,varchar(50),Yes,Yes,No,No,The run identifier -case_series_covariates,characterization_case_id,bigint,Yes,Yes,No,No,"The case cohort id that is unique per characterization_target_id, outcome_id, outcome_washout_days and time-at-risk settings" -case_series_covariates,covariate_id,bigint,Yes,Yes,No,No,The covaraite id -case_series_covariates,before_sum_value,int,No,No,No,No,The sum value for the non-cases -case_series_covariates,before_average_value,float,No,No,No,No,The average value for the non-cases -case_series_covariates,during_sum_value,int,No,No,No,No,The sum value of the cases -case_series_covariates,during_average_value,float,No,No,No,No,The average value of the cases -case_series_covariates,after_sum_value,int,No,No,No,No,The sum value of the cases -case_series_covariates,after_average_value,float,No,No,No,No,The average value of the cases -case_series_covariates_continuous,database_id,varchar(100),Yes,Yes,No,No,The database identifier -case_series_covariates_continuous,setting_id,varchar(50),Yes,Yes,No,No,The run identifier -case_series_covariates_continuous,characterization_case_id,bigint,Yes,Yes,No,No,"The case cohort id that is unique per characterization_target_id, outcome_id, outcome_washout_days and time-at-risk settings" -case_series_covariates_continuous,covariate_id,bigint,Yes,Yes,No,No,The covariate identifier -case_series_covariates_continuous,before_count_value,int,No,No,No,No,The count value -case_series_covariates_continuous,before_min_value,float,No,No,No,No,The min value -case_series_covariates_continuous,before_max_value,float,No,No,No,No,The max value -case_series_covariates_continuous,before_average_value,float,No,No,No,No,The average value -case_series_covariates_continuous,before_standard_deviation,float,No,No,No,No,The standard devidation -case_series_covariates_continuous,before_median_value,float,No,No,No,No,The median value -case_series_covariates_continuous,before_p_10_value,float,No,No,No,No,The 10th percentile -case_series_covariates_continuous,before_p_25_value,float,No,No,No,No,The 25th percentile -case_series_covariates_continuous,before_p_75_value,float,No,No,No,No,The 75th percentile -case_series_covariates_continuous,before_p_90_value,float,No,No,No,No,The 90th percentile -case_series_covariates_continuous,during_min_value,float,No,No,No,No,The min value -case_series_covariates_continuous,during_max_value,float,No,No,No,No,The max value -case_series_covariates_continuous,during_average_value,float,No,No,No,No,The average value -case_series_covariates_continuous,during_standard_deviation,float,No,No,No,No,The standard devidation -case_series_covariates_continuous,during_median_value,float,No,No,No,No,The median value -case_series_covariates_continuous,during_p_10_value,float,No,No,No,No,The 10th percentile -case_series_covariates_continuous,during_p_25_value,float,No,No,No,No,The 25th percentile -case_series_covariates_continuous,during_p_75_value,float,No,No,No,No,The 75th percentile -case_series_covariates_continuous,during_p_90_value,float,No,No,No,No,The 90th percentile -case_series_covariates_continuous,after_count_value,int,No,No,No,No,The count value -case_series_covariates_continuous,after_min_value,float,No,No,No,No,The min value -case_series_covariates_continuous,after_max_value,float,No,No,No,No,The max value -case_series_covariates_continuous,after_average_value,float,No,No,No,No,The average value -case_series_covariates_continuous,after_standard_deviation,float,No,No,No,No,The standard devidation -case_series_covariates_continuous,after_median_value,float,No,No,No,No,The median value -case_series_covariates_continuous,after_p_10_value,float,No,No,No,No,The 10th percentile -case_series_covariates_continuous,after_p_25_value,float,No,No,No,No,The 25th percentile -case_series_covariates_continuous,after_p_75_value,float,No,No,No,No,The 75th percentile -case_series_covariates_continuous,after_p_90_value,float,No,No,No,No,The 90th percentile \ No newline at end of file +table_name,column_name,data_type,is_required,primary_key,empty_is_na,min_cell_count,description +time_to_event,database_id,varchar(100),Yes,Yes,No,No,The database identifier +time_to_event,characterization_target_id,bigint,Yes,Yes,No,No,The characterization cohort definition id for the target cohort +time_to_event,outcome_cohort_definition_id,bigint,Yes,Yes,No,No,The cohort definition id for the outcome cohort +time_to_event,outcome_type,varchar(100),Yes,Yes,No,No,Is the outvome a first occurrence or repeat +time_to_event,target_outcome_type,varchar(40),Yes,Yes,No,No,When does the outcome occur relative to target +time_to_event,time_to_event,int,Yes,Yes,No,No,The time (in days) from target index to outcome start +time_to_event,num_events,int,Yes,No,No,No,Number of events that occur during the specified time to event +time_to_event,time_scale,varchar(20),Yes,Yes,No,No,time scale for the number of events +rechallenge_fail_case_series,database_id,varchar(100),Yes,Yes,No,No,The database identifier +rechallenge_fail_case_series,dechallenge_stop_interval,int,Yes,Yes,No,No,The time period that É +rechallenge_fail_case_series,dechallenge_evaluation_window,int,Yes,Yes,No,No,The time period that É +rechallenge_fail_case_series,characterization_target_id,bigint,Yes,Yes,No,No,The cohort definition id for the target cohort +rechallenge_fail_case_series,included,char(1),No,No,No,No,Whether this was included in the study population settings eras +rechallenge_fail_case_series,outcome_cohort_definition_id,bigint,Yes,Yes,No,No,The cohort definition id for the outcome cohort +rechallenge_fail_case_series,person_key,int,Yes,Yes,No,No,The dense rank for the patient (an identifier that is not the same as the database) +rechallenge_fail_case_series,subject_id,bigint,No,No,No,No,The person identifier for the failed case series (optional) +rechallenge_fail_case_series,dechallenge_exposure_number,int,Yes,Yes,No,No,The number of times a dechallenge has occurred +rechallenge_fail_case_series,dechallenge_exposure_start_date_offset,int,Yes,No,No,No,The offset for the dechallenge start (number of days after index) +rechallenge_fail_case_series,dechallenge_exposure_end_date_offset,int,Yes,No,No,No,The offset for the dechallenge end (number of days after index) +rechallenge_fail_case_series,dechallenge_outcome_number,int,Yes,Yes,No,No,The number of times an outcome has occurred during the dechallenge +rechallenge_fail_case_series,dechallenge_outcome_start_date_offset,int,Yes,No,No,No,The offset for the outcome start (number of days after index) +rechallenge_fail_case_series,rechallenge_exposure_number,int,Yes,Yes,No,No,The number of times a rechallenge exposure has occurred +rechallenge_fail_case_series,rechallenge_exposure_start_date_offset,int,Yes,No,No,No,The offset for the rechallenge start (number of days after index) +rechallenge_fail_case_series,rechallenge_exposure_end_date_offset,int,Yes,No,No,No,The offset for the rechallenge end (number of days after index) +rechallenge_fail_case_series,rechallenge_outcome_number,int,Yes,Yes,No,No,The number of times the outcome has occurred during the rechallenge +rechallenge_fail_case_series,rechallenge_outcome_start_date_offset,int,Yes,No,No,No,The offset for the outcome start (number of days after index) +dechallenge_rechallenge,database_id,varchar(100),Yes,Yes,No,No,The database identifier +dechallenge_rechallenge,dechallenge_stop_interval,int,Yes,Yes,No,No,The dechallenge stop interval +dechallenge_rechallenge,dechallenge_evaluation_window,int,Yes,Yes,No,No,The dechallenge evaluation window +dechallenge_rechallenge,characterization_target_id,bigint,Yes,Yes,No,No,The characterization cohort definition id for the target cohort +dechallenge_rechallenge,outcome_cohort_definition_id,bigint,Yes,Yes,No,No,The cohort definition id for the outcome cohort +dechallenge_rechallenge,num_exposure_eras,int,Yes,No,No,No,The number of exposure eras +dechallenge_rechallenge,num_persons_exposed,int,Yes,No,No,No,The number of persons exposed +dechallenge_rechallenge,num_cases,int,Yes,No,No,No,The number of cases +dechallenge_rechallenge,dechallenge_attempt,int,Yes,No,No,No,The number of dechallenge attempts +dechallenge_rechallenge,dechallenge_fail,int,Yes,No,No,No,The dechallenge fail count +dechallenge_rechallenge,dechallenge_success,int,Yes,No,No,No,The dechallenge success count +dechallenge_rechallenge,rechallenge_attempt,int,Yes,No,No,No,The rechallenge attempt count +dechallenge_rechallenge,rechallenge_fail,int,Yes,No,No,No,The rechallenge fail count +dechallenge_rechallenge,rechallenge_success,int,Yes,No,No,No,The rechallenge success count +dechallenge_rechallenge,pct_dechallenge_attempt,float,Yes,No,No,No,The percentage of dechallenge attempts +dechallenge_rechallenge,pct_dechallenge_success,float,Yes,No,No,No,The percentage of dechallenge success +dechallenge_rechallenge,pct_dechallenge_fail,float,Yes,No,No,No,The percentage of dechallenge fails +dechallenge_rechallenge,pct_rechallenge_attempt,float,Yes,No,No,No,The percentage of rechallenge attempts +dechallenge_rechallenge,pct_rechallenge_success,float,Yes,No,No,No,The percentage of rechallenge success +dechallenge_rechallenge,pct_rechallenge_fail,float,Yes,No,No,No,The percentage of rechallenge fails +analysis_ref,database_id,varchar(100),Yes,Yes,No,No,The database identifier +analysis_ref,setting_id,varchar(50),Yes,Yes,No,No,The run identifier +analysis_ref,analysis_id,int,Yes,Yes,No,No,The analysis identifier +analysis_ref,analysis_name,varchar,Yes,No,No,No,The analysis name +analysis_ref,domain_id,varchar,No,No,No,No,The domain id +analysis_ref,start_day,int,No,No,No,No,The start day +analysis_ref,end_day,int,No,No,No,No,The end day +analysis_ref,is_binary,varchar(1),No,No,No,No,Is this a binary analysis +analysis_ref,missing_means_zero,varchar(1),No,No,No,No,Missing means zero +covariate_ref,database_id,varchar(100),Yes,Yes,No,No,The database identifier +covariate_ref,setting_id,varchar(50),Yes,Yes,No,No,The run identifier +covariate_ref,covariate_id,bigint,Yes,Yes,No,No,The covariate identifier +covariate_ref,covariate_name,varchar,Yes,No,No,No,The covariate name +covariate_ref,analysis_id,int,Yes,No,No,No,The analysis identifier +covariate_ref,concept_id,bigint,Yes,No,No,No,The concept identifier +covariate_ref,value_as_concept_id,int,No,No,No,No,The value as concept_id for features created from observation or measurement values +covariate_ref,collisions,int,No,No,No,No,The number of collisions found for the covariate_id +target_covariates,database_id,varchar(100),Yes,Yes,No,No,The database identifier +target_covariates,setting_id,varchar(50),Yes,Yes,No,No,The run identifier +target_covariates,characterization_target_id,int,Yes,Yes,No,No,The characteriation target id +target_covariates,covariate_id,bigint,Yes,Yes,No,No,The covaraite id +target_covariates,sum_value,int,No,No,No,No,The sum value +target_covariates,average_value,float,No,No,No,No,The average value +target_covariates_continuous,database_id,varchar(100),Yes,Yes,No,No,The database identifier +target_covariates_continuous,setting_id,varchar(50),Yes,Yes,No,No,The run identifier +target_covariates_continuous,characterization_target_id,int,Yes,Yes,No,No,The characteriation target id +target_covariates_continuous,covariate_id,bigint,Yes,Yes,No,No,The covariate identifier +target_covariates_continuous,count_value,int,No,No,No,No,The count value +target_covariates_continuous,min_value,float,No,No,No,No,The min value +target_covariates_continuous,max_value,float,No,No,No,No,The max value +target_covariates_continuous,average_value,float,No,No,No,No,The average value +target_covariates_continuous,standard_deviation,float,No,No,No,No,The standard devidation +target_covariates_continuous,median_value,float,No,No,No,No,The median value +target_covariates_continuous,p_10_value,float,No,No,No,No,The 10th percentile +target_covariates_continuous,p_25_value,float,No,No,No,No,The 25th percentile +target_covariates_continuous,p_75_value,float,No,No,No,No,The 75th percentile +target_covariates_continuous,p_90_value,float,No,No,No,No,The 90th percentile +execution_settings,setting_id,varchar(50),Yes,Yes,No,No,The run identifier +execution_settings,database_id,varchar(100),Yes,Yes,No,No,The database identifier +execution_settings,database_hash,varchar(50),Yes,No,No,No,The hash of the database identifier +execution_settings,mode,varchar(25),No,No,No,No,Whether Efficient/CohortIncidence/PatientLevelPrediction mode was used for risk factor non-cases +execution_settings,min_characterization_mean,float,No,No,No,No,The minimum fraction of patients who have a covariate for the covariate to be included in results +execution_settings,min_covariate_count,int,No,No,No,No,The minimum number of patients who have a covariate for the covariate to be included in results (useful if cohorts are small) +execution_settings,min_smd,float,No,No,No,No,The minimum standardized mean value a risk factor must have to be included in results +execution_settings,min_target_size,bigint,No,No,No,No,"The minimum target cohort size to be included in target baseline, risk factor and case series results" +execution_settings,min_case_size,bigint,No,No,No,No,The minimum case cohort size to be included in risk factor and case series results +target_settings,setting_id,varchar(50),Yes,Yes,No,No,The run identifier +target_settings,database_id,varchar(100),Yes,Yes,No,No,The database identifier +target_settings,characterization_target_id,bigint,Yes,Yes,No,No,The target cohort id after inclusion criteria used internally by characterization +target_settings,target_id,bigint,No,No,No,No,The target cohort id +target_settings,limit_to_first_in_n_days,int,No,No,No,No,"Target exposures are only included if they occur >= first_in_n_days days after the last exposure" +target_settings,min_prior_observation,int,No,No,No,No,"Target exposures with < min_prior_obs days observation before exposure are excluded" +target_settings,nesting_cohort_id,bigint,No,No,No,No,The nesting id for the popualtion of interest +target_settings,min_age,int,No,No,No,No,The min age to be includedfor the popualtion of interest +target_settings,max_age,int,No,No,No,No,The max age to be includedfor the popualtion of interest +target_settings,study_start,char(8),No,No,No,No,The earliest date to be included for the popualtion of interest +target_settings,study_end,char(8),No,No,No,No,The latest date to be included for the popualtion of interest +target_settings,gender_concept_ids,varchar(100),No,No,No,No,The gender conept ids to be included for the popualtion of interest +target_settings,time_to_event_settings,char(1),No,No,No,No,Whether used in time to event +target_settings,dechallenge_rechallenge_settings,char(1),No,No,No,No,Whether used in dechal-rechal +target_settings,target_baseline_settings,char(1),No,No,No,No,Whether used in target baseline +target_settings,risk_factor_settings,char(1),No,No,No,No,Whether used in risk factor +target_settings,case_series_settings,char(1),No,No,No,No,Whether used in case series +case_settings,setting_id,varchar(50),Yes,Yes,No,No,The run identifier +case_settings,database_id,varchar(100),Yes,Yes,No,No,The database identifier +case_settings,characterization_case_id,bigint,Yes,Yes,No,No,"The case cohort id that is unique per characterization_target_id, outcome_id, outcome_washout_days and time-at-risk settings" +case_settings,characterization_target_id,bigint,Yes,No,No,No,The target cohort id after inclusion criteria used internally by characterization +case_settings,outcome_id,bigint,No,No,No,No,The outcome cohort id +case_settings,outcome_washout_days,int,No,No,No,No,"Outcome exposures with < outcome_washout_days days after the last outcome exposure are excluded" +case_settings,start_anchor,varchar(15),No,No,No,No,The start anchor +case_settings,end_anchor,varchar(15),No,No,No,No,The end anchor +case_settings,risk_window_start,int,No,No,No,No,The risk window start +case_settings,risk_window_end,int,No,No,No,No,The risk window end +case_settings,risk_factor_settings,char(1),No,No,No,No,Whether this case was used in risk-factor +case_settings,case_series_settings,char(1),No,No,No,No,Whether this case was used in case-series +case_series_settings,setting_id,varchar(50),Yes,Yes,No,No,The run identifier +case_series_settings,case_pre_target_duration,int,No,No,No,No,The number of days before target index to create the before target period in case series +case_series_settings,case_post_outcome_duration,int,No,No,No,No,The number of days after first outcome after target to create the after outcome period in case series +risk_factor_covariates,database_id,varchar(100),Yes,Yes,No,No,The database identifier +risk_factor_covariates,setting_id,varchar(50),Yes,Yes,No,No,The run identifier +risk_factor_covariates,characterization_case_id,bigint,Yes,Yes,No,No,"The case cohort id that is unique per characterization_target_id, outcome_id, outcome_washout_days and time-at-risk settings" +risk_factor_covariates,covariate_id,bigint,Yes,Yes,No,No,The covaraite id +risk_factor_covariates,non_case_sum_value,int,No,No,No,No,The sum value for the non-cases +risk_factor_covariates,non_case_average_value,float,No,No,No,No,The average value for the non-cases +risk_factor_covariates,case_sum_value,int,No,No,No,No,The sum value of the cases +risk_factor_covariates,case_average_value,float,No,No,No,No,The average value of the cases +risk_factor_covariates,standardized_mean_difference,float,No,No,No,No,The standardized mean difference for the covariate +risk_factor_covariates_continuous,database_id,varchar(100),Yes,Yes,No,No,The database identifier +risk_factor_covariates_continuous,setting_id,varchar(50),Yes,Yes,No,No,The run identifier +risk_factor_covariates_continuous,characterization_case_id,bigint,Yes,Yes,No,No,"The case cohort id that is unique per characterization_target_id, outcome_id, outcome_washout_days and time-at-risk settings" +risk_factor_covariates_continuous,covariate_id,bigint,Yes,Yes,No,No,The covariate identifier +risk_factor_covariates_continuous,case_count_value,int,No,No,No,No,The count value +risk_factor_covariates_continuous,case_min_value,float,No,No,No,No,The min value +risk_factor_covariates_continuous,case_max_value,float,No,No,No,No,The max value +risk_factor_covariates_continuous,case_average_value,float,No,No,No,No,The average value +risk_factor_covariates_continuous,case_standard_deviation,float,No,No,No,No,The standard devidation +risk_factor_covariates_continuous,case_median_value,float,No,No,No,No,The median value +risk_factor_covariates_continuous,case_p_10_value,float,No,No,No,No,The 10th percentile +risk_factor_covariates_continuous,case_p_25_value,float,No,No,No,No,The 25th percentile +risk_factor_covariates_continuous,case_p_75_value,float,No,No,No,No,The 75th percentile +risk_factor_covariates_continuous,case_p_90_value,float,No,No,No,No,The 90th percentile +risk_factor_covariates_continuous,non_case_count_value,int,No,No,No,No,The count value +risk_factor_covariates_continuous,non_case_min_value,float,No,No,No,No,The min value +risk_factor_covariates_continuous,non_case_max_value,float,No,No,No,No,The max value +risk_factor_covariates_continuous,non_case_average_value,float,No,No,No,No,The average value +risk_factor_covariates_continuous,non_case_standard_deviation,float,No,No,No,No,The standard devidation +risk_factor_covariates_continuous,non_case_median_value,float,No,No,No,No,The median value +risk_factor_covariates_continuous,non_case_p_10_value,float,No,No,No,No,The 10th percentile +risk_factor_covariates_continuous,non_case_p_25_value,float,No,No,No,No,The 25th percentile +risk_factor_covariates_continuous,non_case_p_75_value,float,No,No,No,No,The 75th percentile +risk_factor_covariates_continuous,non_case_p_90_value,float,No,No,No,No,The 90th percentile +risk_factor_covariates_continuous,standardized_mean_difference,float,No,No,No,No,The standardized mean difference for the covariate +case_series_covariates,database_id,varchar(100),Yes,Yes,No,No,The database identifier +case_series_covariates,setting_id,varchar(50),Yes,Yes,No,No,The run identifier +case_series_covariates,characterization_case_id,bigint,Yes,Yes,No,No,"The case cohort id that is unique per characterization_target_id, outcome_id, outcome_washout_days and time-at-risk settings" +case_series_covariates,covariate_id,bigint,Yes,Yes,No,No,The covaraite id +case_series_covariates,before_sum_value,int,No,No,No,No,The sum value for the non-cases +case_series_covariates,before_average_value,float,No,No,No,No,The average value for the non-cases +case_series_covariates,during_sum_value,int,No,No,No,No,The sum value of the cases +case_series_covariates,during_average_value,float,No,No,No,No,The average value of the cases +case_series_covariates,after_sum_value,int,No,No,No,No,The sum value of the cases +case_series_covariates,after_average_value,float,No,No,No,No,The average value of the cases +case_series_covariates_continuous,database_id,varchar(100),Yes,Yes,No,No,The database identifier +case_series_covariates_continuous,setting_id,varchar(50),Yes,Yes,No,No,The run identifier +case_series_covariates_continuous,characterization_case_id,bigint,Yes,Yes,No,No,"The case cohort id that is unique per characterization_target_id, outcome_id, outcome_washout_days and time-at-risk settings" +case_series_covariates_continuous,covariate_id,bigint,Yes,Yes,No,No,The covariate identifier +case_series_covariates_continuous,before_count_value,int,No,No,No,No,The count value +case_series_covariates_continuous,before_min_value,float,No,No,No,No,The min value +case_series_covariates_continuous,before_max_value,float,No,No,No,No,The max value +case_series_covariates_continuous,before_average_value,float,No,No,No,No,The average value +case_series_covariates_continuous,before_standard_deviation,float,No,No,No,No,The standard devidation +case_series_covariates_continuous,before_median_value,float,No,No,No,No,The median value +case_series_covariates_continuous,before_p_10_value,float,No,No,No,No,The 10th percentile +case_series_covariates_continuous,before_p_25_value,float,No,No,No,No,The 25th percentile +case_series_covariates_continuous,before_p_75_value,float,No,No,No,No,The 75th percentile +case_series_covariates_continuous,before_p_90_value,float,No,No,No,No,The 90th percentile +case_series_covariates_continuous,during_min_value,float,No,No,No,No,The min value +case_series_covariates_continuous,during_max_value,float,No,No,No,No,The max value +case_series_covariates_continuous,during_average_value,float,No,No,No,No,The average value +case_series_covariates_continuous,during_standard_deviation,float,No,No,No,No,The standard devidation +case_series_covariates_continuous,during_median_value,float,No,No,No,No,The median value +case_series_covariates_continuous,during_p_10_value,float,No,No,No,No,The 10th percentile +case_series_covariates_continuous,during_p_25_value,float,No,No,No,No,The 25th percentile +case_series_covariates_continuous,during_p_75_value,float,No,No,No,No,The 75th percentile +case_series_covariates_continuous,during_p_90_value,float,No,No,No,No,The 90th percentile +case_series_covariates_continuous,after_count_value,int,No,No,No,No,The count value +case_series_covariates_continuous,after_min_value,float,No,No,No,No,The min value +case_series_covariates_continuous,after_max_value,float,No,No,No,No,The max value +case_series_covariates_continuous,after_average_value,float,No,No,No,No,The average value +case_series_covariates_continuous,after_standard_deviation,float,No,No,No,No,The standard devidation +case_series_covariates_continuous,after_median_value,float,No,No,No,No,The median value +case_series_covariates_continuous,after_p_10_value,float,No,No,No,No,The 10th percentile +case_series_covariates_continuous,after_p_25_value,float,No,No,No,No,The 25th percentile +case_series_covariates_continuous,after_p_75_value,float,No,No,No,No,The 75th percentile +case_series_covariates_continuous,after_p_90_value,float,No,No,No,No,The 90th percentile +target_counts,characterization_target_id,bigint,Yes,Yes,No,No,The characterization cohort definition id +target_counts,n_events,bigint,No,No,No,No,The number of events +target_counts,n_people,bigint,No,No,No,No,The number of people +target_counts,database_id,varchar(100),Yes,Yes,No,No,The database identifier +target_counts,setting_id,varchar(50),Yes,Yes,No,No,The run identifier +case_counts,characterization_case_id,bigint,Yes,Yes,No,No,The characterization case id +case_counts,cohort_type,varchar(50),No,Yes,No,No,Whether the count is a case or non-case +case_counts,n_events,bigint,No,No,No,No,The number of events +case_counts,n_people,bigint,No,No,No,No,The number of people +case_counts,database_id,varchar(100),Yes,Yes,No,No,The database identifier +case_counts,setting_id,varchar(50),Yes,Yes,No,No,The run identifier +target_attrition,characterization_target_id,bigint,Yes,Yes,No,No,The characterization cohort id +target_attrition,attr_order,int,No,Yes,No,No,The attrition order +target_attrition,attr_reason,varchar(100),No,No,No,No,Description of removal rule +target_attrition,n_events,bigint,No,No,No,No,The number of events remaining +target_attrition,n_people,bigint,No,No,No,No,The number of people remaining +target_attrition,database_id,varchar(100),Yes,Yes,No,No,The database identifier +target_attrition,setting_id,varchar(50),Yes,Yes,No,No,The run identifier +case_attrition,characterization_case_id,bigint,Yes,Yes,No,No,The characterization case id +case_attrition,attr_order,int,No,Yes,No,No,The attrition order +case_attrition,attr_reason,varchar(100),No,No,No,No,Description of removal rule +case_attrition,n_events,bigint,No,No,No,No,The number of events remaining +case_attrition,n_people,bigint,No,No,No,No,The number of people remaining +case_attrition,database_id,varchar(100),Yes,Yes,No,No,The database identifier +case_attrition,setting_id,varchar(50),Yes,Yes,No,No,The run identifier +time_to_event_settings,setting_id,varchar(50),Yes,Yes,No,No,The run identifier +time_to_event_settings,database_id,varchar(100),Yes,Yes,No,No,The database identifier +time_to_event_settings,characterization_target_id,bigint,Yes,Yes,No,No,The characterization cohort id +time_to_event_settings,outcome_id,bigint,Yes,Yes,No,No,The outcome cohort id +dechallenge_rechallenge_settings,setting_id,varchar(50),Yes,Yes,No,No,The run identifier +dechallenge_rechallenge_settings,database_id,varchar(100),Yes,Yes,No,No,The database identifier +dechallenge_rechallenge_settings,characterization_target_id,bigint,Yes,Yes,No,No,The characterization cohort id +dechallenge_rechallenge_settings,outcome_id,bigint,Yes,Yes,No,No,The outcome cohort id diff --git a/inst/shinyConfigUpdate.json b/inst/shinyConfigUpdate.json index 13e18d9..e643455 100644 --- a/inst/shinyConfigUpdate.json +++ b/inst/shinyConfigUpdate.json @@ -5,6 +5,9 @@ "tabName": "About", "tabText": "About", "shinyModulePackage": "OhdsiShinyModules", + "shinyModulePackageVersion": "3.6.0", + "installSource": "github", + "gitHubRepo": "ohdsi", "uiFunction": "aboutViewer", "serverFunction": "aboutServer", "infoBoxFile": "aboutHelperFile()", @@ -16,6 +19,9 @@ "tabName": "Characterization", "tabText": "Characterization", "shinyModulePackage": "OhdsiShinyModules", + "shinyModulePackageVersion": "3.6.0", + "installSource": "github", + "gitHubRepo": "ohdsi", "uiFunction": "characterizationViewer", "serverFunction": "characterizationServer", "infoBoxFile": "characterizationHelperFile()", diff --git a/inst/sql/sql_server/CaseCohorts.sql b/inst/sql/sql_server/CaseCohorts.sql index b78742f..f66261e 100644 --- a/inst/sql/sql_server/CaseCohorts.sql +++ b/inst/sql/sql_server/CaseCohorts.sql @@ -6,7 +6,7 @@ IF OBJECT_ID('tempdb..#characterization_cases', 'U') IS NOT NULL DROP TABLE #cha SELECT case_settings.characterization_case_id as cohort_definition_id, -t.row_number, +t.row_id, t.subject_id, t.cohort_start_date, t.cohort_end_date, @@ -23,7 +23,9 @@ FROM @characterization_schema.@characterization_table t INNER JOIN ( SELECT *, - ISNULL(datediff(day, LAG(cohort_end_date) OVER(partition BY subject_id, cohort_definition_id ORDER BY cohort_start_date ASC), cohort_start_date ), (@outcome_washout+1)) outcome_washout_time + -- NOTE this does not consider observation period + -- and no outcome erification if done currently + ISNULL(DATEDIFF(day, MAX(cohort_end_date) OVER (PARTITION BY subject_id, cohort_definition_id ORDER BY cohort_start_date ASC ROWS BETWEEN UNBOUNDED PRECEDING AND 1 PRECEDING), cohort_start_date), (@outcome_washout+1)) AS outcome_washout_time FROM @cohort_schema.@cohort_table WHERE cohort_definition_id IN (@outcome_cohort_ids) ) o @@ -46,13 +48,13 @@ AND o.cohort_start_date >= t.observation_period_start_date AND o.cohort_start_date <= t.observation_period_end_date -- outcome starts before TAR end AND o.cohort_start_date <= dateadd(day, @risk_window_end, t.@end_anchor_date) --- outcome starts (ends?) after TAR start +-- outcome starts after TAR start AND o.cohort_start_date >= dateadd(day, @risk_window_start, t.@start_anchor_date) -- make sure to only get first outcome date during TAR GROUP BY case_settings.characterization_case_id, -t.row_number, +t.row_id, t.subject_id, t.cohort_start_date, t.cohort_end_date, @@ -69,11 +71,11 @@ WHERE char_type = 'cases' AND cohort_definition_id in (SELECT DISTINCT cohort_definition_id*10+1 FROM #characterization_cases); INSERT INTO @characterization_schema.@characterization_table( -cohort_definition_id, row_number, subject_id, cohort_start_date, cohort_end_date, char_type +cohort_definition_id, row_id, subject_id, cohort_start_date, cohort_end_date, char_type ) SELECT -cohort_definition_id*10+1, -row_number, +CAST(cohort_definition_id*10+1 as BIGINT), +row_id, subject_id, cohort_start_date, cohort_end_date, @@ -95,11 +97,11 @@ SELECT cohort_definition_id*10+5 FROM #characterization_cases INSERT INTO @characterization_schema.@characterization_table( -cohort_definition_id, row_number, subject_id, cohort_start_date, cohort_end_date, char_type +cohort_definition_id, row_id, subject_id, cohort_start_date, cohort_end_date, char_type ) SELECT -cohort_definition_id*10+3, -row_number, +CAST(cohort_definition_id*10+3 as BIGINT), +row_id, subject_id, DATEADD(day, -@case_series_before, cohort_start_date), DATEADD(day, 0, cohort_start_date), @@ -110,8 +112,8 @@ FROM #characterization_cases UNION SELECT -cohort_definition_id*10+4, -row_number, +CAST(cohort_definition_id*10+4 as BIGINT), +row_id, subject_id, DATEADD(day, 1, cohort_start_date), DATEADD(day, 0, outcome_start_date), @@ -121,8 +123,8 @@ FROM #characterization_cases UNION SELECT -cohort_definition_id*10+5, -row_number, +CAST(cohort_definition_id*10+5 as BIGINT), +row_id, subject_id, DATEADD(day, 1, outcome_start_date), DATEADD(day, @case_series_after, outcome_end_date), @@ -131,17 +133,25 @@ FROM #characterization_cases; } --- add to attrition table using risk factor id -INSERT INTO @characterization_schema.@attrition_table +-- add case count table +DELETE FROM @characterization_schema.@case_count_table +WHERE cohort_type = 'Cases' +AND characterization_case_id in +(SELECT DISTINCT cohort_definition_id FROM #characterization_cases); + +INSERT INTO @characterization_schema.@case_count_table( +characterization_case_id, cohort_type, n_events, n_people +) SELECT -cohort_definition_id*10+1, -'Cases' as attr_reason, -count(*) as n +CAST(cohort_definition_id as BIGINT), +'Cases', +count(*), +count(distinct subject_id) FROM #characterization_cases GROUP BY -cohort_definition_id +CAST(cohort_definition_id as BIGINT) ; -- clean up diff --git a/inst/sql/sql_server/CaseSeriesBinaryExtraction.sql b/inst/sql/sql_server/CaseSeriesBinaryExtraction.sql index a70b356..357b11b 100644 --- a/inst/sql/sql_server/CaseSeriesBinaryExtraction.sql +++ b/inst/sql/sql_server/CaseSeriesBinaryExtraction.sql @@ -52,5 +52,11 @@ covariate_id ) main_table WHERE (before_sum_value + during_sum_value + after_sum_value) >= @min_count +AND (ISNULL(before_average_value, 0) >= @min_characterization_mean + OR + ISNULL(during_average_value, 0) >= @min_characterization_mean + OR + ISNULL(after_average_value, 0) >= @min_characterization_mean + ) ; diff --git a/inst/sql/sql_server/CreateTargetCohortTable.sql b/inst/sql/sql_server/CreateTargetCohortTable.sql index 2b7f33f..57f45b8 100644 --- a/inst/sql/sql_server/CreateTargetCohortTable.sql +++ b/inst/sql/sql_server/CreateTargetCohortTable.sql @@ -2,7 +2,7 @@ DROP TABLE IF EXISTS @characterization_schema.@characterization_table; CREATE TABLE @characterization_schema.@characterization_table( cohort_definition_id BIGINT, -row_number BIGINT, +row_id BIGINT, subject_id BIGINT, cohort_start_date DATE, cohort_end_date DATE, @@ -11,9 +11,46 @@ observation_period_end_date DATE, char_type VARCHAR(20) ); -DROP TABLE IF EXISTS @characterization_schema.@attrition_table; -CREATE TABLE @characterization_schema.@attrition_table( +DROP TABLE IF EXISTS @characterization_schema.@target_attrition_table; +CREATE TABLE @characterization_schema.@target_attrition_table( +characterization_target_id BIGINT, +attr_order INT, +attr_reason VARCHAR(200), +n_events BIGINT, +n_people BIGINT +); + +DROP TABLE IF EXISTS @characterization_schema.@case_attrition_table; +CREATE TABLE @characterization_schema.@case_attrition_table( +characterization_case_id BIGINT, +attr_order INT, +attr_reason VARCHAR(200), +n_events BIGINT, +n_people BIGINT +); + +-- count tables +DROP TABLE IF EXISTS @characterization_schema.@target_count_table; +CREATE TABLE @characterization_schema.@target_count_table( +characterization_target_id BIGINT, +n_events BIGINT, +n_people BIGINT +); + +DROP TABLE IF EXISTS @characterization_schema.@case_count_table; +CREATE TABLE @characterization_schema.@case_count_table( +characterization_case_id BIGINT, +cohort_type VARCHAR(10), +n_events BIGINT, +n_people BIGINT +); + +-- outcome era table +DROP TABLE IF EXISTS @characterization_schema.@outcome_era_table; +CREATE TABLE @characterization_schema.@outcome_era_table( cohort_definition_id BIGINT, -attr_reason VARCHAR(50), -n BIGINT +outcome_washout BIGINT, +subject_id BIGINT, +cohort_start_date DATE, +cohort_end_date DATE ); diff --git a/inst/sql/sql_server/DechallengeRechallenge.sql b/inst/sql/sql_server/DechallengeRechallenge.sql index 8e7f2b7..0f9e106 100644 --- a/inst/sql/sql_server/DechallengeRechallenge.sql +++ b/inst/sql/sql_server/DechallengeRechallenge.sql @@ -1,7 +1,7 @@ IF OBJECT_ID('tempdb..#target_cohort', 'U') IS NOT NULL DROP TABLE #target_cohort; select * into #target_cohort -from @target_database_schema.@target_table -where cohort_definition_id in (@target_ids) +from @characterization_database_schema.@characterization_table +where cohort_definition_id in (@characterization_target_ids) ; IF OBJECT_ID('tempdb..#outcome_cohort', 'U') IS NOT NULL DROP TABLE #outcome_cohort; @@ -15,7 +15,7 @@ select '@database_id' as database_id, @dechallenge_stop_interval as dechallenge_stop_interval, @dechallenge_evaluation_window as dechallenge_evaluation_window, -target_cohort_definition_id, +target_cohort_definition_id as characterization_target_id, -- renamed outcome_cohort_definition_id, num_exposure_eras, num_persons_exposed, diff --git a/inst/sql/sql_server/DropTargetCohortTable.sql b/inst/sql/sql_server/DropTargetCohortTable.sql index 1797b99..03cfd15 100644 --- a/inst/sql/sql_server/DropTargetCohortTable.sql +++ b/inst/sql/sql_server/DropTargetCohortTable.sql @@ -1,5 +1,29 @@ +{DEFAULT @drop_char_cohorts = true} +{DEFAULT @drop_char_counts = true} +{DEFAULT @drop_char_attr = true} +{DEFAULT @drop_char_settings = true} +{DEFAULT @drop_outcome_era = true} + + +{@drop_char_cohorts}?{ DROP TABLE IF EXISTS @characterization_schema.@characterization_table; -DROP TABLE IF EXISTS @characterization_schema.@attrition_table; +} + +{@drop_char_counts}?{ +DROP TABLE IF EXISTS @characterization_schema.@target_count_table; +DROP TABLE IF EXISTS @characterization_schema.@case_count_table; +} + +{@drop_char_attr}?{ +DROP TABLE IF EXISTS @characterization_schema.@target_attrition_table; +DROP TABLE IF EXISTS @characterization_schema.@case_attrition_table; +} + +{@drop_char_settings}?{ DROP TABLE IF EXISTS @characterization_schema.@target_settings_table; DROP TABLE IF EXISTS @characterization_schema.@case_settings_table; +} +{@drop_outcome_era}?{ +DROP TABLE IF EXISTS @characterization_schema.@outcome_era_table; +} diff --git a/inst/sql/sql_server/DropTimeToEvent.sql b/inst/sql/sql_server/DropTimeToEvent.sql index 2a2df0c..afae8b8 100644 --- a/inst/sql/sql_server/DropTimeToEvent.sql +++ b/inst/sql/sql_server/DropTimeToEvent.sql @@ -15,12 +15,6 @@ DROP TABLE #target_w_outcome; TRUNCATE TABLE #two_fu_bounds; DROP TABLE #two_fu_bounds; -TRUNCATE TABLE #t_prior_obs; -DROP TABLE #t_prior_obs; - -TRUNCATE TABLE #t_post_obs; -DROP TABLE #t_post_obs; - TRUNCATE TABLE #two_tte; DROP TABLE #two_tte; diff --git a/inst/sql/sql_server/NonCaseCohorts.sql b/inst/sql/sql_server/NonCaseCohorts.sql index b26721a..fdb129c 100644 --- a/inst/sql/sql_server/NonCaseCohorts.sql +++ b/inst/sql/sql_server/NonCaseCohorts.sql @@ -1,9 +1,12 @@ -- clean this table at the end IF OBJECT_ID('tempdb..#temp_non_cases', 'U') IS NOT NULL DROP TABLE #temp_non_cases; +IF OBJECT_ID('tempdb..#temp_non_cases_with_tar', 'U') IS NOT NULL DROP TABLE #temp_non_cases_with_tar; +IF OBJECT_ID('tempdb..#temp_non_cases_pass_washout', 'U') IS NOT NULL DROP TABLE #temp_non_cases_pass_washout; + SELECT case_settings.characterization_case_id*10+2 as cohort_definition_id, - t.row_number, + t.row_id, t.subject_id, t.cohort_start_date, t.cohort_end_date, @@ -18,11 +21,12 @@ SELECT MAX(CASE WHEN o.cohort_start_date IS NOT NULL AND o.cohort_start_date < dateadd(day, @risk_window_start, t.@start_anchor_date) - AND o.cohort_end_date > dateadd(day, -@outcome_washout, dateadd(day, @risk_window_start, t.@start_anchor_date)) + -- Note: should this be >= or > ?? + AND o.cohort_end_date >= dateadd(day, -@outcome_washout, dateadd(day, @risk_window_start, t.@start_anchor_date)) THEN 1 else 0 END) AS outcome_in_washout_before_tar, -- ADD has outcome in TAR (left join CASES on characterization_target_id, row_id and ) - MAX(CASE WHEN cases.row_number IS NOT NULL THEN 1 else 0 END) AS outcome_during_tar + MAX(CASE WHEN cases.row_id IS NOT NULL THEN 1 else 0 END) AS outcome_during_tar INTO #temp_non_cases FROM @characterization_schema.@characterization_table t @@ -37,21 +41,24 @@ SELECT ) case_settings ON t.cohort_definition_id = case_settings.characterization_target_id - LEFT JOIN @cohort_schema.@cohort_table o + -- EDITED to collapse using outcome washout + LEFT JOIN @characterization_schema.@outcome_era_table o + --LEFT JOIN @cohort_schema.@cohort_table o + ON t.subject_id = o.subject_id AND case_settings.outcome_id = o.cohort_definition_id - AND o.cohort_start_date >= t.observation_period_start_date - AND o.cohort_start_date <= t.observation_period_end_date + AND o.outcome_washout = @outcome_washout + -- outcome starts before TAR start - AND o.cohort_start_date <= dateadd(day, @risk_window_start, t.@start_anchor_date) + AND o.cohort_start_date < dateadd(day, @risk_window_start, t.@start_anchor_date) -- outcome end after washout prior before TAR start AND o.cohort_end_date >= dateadd(day, -@outcome_washout, dateadd(day, @risk_window_start, t.@start_anchor_date)) - -- use real table not temp case table? + -- join to cases LEFT JOIN (SELECT * from @characterization_schema.@characterization_table WHERE char_type = 'cases' ) cases ON cases.cohort_definition_id = case_settings.characterization_case_id*10+1 - AND cases.row_number = t.row_number + AND cases.row_id = t.row_id WHERE case_settings.outcome_id IN (@outcome_cohort_ids) AND case_settings.characterization_target_id IN (@characterization_target_ids) @@ -59,7 +66,7 @@ SELECT GROUP BY case_settings.characterization_case_id, - t.row_number, + t.row_id, t.subject_id, t.cohort_start_date, t.cohort_end_date; @@ -72,12 +79,12 @@ AND cohort_definition_id in (SELECT DISTINCT cohort_definition_id FROM #temp_non -- now determine the non-cases INSERT INTO @characterization_schema.@characterization_table( - cohort_definition_id, row_number, subject_id, cohort_start_date, cohort_end_date, char_type + cohort_definition_id, row_id, subject_id, cohort_start_date, cohort_end_date, char_type ) SELECT temp.cohort_definition_id, - temp.row_number, + temp.row_id, temp.subject_id, temp.cohort_start_date, temp.cohort_end_date, @@ -103,45 +110,145 @@ AND cohort_definition_id in (SELECT DISTINCT cohort_definition_id FROM #temp_non ; +-- add counts +-- add case count table +DELETE FROM @characterization_schema.@case_count_table +WHERE cohort_type = 'non-cases' +AND characterization_case_id in +(SELECT DISTINCT CAST((cohort_definition_id-2.0)/10.0 as BIGINT) FROM #temp_non_cases); -INSERT INTO @characterization_schema.@attrition_table - +INSERT INTO @characterization_schema.@case_count_table( +characterization_case_id, cohort_type, n_events, n_people +) SELECT -cohort_definition_id, -attr_reason, -count(*) as n +CAST((cohort_definition_id-2.0)/10.0 as BIGINT), +'non-cases', +count(*), +count(distinct subject_id) -FROM +FROM #temp_non_cases temp -(SELECT - temp.cohort_definition_id, - temp.row_number, +-- not a case +WHERE temp.outcome_during_tar = 0 + + {@use_plp}?{ -- exclude anyone with with outcome during washout before TAR or no TAR + AND temp.outcome_in_washout_before_tar = 0 + AND temp.no_tar_ignoring_outcome_washout = 0 + AND temp.no_tar_obs = 0 + } + {@use_ci}?{ -- exclude anyone without 1+ days of TAR + AND temp.no_tar_ignoring_outcome_washout = 0 + AND temp.no_tar_because_outcome_washout = 0 + AND temp.no_tar_washout_and_obs = 0 + AND temp.no_tar_obs = 0 + } + +GROUP BY +cohort_definition_id +; + + + + +-- add the reasons for lost people due to tar/washout +SELECT * +INTO #temp_non_cases_with_tar +FROM #temp_non_cases temp {@use_plp}?{ -CASE -WHEN temp.no_tar_ignoring_outcome_washout = 1 OR temp.no_tar_obs = 1 THEN '1. No TAR due to TAR start > TAR end or observation end' -WHEN temp.outcome_in_washout_before_tar = 1 THEN '2. Outcome occurs during washout' -WHEN temp.outcome_during_tar = 1 THEN '3. Has outcome during TAR' -END attr_reason +WHERE temp.no_tar_ignoring_outcome_washout = 0 AND temp.no_tar_obs = 0 } {@use_ci}?{ -CASE -WHEN temp.no_tar_ignoring_outcome_washout = 1 OR temp.no_tar_obs = 1 THEN '1. No TAR due to TAR start > TAR end or observation end' -WHEN temp.no_tar_because_outcome_washout = 1 OR temp.no_tar_washout_and_obs = 1 THEN '2. No TAR due to outcome washout' -WHEN temp.outcome_during_tar = 1 THEN '3. Has outcome during TAR' -END attr_reason +WHERE temp.no_tar_ignoring_outcome_washout = 0 AND temp.no_tar_obs = 0 } +; -FROM #temp_non_cases temp -) attrition +SELECT * +INTO #temp_non_cases_pass_washout +FROM #temp_non_cases_with_tar temp -WHERE attr_reason IS NOT NULL +{@use_plp}?{ +WHERE temp.outcome_in_washout_before_tar = 0 +} +{@use_ci}?{ +WHERE temp.no_tar_because_outcome_washout = 0 AND temp.no_tar_washout_and_obs = 0 +} +; + + +-- next +DELETE FROM @characterization_schema.@case_attrition_table +WHERE characterization_case_id in +(SELECT DISTINCT CAST((cohort_definition_id-2.0)/10.0 AS BIGINT) FROM #temp_non_cases); + + +INSERT INTO @characterization_schema.@case_attrition_table( +characterization_case_id, attr_order, attr_reason, +n_events, n_people +) + +SELECT * FROM +( +SELECT +CAST((cohort_definition_id - 2.0)/10.0 AS BIGINT) as characterization_case_id, +8 as attr_order, +'Has some TAR' as attr_reason, +count(*) as n_events, +count(distinct subject_id) as n_people + +FROM #temp_non_cases_with_tar +GROUP BY cohort_definition_id +) temp + +-- add 0s +UNION +SELECT +CAST((cohort_definition_id - 2.0)/10.0 AS BIGINT), +8, +'Has some TAR', +0, +0 +FROM #temp_non_cases +WHERE cohort_definition_id NOT IN +(SELECT distinct cohort_definition_id FROM #temp_non_cases_with_tar) -GROUP BY -cohort_definition_id, -attr_reason ; +INSERT INTO @characterization_schema.@case_attrition_table( +characterization_case_id, attr_order, attr_reason, +n_events, n_people +) + +SELECT * FROM +( +SELECT +CAST((cohort_definition_id - 2.0)/10.0 AS BIGINT) as characterization_case_id, +9 as attr_order, +'Remains after outcome washout' as attr_reason, +count(*) as n_events, +count(distinct subject_id) as n_people + +FROM #temp_non_cases_pass_washout +GROUP BY cohort_definition_id +) temp + +UNION + +SELECT +CAST((cohort_definition_id - 2.0)/10.0 AS BIGINT), +9, +'Remains after outcome washout', +0, +0 +FROM #temp_non_cases_with_tar +WHERE cohort_definition_id NOT IN +(SELECT distinct cohort_definition_id FROM #temp_non_cases_pass_washout) +; + + + -- cleaning table IF OBJECT_ID('tempdb..#temp_non_cases', 'U') IS NOT NULL DROP TABLE #temp_non_cases; +IF OBJECT_ID('tempdb..#temp_non_cases_with_tar', 'U') IS NOT NULL DROP TABLE #temp_non_cases_with_tar; +IF OBJECT_ID('tempdb..#temp_non_cases_pass_washout', 'U') IS NOT NULL DROP TABLE #temp_non_cases_pass_washout; diff --git a/inst/sql/sql_server/OutcomeEras.sql b/inst/sql/sql_server/OutcomeEras.sql new file mode 100644 index 0000000..028031e --- /dev/null +++ b/inst/sql/sql_server/OutcomeEras.sql @@ -0,0 +1,58 @@ +-- remove existing results +DELETE FROM @characterization_schema.@outcome_era_table +WHERE cohort_definition_id in (@outcome_ids) +AND outcome_washout = @outcome_washout +; + +-- now determine the non-cases + INSERT INTO @characterization_schema.@outcome_era_table( + cohort_definition_id, outcome_washout, subject_id, cohort_start_date, cohort_end_date + ) + +SELECT + cohort_definition_id, + @outcome_washout as outcome_washout, + subject_id, + MIN(cohort_start_date) AS cohort_start_date, + MAX(cohort_end_date) AS cohort_end_date + +FROM ( + + SELECT + cohort_definition_id, + subject_id, + cohort_start_date, + cohort_end_date, + + SUM( + CASE WHEN previous_cohort_end_date >= cohort_start_date THEN 0 + ELSE 1 + END) + OVER ( + PARTITION BY cohort_definition_id, subject_id + ORDER BY cohort_start_date + ROWS BETWEEN UNBOUNDED PRECEDING AND CURRENT ROW + ) AS era_count + + FROM ( + SELECT + cohort_definition_id, + subject_id, + cohort_start_date, + cohort_end_date, + MAX(DATEADD(day, @outcome_washout, cohort_end_date)) OVER ( + PARTITION BY cohort_definition_id, subject_id + ORDER BY cohort_start_date ASC + ROWS BETWEEN UNBOUNDED PRECEDING AND 1 PRECEDING + ) AS previous_cohort_end_date + FROM @cohort_schema.@cohort_table + + WHERE cohort_definition_id IN (@outcome_ids) + ) prior_eras + +) temp + +GROUP BY +cohort_definition_id, +subject_id, +era_count; diff --git a/inst/sql/sql_server/RechallengeFailCaseSeries.sql b/inst/sql/sql_server/RechallengeFailCaseSeries.sql index 02f7b03..75ac3bc 100644 --- a/inst/sql/sql_server/RechallengeFailCaseSeries.sql +++ b/inst/sql/sql_server/RechallengeFailCaseSeries.sql @@ -1,8 +1,27 @@ +-- here we join the original target table to the subset target table via +-- the target_settings table to class each era as included in the subset or not +-- this ensures to target era id in the final results accounts for all exposures +-- not just those that occur in the subset but we know which exposures occured in +-- the subset (included = 1) IF OBJECT_ID('tempdb..#target_cohort', 'U') IS NOT NULL DROP TABLE #target_cohort; -select * into #target_cohort -from @target_database_schema.@target_table -where cohort_definition_id in (@target_ids) + +SELECT +ts.characterization_target_id as cohort_definition_id, +tc.subject_id, +tc.cohort_start_date, +tc.cohort_end_date, +CASE WHEN sc.subject_id is NULL THEN 0 ELSE 1 END included +INTO #target_cohort +FROM @target_database_schema.@target_table tc +INNER JOIN @characterization_database_schema.@target_settings ts +ON tc.cohort_definition_id = ts.target_id +LEFT JOIN @characterization_database_schema.@characterization_table sc +ON sc.subject_id = tc.subject_id +AND sc.cohort_start_date = tc.cohort_start_date +AND sc.cohort_definition_id = ts.characterization_target_id +WHERE sc.cohort_definition_id in (@characterization_target_ids) ; + IF OBJECT_ID('tempdb..#outcome_cohort', 'U') IS NOT NULL DROP TABLE #outcome_cohort; select * into #outcome_cohort from @outcome_database_schema.@outcome_table @@ -16,7 +35,8 @@ select '@database_id' as database_id, @dechallenge_stop_interval as dechallenge_stop_interval, @dechallenge_evaluation_window as dechallenge_evaluation_window, - dc1.cohort_definition_id as target_cohort_definition_id, + dc1.cohort_definition_id as characterization_target_id, -- renamed this + dc1.included, -- new: whether the target era is in the target eras subset of interest io1.cohort_definition_id as outcome_cohort_definition_id, dense_rank() over (partition by dc1.cohort_definition_id, io1.cohort_definition_id order by datediff(day, dc0.cohort_start_date, dc1.cohort_start_date), dc1.subject_id) as person_key, {@show_subject_id}?{dc1.subject_id}:{CAST(NULL AS BIGINT) as subject_id}, --this is the field that we would want to allow parameter to make nullable or not export @@ -33,29 +53,53 @@ select into #fail_case_series -from (select *, row_number() over (partition by cohort_definition_id, subject_id order by cohort_start_date) as era_number from #target_cohort) dc0 +from + (select *, + cohort_start_date as dc0_start_date, + cohort_end_date as dc0_end_date, + row_number() over (partition by cohort_definition_id, subject_id order by cohort_start_date) as era_number from #target_cohort + ) dc0 inner join - (select *, row_number() over (partition by cohort_definition_id, subject_id order by cohort_start_date) as era_number from #target_cohort) dc1 + (select *, + cohort_start_date as dc1_start_date, + cohort_end_date as dc1_end_date, + row_number() over (partition by cohort_definition_id, subject_id order by cohort_start_date) as era_number from #target_cohort + ) dc1 on dc0.subject_id = dc1.subject_id and dc0.cohort_definition_id = dc1.cohort_definition_id and dc0.era_number = 1 - inner join (select *, row_number() over (partition by cohort_definition_id, subject_id order by cohort_start_date) as era_number from #outcome_cohort) io1 + inner join + (select *, + cohort_start_date as io1_start_date, + cohort_end_date as io1_end_date, + row_number() over (partition by cohort_definition_id, subject_id order by cohort_start_date) as era_number from #outcome_cohort + ) io1 on dc1.subject_id = io1.subject_id - and io1.cohort_start_date > dc1.cohort_start_date and io1.cohort_start_date <= dc1.cohort_end_date - and dc1.cohort_end_date <= dateadd(day,@dechallenge_stop_interval,io1.cohort_start_date) -- exposure ends shortly after outcome starts + and io1.io1_start_date > dc1.dc1_start_date and io1.io1_start_date <= dc1.dc1_end_date + and dc1.dc1_end_date <= dateadd(day,@dechallenge_stop_interval,io1.io1_start_date) -- exposure ends shortly after outcome starts left join #outcome_cohort ro0 -- used to exclude people who have the outcome between exposure or next eligible time on dc1.subject_id = ro0.subject_id and io1.cohort_definition_id = ro0.cohort_definition_id - and ro0.cohort_start_date > dc1.cohort_end_date - and ro0.cohort_start_date <= dateadd(day,@dechallenge_evaluation_window,dc1.cohort_end_date) --this should be parameterized to be the dechallenge window required for success/failure - inner join (select *, row_number() over (partition by cohort_definition_id, subject_id order by cohort_start_date) as era_number from #target_cohort) de1 + and ro0.cohort_start_date > dc1.dc1_end_date + and ro0.cohort_start_date <= dateadd(day,@dechallenge_evaluation_window,dc1.dc1_end_date) --this should be parameterized to be the dechallenge window required for success/failure + inner join + (select *, + cohort_start_date as de1_start_date, + cohort_end_date as de1_end_date, + row_number() over (partition by cohort_definition_id, subject_id order by cohort_start_date) as era_number from #target_cohort + ) de1 on dc1.subject_id = de1.subject_id and dc1.cohort_definition_id = de1.cohort_definition_id - and de1.cohort_start_date > dateadd(day,@dechallenge_evaluation_window,dc1.cohort_end_date) --using same dechallenge window to detrmine when rechallenge attempt can start - inner join (select *, row_number() over (partition by cohort_definition_id, subject_id order by cohort_start_date) as era_number from #outcome_cohort) ro1 + and de1.de1_start_date > dateadd(day,@dechallenge_evaluation_window,dc1.dc1_end_date) --using same dechallenge window to detrmine when rechallenge attempt can start + inner join + (select *, + cohort_start_date as ro1_start_date, + cohort_end_date as ro1_end_date, + row_number() over (partition by cohort_definition_id, subject_id order by cohort_start_date) as era_number from #outcome_cohort + ) ro1 on de1.subject_id = ro1.subject_id and io1.cohort_definition_id = ro1.cohort_definition_id - and ro1.cohort_start_date > de1.cohort_start_date - and ro1.cohort_start_date <= de1.cohort_end_date + and ro1.ro1_start_date > de1.de1_start_date + and ro1.ro1_start_date <= de1.de1_end_date where ro0.subject_id is null ; diff --git a/inst/sql/sql_server/ResultTables.sql b/inst/sql/sql_server/ResultTables.sql index 79a13c2..47190ad 100644 --- a/inst/sql/sql_server/ResultTables.sql +++ b/inst/sql/sql_server/ResultTables.sql @@ -219,6 +219,8 @@ CREATE TABLE @my_schema.@table_prefixexecution_settings ( min_characterization_mean FLOAT, min_covariate_count INT, min_smd FLOAT, + min_target_size BIGINT, + min_case_size BIGINT, PRIMARY KEY (setting_id, database_id) ); @@ -243,7 +245,7 @@ CREATE TABLE @my_schema.@table_prefixcase_settings ( end_anchor VARCHAR(15), risk_window_start INT, risk_window_end INT, - runtype VARCHAR(50), + runtype VARCHAR(50), -- need to add migration to add risk_factor_settings and case_series_settings PRIMARY KEY (setting_id, database_id,characterization_case_id) ); @@ -253,13 +255,3 @@ CREATE TABLE @my_schema.@table_prefixcase_series_settings ( case_post_outcome_duration int, PRIMARY KEY (setting_id) ); - --- added this table -CREATE TABLE @my_schema.@table_prefixattrition ( - database_id varchar(100) NOT NULL, - setting_id varchar(50) NOT NULL, - cohort_definition_id BIGINT, - attr_reason VARCHAR(200), - n BIGINT, - PRIMARY KEY (setting_id, database_id, cohort_definition_id, attr_reason) -); diff --git a/inst/sql/sql_server/RiskFactorBinaryExtraction.sql b/inst/sql/sql_server/RiskFactorBinaryExtraction.sql index 44dac83..1b4b98c 100644 --- a/inst/sql/sql_server/RiskFactorBinaryExtraction.sql +++ b/inst/sql/sql_server/RiskFactorBinaryExtraction.sql @@ -27,32 +27,40 @@ SELECT case_id FROM cohort_of_int GROUP BY cohort_definition_id ) -SELECT * +SELECT +characterization_case_id, +covariate_id, +non_case_sum_value, +case_sum_value, +non_case_average_value, +case_average_value, +CASE WHEN st_dev = 0 THEN mean_diff ELSE mean_diff/st_dev END as standardized_mean_difference + FROM ( SELECT -IFNULL(non_cases.characterization_case_id, cases.characterization_case_id) as characterization_case_id, -IFNULL(non_cases.covariate_id, cases.covariate_id) as covariate_id, -IFNULL(non_case_sum_value, 0) as non_case_sum_value, -IFNULL(case_sum_value, 0) as case_sum_value, -IFNULL(non_case_average_value, 0) as non_case_average_value, -IFNULL(case_average_value, 0) as case_average_value, -(IFNULL(case_average_value, 0.0) - IFNULL(non_case_average_value, 0.0))/ +ISNULL(non_cases.characterization_case_id, cases.characterization_case_id) as characterization_case_id, +ISNULL(non_cases.covariate_id, cases.covariate_id) as covariate_id, +ISNULL(non_case_sum_value, 0) as non_case_sum_value, +ISNULL(case_sum_value, 0) as case_sum_value, +ISNULL(non_case_average_value, 0) as non_case_average_value, +ISNULL(case_average_value, 0) as case_average_value, +(ISNULL(case_average_value, 0.0) - ISNULL(non_case_average_value, 0.0))*1.0 as mean_diff, SQRT( ( ( - (POWER((1.0 - IFNULL(case_average_value, 0.0)),2) * IFNULL(case_sum_value*1.0, 0.0)) + - (POWER((0.0 - IFNULL(case_average_value, 0.0)),2) * (IFNULL(case_n*1.0, 0.0) - IFNULL(case_sum_value*1.0, 0.0))) - )/CASE WHEN IFNULL(case_n*1.0-1.0, 1.0) = 0 THEN 1.0 ELSE IFNULL(case_n*1.0-1.0, 1.0) END + (POWER((1.0 - ISNULL(case_average_value, 0.0)),2) * ISNULL(case_sum_value*1.0, 0.0)) + + (POWER((0.0 - ISNULL(case_average_value, 0.0)),2) * (ISNULL(case_n*1.0, 0.0) - ISNULL(case_sum_value*1.0, 0.0))) + )/CASE WHEN ISNULL(case_n*1.0-1.0, 1.0) = 0 THEN 1.0 ELSE ISNULL(case_n*1.0-1.0, 1.0) END + ( - (POWER((1.0 - IFNULL(non_case_average_value, 0.0)),2) * IFNULL(non_case_sum_value*1.0, 0.0)) + - (POWER((0.0 - IFNULL(non_case_average_value, 0.0)),2) * (IFNULL(non_case_n*1.0, 0.0) - IFNULL(non_case_sum_value*1.0, 0))) - )/CASE WHEN IFNULL(non_case_n*1.0-1.0, 1.0) = 0 THEN 1.0 ELSE IFNULL(non_case_n*1.0-1.0, 1.0) END + (POWER((1.0 - ISNULL(non_case_average_value, 0.0)),2) * ISNULL(non_case_sum_value*1.0, 0.0)) + + (POWER((0.0 - ISNULL(non_case_average_value, 0.0)),2) * (ISNULL(non_case_n*1.0, 0.0) - ISNULL(non_case_sum_value*1.0, 0))) + )/CASE WHEN ISNULL(non_case_n*1.0-1.0, 1.0) = 0 THEN 1.0 ELSE ISNULL(non_case_n*1.0-1.0, 1.0) END )/2.0 - ) as standardized_mean_difference + ) as st_dev FROM @@ -89,7 +97,10 @@ AND non_cases.covariate_id = cases.covariate_id ) smd_table -WHERE abs(smd_table.standardized_mean_difference) >= @smd_min -AND (IFNULL(non_case_sum_value, 0) + IFNULL(case_sum_value, 0) ) >= @min_count +WHERE abs(CASE WHEN st_dev = 0 THEN mean_diff ELSE mean_diff/st_dev END) >= @smd_min +AND (ISNULL(non_case_sum_value, 0) + ISNULL(case_sum_value, 0) ) >= @min_count +AND (ISNULL(non_case_average_value, 0) >= @min_characterization_mean + OR + ISNULL(case_average_value, 0) >= @min_characterization_mean ) ; diff --git a/inst/sql/sql_server/RiskFactorContinuousExtraction.sql b/inst/sql/sql_server/RiskFactorContinuousExtraction.sql index 6b453f1..bf44319 100644 --- a/inst/sql/sql_server/RiskFactorContinuousExtraction.sql +++ b/inst/sql/sql_server/RiskFactorContinuousExtraction.sql @@ -30,36 +30,61 @@ SELECT case_id FROM cohort_of_int GROUP BY cohort_definition_id ) -SELECT * +SELECT +characterization_case_id, +covariate_id, +non_case_count_value, +case_count_value, +non_case_min_value, +case_min_value, +non_case_max_value, +case_max_value, +non_case_average_value, +case_average_value, +non_case_median_value, +case_median_value, +non_case_p10_value, +case_p10_value, +non_case_p25_value, +case_p25_value, +non_case_p75_value, +case_p75_value, +non_case_p90_value, +case_p90_value, +non_case_standard_deviation, +case_standard_deviation, + +CASE WHEN st_dev = 0 THEN mean_diff ELSE mean_diff/st_dev END as standardized_mean_difference + FROM ( SELECT -IFNULL(non_cases.characterization_case_id, cases.characterization_case_id) as characterization_case_id, -IFNULL(non_cases.covariate_id, cases.covariate_id) as covariate_id, -IFNULL(non_case_count_value, 0) as non_case_count_value, -IFNULL(case_count_value, 0) as case_count_value, -IFNULL(non_case_min_value, 0) as non_case_min_value, -IFNULL(case_min_value, 0) as case_min_value, -IFNULL(non_case_max_value, 0) as non_case_max_value, -IFNULL(case_max_value, 0) as case_max_value, -IFNULL(non_case_average_value, 0) as non_case_average_value, -IFNULL(case_average_value, 0) as case_average_value, -IFNULL(non_case_median_value, 0) as non_case_median_value, -IFNULL(case_median_value, 0) as case_median_value, -IFNULL(non_case_p10_value, 0) as non_case_p10_value, -IFNULL(case_p10_value, 0) as case_p10_value, -IFNULL(non_case_p25_value, 0) as non_case_p25_value, -IFNULL(case_p25_value, 0) as case_p25_value, -IFNULL(non_case_p75_value, 0) as non_case_p75_value, -IFNULL(case_p75_value, 0) as case_p75_value, -IFNULL(non_case_p90_value, 0) as non_case_p90_value, -IFNULL(case_p90_value, 0) as case_p90_value, -IFNULL(non_case_standard_deviation, 0) as non_case_standard_deviation, -IFNULL(case_standard_deviation, 0) as case_standard_deviation, -(IFNULL(case_average_value, 0.0) - IFNULL(non_case_average_value, 0.0))/ +ISNULL(non_cases.characterization_case_id, cases.characterization_case_id) as characterization_case_id, +ISNULL(non_cases.covariate_id, cases.covariate_id) as covariate_id, +ISNULL(non_case_count_value, 0) as non_case_count_value, +ISNULL(case_count_value, 0) as case_count_value, +ISNULL(non_case_min_value, 0) as non_case_min_value, +ISNULL(case_min_value, 0) as case_min_value, +ISNULL(non_case_max_value, 0) as non_case_max_value, +ISNULL(case_max_value, 0) as case_max_value, +ISNULL(non_case_average_value, 0) as non_case_average_value, +ISNULL(case_average_value, 0) as case_average_value, +ISNULL(non_case_median_value, 0) as non_case_median_value, +ISNULL(case_median_value, 0) as case_median_value, +ISNULL(non_case_p10_value, 0) as non_case_p10_value, +ISNULL(case_p10_value, 0) as case_p10_value, +ISNULL(non_case_p25_value, 0) as non_case_p25_value, +ISNULL(case_p25_value, 0) as case_p25_value, +ISNULL(non_case_p75_value, 0) as non_case_p75_value, +ISNULL(case_p75_value, 0) as case_p75_value, +ISNULL(non_case_p90_value, 0) as non_case_p90_value, +ISNULL(case_p90_value, 0) as case_p90_value, +ISNULL(non_case_standard_deviation, 0) as non_case_standard_deviation, +ISNULL(case_standard_deviation, 0) as case_standard_deviation, +(ISNULL(case_average_value, 0.0) - ISNULL(non_case_average_value, 0.0))*1.0 as mean_diff, SQRT( -(POWER(IFNULL(case_standard_deviation, 0.0),2) + POWER(IFNULL(non_case_standard_deviation, 0.0),2)) -/2.0) as standardized_mean_difference +(POWER(ISNULL(case_standard_deviation, 0.0),2) + POWER(ISNULL(non_case_standard_deviation, 0.0),2)) +/2.0) as st_dev FROM @@ -112,6 +137,6 @@ AND non_cases.covariate_id = cases.covariate_id ) temp -WHERE abs(temp.standardized_mean_difference) >= @smd_min -AND (IFNULL(non_case_count_value, 0) + IFNULL(case_count_value, 0) ) >= @min_count +WHERE abs(CASE WHEN st_dev = 0 THEN mean_diff ELSE mean_diff/st_dev END) >= @smd_min +AND (ISNULL(non_case_count_value, 0) + ISNULL(case_count_value, 0) ) >= @min_count ; diff --git a/inst/sql/sql_server/TargetCohorts.sql b/inst/sql/sql_server/TargetCohorts.sql index e687122..a8f56d3 100644 --- a/inst/sql/sql_server/TargetCohorts.sql +++ b/inst/sql/sql_server/TargetCohorts.sql @@ -1,27 +1,35 @@ -- first entry in washout days and min prior obs IF OBJECT_ID('tempdb..#temp_target', 'U') IS NOT NULL DROP TABLE #temp_target; +IF OBJECT_ID('tempdb..#temp_target_first', 'U') IS NOT NULL DROP TABLE #temp_target_first; +IF OBJECT_ID('tempdb..#temp_target_prior', 'U') IS NOT NULL DROP TABLE #temp_target_prior; +IF OBJECT_ID('tempdb..#temp_target_nest', 'U') IS NOT NULL DROP TABLE #temp_target_nest; +IF OBJECT_ID('tempdb..#temp_target_age', 'U') IS NOT NULL DROP TABLE #temp_target_age; +IF OBJECT_ID('tempdb..#temp_target_gender', 'U') IS NOT NULL DROP TABLE #temp_target_gender; +IF OBJECT_ID('tempdb..#temp_target_date', 'U') IS NOT NULL DROP TABLE #temp_target_date; +-- ========================= SELECT CAST(target_settings.characterization_target_id AS BIGINT) AS cohort_definition_id, -row_number() over(PARTITION BY CAST(target_settings.characterization_target_id AS BIGINT) ORDER BY temp_cohort.subject_id, temp_cohort.cohort_start_date ASC) AS row_number, +row_number() over(PARTITION BY CAST(target_settings.characterization_target_id AS BIGINT) ORDER BY temp_cohort.subject_id, temp_cohort.cohort_start_date ASC) AS row_id, temp_cohort.subject_id, temp_cohort.cohort_start_date, temp_cohort.cohort_end_date, op.observation_period_start_date, op.observation_period_end_date, +temp_cohort.time_between, 'target' as char_type INTO #temp_target FROM (SELECT cohort_definition_id, - @limit_to_first_in_n_days AS limit_to_first_in_n_days, - @min_prior_observation AS min_prior_observation, subject_id, cohort_start_date, cohort_end_date, - ISNULL(datediff(day, LAG(cohort_end_date) OVER(partition BY subject_id, cohort_definition_id ORDER BY cohort_start_date ASC), cohort_start_date ), -1) AS time_between + -- edited this so it works even when cohort period are not ordered nicely + ISNULL(DATEDIFF(day, MAX(cohort_end_date) OVER (PARTITION BY subject_id, cohort_definition_id ORDER BY cohort_start_date ASC ROWS BETWEEN UNBOUNDED PRECEDING AND 1 PRECEDING), cohort_start_date), (@limit_to_first_in_n_days+1)) AS time_between + FROM @cohort_schema.@cohort_table WHERE cohort_definition_id IN (@cohort_ids) ) temp_cohort @@ -30,54 +38,369 @@ ON op.person_id = temp_cohort.subject_id AND temp_cohort.cohort_start_date >= op.observation_period_start_date AND temp_cohort.cohort_start_date <= op.observation_period_end_date +-- this is just to get the characterization_target_id INNER JOIN -(SELECT * FROM @target_settings_schema.@target_settings_table +(SELECT distinct * FROM @target_settings_schema.@target_settings_table WHERE limit_to_first_in_n_days = @limit_to_first_in_n_days AND min_prior_observation = @min_prior_observation + -- added: + AND min_age = @min_age + AND max_age = @max_age + AND study_start = '@study_start' + AND study_end = '@study_end' + AND gender_concept_ids = '@gender_concept_ids' + AND nesting_cohort_id = @nesting_cohort_id + + -- add target_ids? + --AND target_id IN (@cohort_ids) + ) target_settings -ON temp_cohort.cohort_definition_id = target_settings.target_id +ON temp_cohort.cohort_definition_id = target_settings.target_id; + + +-- now do first in n +SELECT * +INTO #temp_target_first +FROM #temp_target temp_cohort +WHERE (temp_cohort.time_between >= @limit_to_first_in_n_days); + +-- now min prior obs +SELECT * +INTO #temp_target_prior +FROM #temp_target_first +WHERE datediff(day, observation_period_start_date, cohort_start_date) >= @min_prior_observation; + +-- now nesting +{@nesting_cohort_id != 0}?{SELECT +t.cohort_definition_id, +t.row_id, +t.subject_id, +t.cohort_start_date, +-- use the nesting end date if it is before the target end date +CASE WHEN t.cohort_end_date <= n.cohort_end_date THEN t.cohort_end_date +ELSE n.cohort_end_date END cohort_end_date, +t.observation_period_start_date, +t.observation_period_end_date, +t.char_type +INTO #temp_target_nest +FROM #temp_target_prior t +INNER JOIN +(SELECT * from @nesting_schema.@nesting_table +WHERE cohort_definition_id = @nesting_cohort_id) n +ON n.subject_id = t.subject_id +-- cohort starts between nesting date +AND n.cohort_start_date <= t.cohort_start_date +AND n.cohort_end_date >= t.cohort_start_date; +}:{ +SELECT * +INTO #temp_target_nest +FROM #temp_target_prior t; +} + +-- now age at start +SELECT * +INTO #temp_target_age +FROM #temp_target_nest t +INNER JOIN @cdm_database_schema.person p +ON p.person_id = t.subject_id +WHERE YEAR(t.cohort_start_date) - p.year_of_birth >= @min_age +AND YEAR(t.cohort_start_date) - p.year_of_birth <= @max_age; + +-- now gender +{@gender_concept_ids != ''}?{ +SELECT * +INTO #temp_target_gender +FROM #temp_target_age t +INNER JOIN +@cdm_database_schema.person p +ON p.person_id = t.subject_id +WHERE p.gender_concept_id = '@gender_concept_ids'; +}:{ +SELECT * +INTO #temp_target_gender +FROM #temp_target_age; +} + +-- finally date: +{@study_start != '' | @study_end != ''}?{ +SELECT +cohort_definition_id, +row_id, +subject_id, +cohort_start_date, +-- edit the end date if after study end +{@study_end != ''}?{ +CASE WHEN CAST('@study_end' AS DATE) < cohort_end_date THEN CAST('@study_end' AS DATE) ELSE cohort_end_date END as cohort_end_date, +} : +{cohort_end_date,} +observation_period_start_date, +observation_period_end_date, +time_between, +char_type +INTO #temp_target_date +FROM #temp_target_gender +WHERE 1 = 1 +{@study_start != ''}?{AND cohort_start_date >= CAST('@study_start' AS DATE)} +{@study_end != ''}?{AND cohort_start_date <= CAST('@study_end' AS DATE)} +; +} : { +SELECT * +INTO #temp_target_date +FROM #temp_target_gender; +} +-- ========================= -WHERE (temp_cohort.time_between >= @limit_to_first_in_n_days OR temp_cohort.time_between = -1) -AND datediff(day, op.observation_period_start_date, temp_cohort.cohort_start_date) >= @min_prior_observation; + +-- ========================= +-- ADDING FINAL COHORT INTO TABLE -- remove existing rows with cohort ids DELETE FROM @characterization_schema.@characterization_table WHERE char_type = 'target' -AND cohort_definition_id in (SELECT DISTINCT cohort_definition_id FROM #temp_target) +AND cohort_definition_id in (SELECT DISTINCT cohort_definition_id FROM #temp_target_date) ; -- insert the new rows -- now determine the non-cases INSERT INTO @characterization_schema.@characterization_table( - cohort_definition_id, row_number, subject_id, cohort_start_date, cohort_end_date, + cohort_definition_id, row_id, subject_id, cohort_start_date, cohort_end_date, observation_period_start_date, observation_period_end_date, char_type ) SELECT temp.cohort_definition_id, - temp.row_number, + temp.row_id, temp.subject_id, temp.cohort_start_date, - temp.cohort_end_date, + temp.cohort_end_date, -- TODO: update cohort_end_date to be study_end_date if study_end_date is before? temp.observation_period_start_date, temp.observation_period_end_date, 'target' as char_type - FROM #temp_target temp; + FROM #temp_target_date temp; +-- ========================= + -INSERT INTO @characterization_schema.@attrition_table +-- ========================= +-- DO ATTRITION - how to get 0 when there are no rows? +DELETE FROM @characterization_schema.@target_attrition_table +WHERE characterization_target_id in (SELECT DISTINCT cohort_definition_id FROM #temp_target_date) +; + +INSERT INTO @characterization_schema.@target_attrition_table( +characterization_target_id, attr_order, attr_reason, +n_events, n_people) SELECT cohort_definition_id, -'Target first in @limit_to_first_in_n_days - @min_prior_observation prior obs' as attr_reason, -count(*) as n - +1, +'Target Start', +count(*), +count(distinct subject_id) FROM #temp_target +GROUP BY cohort_definition_id +; + +INSERT INTO @characterization_schema.@target_attrition_table( +characterization_target_id, attr_order, attr_reason, +n_events, n_people) + +SELECT * FROM +(SELECT +cohort_definition_id as characterization_target_id, +2 as attr_order, +'First in @limit_to_first_in_n_days days' as attr_reason, +count(*) as n_events, +count(distinct subject_id) as n_people +FROM #temp_target_first +GROUP BY cohort_definition_id) main + +UNION + +SELECT +cohort_definition_id, +2, +'First in @limit_to_first_in_n_days days', +0, +0 +FROM #temp_target -- preious +WHERE cohort_definition_id NOT IN +(SELECT distinct cohort_definition_id FROM #temp_target_first) + +; + +INSERT INTO @characterization_schema.@target_attrition_table( +characterization_target_id, attr_order, attr_reason, +n_events, n_people) + +SELECT * FROM +(SELECT +cohort_definition_id as characterization_target_id, +3 as attr_order, +'With @min_prior_observation prior obs' as attr_reason, +count(*) as n_events, +count(distinct subject_id) as n_people +FROM #temp_target_prior +GROUP BY cohort_definition_id) main + +UNION + +SELECT +cohort_definition_id, +3, +'With @min_prior_observation prior obs', +0, +0 +FROM #temp_target_first -- preious +WHERE cohort_definition_id NOT IN +(SELECT distinct cohort_definition_id FROM #temp_target_prior) + +; + +INSERT INTO @characterization_schema.@target_attrition_table( +characterization_target_id, attr_order, attr_reason, +n_events, n_people) + +SELECT * FROM +(SELECT +cohort_definition_id as characterization_target_id, +4 as attr_order, +'Nested in @nesting_cohort_id' as attr_reason, +count(*) as n_events, +count(distinct subject_id) as n_people +FROM #temp_target_nest +GROUP BY cohort_definition_id) main + +UNION + +SELECT +cohort_definition_id, +4, +'Nested in @nesting_cohort_id', +0, +0 +FROM #temp_target_prior -- preious +WHERE cohort_definition_id NOT IN +(SELECT distinct cohort_definition_id FROM #temp_target_nest) + +; + +INSERT INTO @characterization_schema.@target_attrition_table( +characterization_target_id, attr_order, attr_reason, +n_events, n_people) + +SELECT * FROM +(SELECT +cohort_definition_id as characterization_target_id, +5 as attr_order, +'Aged @min_age to @max_age' as attr_reason, +count(*) as n_events, +count(distinct subject_id) as n_people +FROM #temp_target_age +GROUP BY cohort_definition_id) main + +UNION + +SELECT +cohort_definition_id, +5, +'Aged @min_age to @max_age', +0, +0 +FROM #temp_target_nest -- preious +WHERE cohort_definition_id NOT IN +(SELECT distinct cohort_definition_id FROM #temp_target_age) + +; + +INSERT INTO @characterization_schema.@target_attrition_table( +characterization_target_id, attr_order, attr_reason, +n_events, n_people) + +SELECT * FROM +(SELECT +cohort_definition_id as characterization_target_id, +6 as attr_order, +'Gender in @gender_concept_ids' as attr_reason, +count(*) as n_events, +count(distinct subject_id) as n_people +FROM #temp_target_gender +GROUP BY cohort_definition_id) main + +UNION + +SELECT +cohort_definition_id, +6, +'Gender in @gender_concept_ids', +0, +0 +FROM #temp_target_age -- preious +WHERE cohort_definition_id NOT IN +(SELECT distinct cohort_definition_id FROM #temp_target_gender); + +INSERT INTO @characterization_schema.@target_attrition_table( +characterization_target_id, attr_order, attr_reason, +n_events, n_people +) + +SELECT * FROM +(SELECT +cohort_definition_id as characterization_target_id, +7 as attr_order, +'Starting between @study_start to @study_end' as attr_reason, +count(*) as n_events, +count(distinct subject_id) as n_people + +FROM #temp_target_date +GROUP BY cohort_definition_id) main + +UNION + +SELECT +cohort_definition_id, +7, +'Starting between @study_start to @study_end', +0, +0 +FROM #temp_target_gender +WHERE cohort_definition_id NOT IN +(SELECT distinct cohort_definition_id FROM #temp_target_date) + +; + +-- ========================= + + +-- add final target count to table +DELETE FROM @characterization_schema.@target_count_table +WHERE characterization_target_id in (SELECT DISTINCT cohort_definition_id FROM #temp_target_date) +; + +INSERT INTO @characterization_schema.@target_count_table +SELECT +cohort_definition_id as characterization_target_id, +count(*) as n_events, -- new +count(distinct subject_id) as n_people -- new + +FROM #temp_target_date GROUP BY cohort_definition_id ; +-- ========================= -- clean up IF OBJECT_ID('tempdb..#temp_target', 'U') IS NOT NULL DROP TABLE #temp_target; +IF OBJECT_ID('tempdb..#temp_target_first', 'U') IS NOT NULL DROP TABLE #temp_target_first; +IF OBJECT_ID('tempdb..#temp_target_prior', 'U') IS NOT NULL DROP TABLE #temp_target_prior; +IF OBJECT_ID('tempdb..#temp_target_nest', 'U') IS NOT NULL DROP TABLE #temp_target_nest; +IF OBJECT_ID('tempdb..#temp_target_age', 'U') IS NOT NULL DROP TABLE #temp_target_age; +IF OBJECT_ID('tempdb..#temp_target_gender', 'U') IS NOT NULL DROP TABLE #temp_target_gender; +IF OBJECT_ID('tempdb..#temp_target_date', 'U') IS NOT NULL DROP TABLE #temp_target_date; +-- ========================= + + + + diff --git a/inst/sql/sql_server/TargetCounts.sql b/inst/sql/sql_server/TargetCounts.sql deleted file mode 100644 index 97e4aab..0000000 --- a/inst/sql/sql_server/TargetCounts.sql +++ /dev/null @@ -1,4 +0,0 @@ -SELECT cohort_definition_id/10, count(*) AS N -FROM @characterization_schema.@characterization_table -WHERE char_type = 'target' -GROUP BY cohort_definition_id, char_type; diff --git a/inst/sql/sql_server/TimeToEvent.sql b/inst/sql/sql_server/TimeToEvent.sql index e30e961..426b738 100644 --- a/inst/sql/sql_server/TimeToEvent.sql +++ b/inst/sql/sql_server/TimeToEvent.sql @@ -2,9 +2,9 @@ drop table if exists #targets; select *, row_number() over (partition by cohort_definition_id, subject_id order by cohort_start_date asc) as era_number into #targets -from @target_database_schema.@target_table +from @characterization_schema.@characterization_table where cohort_definition_id in -(select distinct target_cohort_definition_id from #cohort_settings) +(select distinct characterization_target_id from #cohort_settings) ; drop table if exists #outcomes; @@ -49,7 +49,7 @@ inner join ( ) o1 on t1.subject_id = o1.subject_id inner join #cohort_settings ito1 -on t1.cohort_definition_id = ito1.target_cohort_definition_id +on t1.cohort_definition_id = ito1.characterization_target_id and o1.cohort_definition_id = ito1.outcome_cohort_definition_id ; @@ -77,50 +77,6 @@ group by --select * from #two_fu_bounds; -drop table if exists #t_prior_obs; -select - t1.cohort_definition_id, - 'Before target start' as observation_time_type, - datediff(day, t1.first_date, op1.observation_period_start_date) as time_to_event, - count(t1.subject_id) as num_persons -into #t_prior_obs -from ( - select cohort_definition_id, subject_id, min(cohort_start_date) as first_date - from #targets - group by cohort_definition_id, subject_id - ) t1 -inner join @cdm_database_schema.observation_period op1 -on t1.subject_id = op1.person_id -and t1.first_date >= op1.observation_period_start_date -and t1.first_date <= op1.observation_period_end_date -group by - t1.cohort_definition_id, - datediff(day, t1.first_date, op1.observation_period_start_date) -; - - -drop table if exists #t_post_obs; -select - t1.cohort_definition_id, - 'After target start' as observation_time_type, - datediff(day, t1.first_date, op1.observation_period_end_date) as time_to_event, - count(t1.subject_id) as num_persons -into #t_post_obs -from ( - select cohort_definition_id, subject_id, min(cohort_start_date) as first_date - from #targets - group by cohort_definition_id, subject_id - ) t1 -inner join @cdm_database_schema.observation_period op1 -on t1.subject_id = op1.person_id -and t1.first_date >= op1.observation_period_start_date -and t1.first_date <= op1.observation_period_end_date -group by - t1.cohort_definition_id, - datediff(day, t1.first_date, op1.observation_period_end_date) -; - - /*time-to-event distribution*/ drop table if exists #two_tte; @@ -262,7 +218,7 @@ from ( --daily counting for +/- 100 days, jenna comment why 100 select -target_cohort_definition_id, +target_cohort_definition_id as characterization_target_id, -- renamed outcome_cohort_definition_id, outcome_type, target_outcome_type, @@ -276,7 +232,7 @@ union all --30-day counting for +/- 1080 days (~ 3 years) select -target_cohort_definition_id, +target_cohort_definition_id as characterization_target_id, -- renamed outcome_cohort_definition_id, outcome_type, target_outcome_type, @@ -297,7 +253,7 @@ union all --365-day counting for +/- all days select -target_cohort_definition_id, +target_cohort_definition_id as characterization_target_id, -- renamed outcome_cohort_definition_id, outcome_type, target_outcome_type, @@ -315,9 +271,6 @@ group by target_cohort_definition_id, outcome_cohort_definition_id, outcome_type ) temp ; --- select * from #two_tte_summary; - - diff --git a/inst/sql/sql_server/UpdateVersionNumber.sql b/inst/sql/sql_server/UpdateVersionNumber.sql index e036e85..68740b9 100644 --- a/inst/sql/sql_server/UpdateVersionNumber.sql +++ b/inst/sql/sql_server/UpdateVersionNumber.sql @@ -1,5 +1,5 @@ {DEFAULT @package_version = package_version} -{DEFAULT @version_number = '3.0.0'} +{DEFAULT @version_number = '4.0.0'} DELETE FROM @database_schema.@table_prefix@package_version; INSERT INTO @database_schema.@table_prefix@package_version (version_number) VALUES ('@version_number'); diff --git a/inst/sql/sql_server/migrations/Migration_2-v4_0_0_table_change.sql b/inst/sql/sql_server/migrations/Migration_2-v4_0_0_table_change.sql new file mode 100644 index 0000000..53b6be5 --- /dev/null +++ b/inst/sql/sql_server/migrations/Migration_2-v4_0_0_table_change.sql @@ -0,0 +1,168 @@ +{DEFAULT @package_version = package_version} +{DEFAULT @migration = migration} +{DEFAULT @table_prefix = ''} + + + +-- =========================== +-- 1) Create target_attrition table +-- =========================== +DROP TABLE IF EXISTS @database_schema.@table_prefixtarget_attrition; + +--HINT DISTRIBUTE ON RANDOM +CREATE TABLE @database_schema.@table_prefixtarget_attrition( + characterization_target_id BIGINT, + attr_order INT, + attr_reason VARCHAR(100), + n_events BIGINT, + n_people BIGINT, + database_id VARCHAR(100), + setting_id VARCHAR(50), + PRIMARY KEY (setting_id, database_id, characterization_target_id, attr_order) +); +-- =========================== + + +-- =========================== +-- 2) Create case_attrition table +-- =========================== +DROP TABLE IF EXISTS @database_schema.@table_prefixcase_attrition; + +--HINT DISTRIBUTE ON RANDOM +CREATE TABLE @database_schema.@table_prefixcase_attrition( + characterization_case_id BIGINT, + attr_order INT, + attr_reason VARCHAR(100), + n_events BIGINT, + n_people BIGINT, + database_id VARCHAR(100), + setting_id VARCHAR(50), + PRIMARY KEY (setting_id, database_id, characterization_case_id, attr_order) +); +-- =========================== + + + + +-- =========================== +-- 3) Create target_count table +-- =========================== +DROP TABLE IF EXISTS @database_schema.@table_prefixtarget_counts; + +--HINT DISTRIBUTE ON RANDOM +CREATE TABLE @database_schema.@table_prefixtarget_counts( + characterization_target_id BIGINT, + n_events BIGINT, + n_people BIGINT, + database_id VARCHAR(100), + setting_id VARCHAR(50), + PRIMARY KEY (setting_id, database_id, characterization_target_id) +); +-- =========================== + + +-- =========================== +-- 4) Create case_count table +-- =========================== +DROP TABLE IF EXISTS @database_schema.@table_prefixcase_counts; + +--HINT DISTRIBUTE ON RANDOM +CREATE TABLE @database_schema.@table_prefixcase_counts( + characterization_case_id BIGINT, + cohort_type VARCHAR(50), + n_events BIGINT, + n_people BIGINT, + database_id VARCHAR(100), + setting_id VARCHAR(50), + PRIMARY KEY (setting_id, database_id, characterization_case_id, cohort_type) +); +-- =========================== + + +-- =========================== +-- 5) Rename target_cohort_definition_id to characterization_target_id +-- =========================== +-- dechallenge_rechallenge/rechallenge_fail_case_series/time_to_event +-- Change to target_cohort_definition_id characterization_target_id + +ALTER TABLE @database_schema.@table_prefixdechallenge_rechallenge +RENAME COLUMN target_cohort_definition_id to characterization_target_id; + +ALTER TABLE @database_schema.@table_prefixrechallenge_fail_case_series +RENAME COLUMN target_cohort_definition_id to characterization_target_id; + +ALTER TABLE @database_schema.@table_prefixtime_to_event +RENAME COLUMN target_cohort_definition_id to characterization_target_id; + + +-- =========================== +-- 6) Add columns in target_settings +-- =========================== +-- target_settings: add +-- nesting_cohort_id bigint / min_age int / max_age int +-- study_start date / study_end date / gender_concept_ids varchar(100) +-- time_to_event_settings bit / dechallenge_rechallenge_settings bit +-- target_baseline_settings bit / risk_factor_settings bit / case_series_settings bit + +ALTER TABLE @database_schema.@table_prefixtarget_settings +ADD COLUMN nesting_cohort_id BIGINT; +ALTER TABLE @database_schema.@table_prefixtarget_settings +ADD COLUMN min_age INT; +ALTER TABLE @database_schema.@table_prefixtarget_settings +ADD COLUMN max_age INT; +ALTER TABLE @database_schema.@table_prefixtarget_settings +ADD COLUMN study_start CHAR(8); +ALTER TABLE @database_schema.@table_prefixtarget_settings +ADD COLUMN study_end CHAR(8); +ALTER TABLE @database_schema.@table_prefixtarget_settings +ADD COLUMN gender_concept_ids VARCHAR(100); +ALTER TABLE @database_schema.@table_prefixtarget_settings +ADD COLUMN time_to_event_settings CHAR(1); +ALTER TABLE @database_schema.@table_prefixtarget_settings +ADD COLUMN dechallenge_rechallenge_settings CHAR(1); +ALTER TABLE @database_schema.@table_prefixtarget_settings +ADD COLUMN target_baseline_settings CHAR(1); +ALTER TABLE @database_schema.@table_prefixtarget_settings +ADD COLUMN risk_factor_settings CHAR(1); +ALTER TABLE @database_schema.@table_prefixtarget_settings +ADD COLUMN case_series_settings CHAR(1); + + +-- =========================== +-- 7) Add/remove columns in case_settings +-- =========================== +-- case_settings: +-- remove: runtype +ALTER TABLE @database_schema.@table_prefixcase_settings DROP COLUMN runtype; +-- add: risk_factor_settings varchar(50) / case_series_settings varchar(50) +ALTER TABLE @database_schema.@table_prefixcase_settings +ADD COLUMN risk_factor_settings CHAR(1); +ALTER TABLE @database_schema.@table_prefixcase_settings +ADD COLUMN case_series_settings CHAR(1); + + +-- =========================== +-- 8) Add included to rechallenge_fail_case_series +-- =========================== +ALTER TABLE @database_schema.@table_prefixrechallenge_fail_case_series +ADD COLUMN included CHAR(1); + +-- =========================== +-- 8) Add new settings tables +-- =========================== +CREATE TABLE @database_schema.@table_prefixtime_to_event_settings( + setting_id VARCHAR(50), + database_id VARCHAR(100), + characterization_target_id BIGINT, + outcome_id BIGINT, + PRIMARY KEY (setting_id, database_id,characterization_target_id, outcome_id) +); + +CREATE TABLE @database_schema.@table_prefixdechallenge_rechallenge_settings( + setting_id VARCHAR(50), + database_id VARCHAR(100), + characterization_target_id BIGINT, + outcome_id BIGINT, + PRIMARY KEY (setting_id, database_id,characterization_target_id, outcome_id) +); + diff --git a/man/Characterization-package.Rd b/man/Characterization-package.Rd index 1315097..9b0573a 100644 --- a/man/Characterization-package.Rd +++ b/man/Characterization-package.Rd @@ -22,6 +22,7 @@ Useful links: Authors: \itemize{ + \item Jenna Reps \email{jreps@its.jnj.com} \item Patrick Ryan \email{ryan@ohdsi.org} \item Chris Knoll \email{knoll@ohdsi.org} } diff --git a/man/cleanIncremental.Rd b/man/cleanIncremental.Rd index 85dab5f..dc6b3ca 100644 --- a/man/cleanIncremental.Rd +++ b/man/cleanIncremental.Rd @@ -29,7 +29,7 @@ cleanIncremental( } \seealso{ -Other Incremental: -\code{\link{cleanNonIncremental}()} +Other Incremental: +\code{\link[=cleanNonIncremental]{cleanNonIncremental()}} } \concept{Incremental} diff --git a/man/cleanNonIncremental.Rd b/man/cleanNonIncremental.Rd index a254bcf..ba78e68 100644 --- a/man/cleanNonIncremental.Rd +++ b/man/cleanNonIncremental.Rd @@ -24,7 +24,7 @@ cleanNonIncremental(file.path(tempdir(), 'incremental')) } \seealso{ -Other Incremental: -\code{\link{cleanIncremental}()} +Other Incremental: +\code{\link[=cleanIncremental]{cleanIncremental()}} } \concept{Incremental} diff --git a/man/computeDechallengeRechallengeAnalyses.Rd b/man/computeDechallengeRechallengeAnalyses.Rd deleted file mode 100644 index 8e4e4e1..0000000 --- a/man/computeDechallengeRechallengeAnalyses.Rd +++ /dev/null @@ -1,84 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/DechallengeRechallenge.R -\name{computeDechallengeRechallengeAnalyses} -\alias{computeDechallengeRechallengeAnalyses} -\title{Compute dechallenge rechallenge study} -\usage{ -computeDechallengeRechallengeAnalyses( - connectionDetails = NULL, - targetDatabaseSchema, - targetTable, - outcomeDatabaseSchema = targetDatabaseSchema, - outcomeTable = targetTable, - tempEmulationSchema = getOption("sqlRenderTempEmulationSchema"), - settings, - databaseId = "database 1", - outputFolder, - minCellCount = 0, - progressBar = interactive(), - ... -) -} -\arguments{ -\item{connectionDetails}{An object of type `connectionDetails` as created using the -[DatabaseConnector::createConnectionDetails()] function.} - -\item{targetDatabaseSchema}{Schema name where your target cohort table resides. Note that for SQL Server, -this should include both the database and schema name, for example -'scratch.dbo'.} - -\item{targetTable}{Name of the target cohort table.} - -\item{outcomeDatabaseSchema}{Schema name where your outcome cohort table resides. Note that for SQL Server, -this should include both the database and schema name, for example -'scratch.dbo'.} - -\item{outcomeTable}{Name of the outcome cohort table.} - -\item{tempEmulationSchema}{Some database platforms like Oracle and Impala do not truly support temp tables. -To emulate temp tables, provide a schema with write privileges where temp tables -can be created} - -\item{settings}{The settings for the timeToEvent study} - -\item{databaseId}{An identifier for the database (string)} - -\item{outputFolder}{A directory to save the results as csv files} - -\item{minCellCount}{The minimum cell value to display, values less than this will be replaced by -1} - -\item{progressBar}{Whether to display a progress bar while the analysis is running} - -\item{...}{extra inputs} -} -\value{ -An \code{Andromeda::andromeda()} object containing the dechallenge rechallenge results -} -\description{ -Compute dechallenge rechallenge study -} -\examples{ - -conDet <- exampleOmopConnectionDetails() - -drSet <- createDechallengeRechallengeSettings( - targetIds = c(1,2), - outcomeIds = 3 -) - -computeDechallengeRechallengeAnalyses( - connectionDetails = conDet, - targetDatabaseSchema = 'main', - targetTable = 'cohort', - settings = drSet, - outputFolder = tempdir() -) - - -} -\seealso{ -Other DechallengeRechallenge: -\code{\link{computeRechallengeFailCaseSeriesAnalyses}()}, -\code{\link{createDechallengeRechallengeSettings}()} -} -\concept{DechallengeRechallenge} diff --git a/man/computeRechallengeFailCaseSeriesAnalyses.Rd b/man/computeRechallengeFailCaseSeriesAnalyses.Rd deleted file mode 100644 index 9daaa2f..0000000 --- a/man/computeRechallengeFailCaseSeriesAnalyses.Rd +++ /dev/null @@ -1,89 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/DechallengeRechallenge.R -\name{computeRechallengeFailCaseSeriesAnalyses} -\alias{computeRechallengeFailCaseSeriesAnalyses} -\title{Compute fine the subjects that fail the dechallenge rechallenge study} -\usage{ -computeRechallengeFailCaseSeriesAnalyses( - connectionDetails = NULL, - targetDatabaseSchema, - targetTable, - outcomeDatabaseSchema = targetDatabaseSchema, - outcomeTable = targetTable, - tempEmulationSchema = getOption("sqlRenderTempEmulationSchema"), - settings, - databaseId = "database 1", - showSubjectId = FALSE, - outputFolder, - minCellCount = 0, - progressBar = interactive(), - executionId, - ... -) -} -\arguments{ -\item{connectionDetails}{An object of type `connectionDetails` as created using the -[DatabaseConnector::createConnectionDetails()] function.} - -\item{targetDatabaseSchema}{Schema name where your target cohort table resides. Note that for SQL Server, -this should include both the database and schema name, for example -'scratch.dbo'.} - -\item{targetTable}{Name of the target cohort table.} - -\item{outcomeDatabaseSchema}{Schema name where your outcome cohort table resides. Note that for SQL Server, -this should include both the database and schema name, for example -'scratch.dbo'.} - -\item{outcomeTable}{Name of the outcome cohort table.} - -\item{tempEmulationSchema}{Some database platforms like Oracle and Impala do not truly support temp tables. -To emulate temp tables, provide a schema with write privileges where temp tables -can be created} - -\item{settings}{The settings for the timeToEvent study} - -\item{databaseId}{An identifier for the database (string)} - -\item{showSubjectId}{if F then subject_ids are hidden (recommended if sharing results)} - -\item{outputFolder}{A directory to save the results as csv files} - -\item{minCellCount}{The minimum cell value to display, values less than this will be replaced by -1} - -\item{progressBar}{Whether to display a progress bar while the analysis is running} - -\item{executionId}{a unique id for the run} - -\item{...}{extra inputs} -} -\value{ -An \code{Andromeda::andromeda()} object with the case series details of the failed rechallenge -} -\description{ -Compute fine the subjects that fail the dechallenge rechallenge study -} -\examples{ - -conDet <- exampleOmopConnectionDetails() - -drSet <- createDechallengeRechallengeSettings( - targetIds = c(1,2), - outcomeIds = 3 -) - -computeRechallengeFailCaseSeriesAnalyses( - connectionDetails = conDet, - targetDatabaseSchema = 'main', - targetTable = 'cohort', - settings = drSet, - outputFolder = tempdir() -) - -} -\seealso{ -Other DechallengeRechallenge: -\code{\link{computeDechallengeRechallengeAnalyses}()}, -\code{\link{createDechallengeRechallengeSettings}()} -} -\concept{DechallengeRechallenge} diff --git a/man/computeTimeToEventAnalyses.Rd b/man/computeTimeToEventAnalyses.Rd deleted file mode 100644 index 78e9e7a..0000000 --- a/man/computeTimeToEventAnalyses.Rd +++ /dev/null @@ -1,92 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/TimeToEvent.R -\name{computeTimeToEventAnalyses} -\alias{computeTimeToEventAnalyses} -\title{Compute time to event study} -\usage{ -computeTimeToEventAnalyses( - connectionDetails = NULL, - targetDatabaseSchema, - targetTable, - outcomeDatabaseSchema = targetDatabaseSchema, - outcomeTable = targetTable, - tempEmulationSchema = getOption("sqlRenderTempEmulationSchema"), - cdmDatabaseSchema, - settings, - databaseId = "database 1", - outputFolder, - minCellCount = 0, - progressBar = interactive(), - executionId, - ... -) -} -\arguments{ -\item{connectionDetails}{An object of type `connectionDetails` as created using the -[DatabaseConnector::createConnectionDetails()] function.} - -\item{targetDatabaseSchema}{Schema name where your target cohort table resides. Note that for SQL Server, -this should include both the database and schema name, for example -'scratch.dbo'.} - -\item{targetTable}{Name of the target cohort table.} - -\item{outcomeDatabaseSchema}{Schema name where your outcome cohort table resides. Note that for SQL Server, -this should include both the database and schema name, for example -'scratch.dbo'.} - -\item{outcomeTable}{Name of the outcome cohort table.} - -\item{tempEmulationSchema}{Some database platforms like Oracle and Impala do not truly support temp tables. -To emulate temp tables, provide a schema with write privileges where temp tables -can be created} - -\item{cdmDatabaseSchema}{The database schema containing the OMOP CDM data} - -\item{settings}{The settings for the timeToEvent study} - -\item{databaseId}{An identifier for the database (string)} - -\item{outputFolder}{A directory to save the results as csv files} - -\item{minCellCount}{The minimum cell value to display, values less than this will be replaced by -1} - -\item{progressBar}{Whether to display a progress bar while the analysis is running} - -\item{executionId}{a unique id for the run} - -\item{...}{extra inputs} -} -\value{ -An \code{Andromeda::andromeda()} object containing the time to event results. -} -\description{ -Compute time to event study -} -\examples{ -# example code - -conDet <- exampleOmopConnectionDetails() - -tteSet <- createTimeToEventSettings( - targetIds = c(1,2), - outcomeIds = 3 -) - -result <- computeTimeToEventAnalyses( - connectionDetails = conDet, - targetDatabaseSchema = 'main', - targetTable = 'cohort', - cdmDatabaseSchema = 'main', - settings = tteSet, - outputFolder = file.path(tempdir(), 'tte') -) - - - -} -\seealso{ -Other TimeToEvent: -\code{\link{createTimeToEventSettings}()} -} -\concept{TimeToEvent} diff --git a/man/createCaseSeriesSettings.Rd b/man/createCaseSeriesSettings.Rd index 50475b8..1ddea3c 100644 --- a/man/createCaseSeriesSettings.Rd +++ b/man/createCaseSeriesSettings.Rd @@ -5,10 +5,8 @@ \title{Create aggregate covariate study settings} \usage{ createCaseSeriesSettings( - targetIds, + studyPopulationSettings, outcomeIds, - limitToFirstInNDays = 99999, - minPriorObservation = 0, outcomeWashoutDays = 0, riskWindowStart = 1, startAnchor = "cohort start", @@ -23,15 +21,11 @@ createCaseSeriesSettings( ) } \arguments{ -\item{targetIds}{A list of cohortIds for the target cohorts} +\item{studyPopulationSettings}{A List of object created using \code{createStudyPopulationSettings} that specifies target cohorts and inclusion criteria} \item{outcomeIds}{A list of cohortIds for the outcome cohorts} -\item{limitToFirstInNDays}{whether to limit each target cohort to the first entry into the cohort per N days per subject} - -\item{minPriorObservation}{The minimum time (in days) in the database a patient in the target cohorts must be observed prior to index} - -\item{outcomeWashoutDays}{Patients with the outcome within outcomeWashout days prior to index are excluded from the risk factor analysis} +\item{outcomeWashoutDays}{A single integer value. Patients with the outcome within outcomeWashout days prior to index are excluded from the risk factor analysis} \item{riskWindowStart}{The start of the risk window (in days) relative to the `startAnchor`.} @@ -45,9 +39,9 @@ or `"cohort end"`.} \item{caseCovariateSettings}{An object created using \code{createDuringCovariateSettings}} -\item{casePreTargetDuration}{The number of days prior to case index we use for FeatureExtraction} +\item{casePreTargetDuration}{A single integer value. The number of days prior to case index we use for FeatureExtraction} -\item{casePostOutcomeDuration}{The number of days prior to case index we use for FeatureExtraction} +\item{casePostOutcomeDuration}{A single integer value. The number of days prior to case index we use for FeatureExtraction} } \value{ A list with the settings @@ -58,10 +52,12 @@ Create aggregate covariate study settings \examples{ caseSeriesSetting <- createCaseSeriesSettings( - targetIds = c(1,2), + studyPopulationSettings = createStudyPopulationSettings( + targetIds = c(1,2), + minPriorObservation = 365, + limitToFirstInNDays = 365 + ), outcomeIds = c(3), - limitToFirstInNDays = 365, - minPriorObservation = 365, outcomeWashoutDays = 90, riskWindowStart = 1, startAnchor = "cohort start", @@ -73,8 +69,8 @@ caseSeriesSetting <- createCaseSeriesSettings( } \seealso{ -Other Aggregate: -\code{\link{createRiskFactorSettings}()}, -\code{\link{createTargetBaselineSettings}()} +Other Aggregate: +\code{\link[=createRiskFactorSettings]{createRiskFactorSettings()}}, +\code{\link[=createTargetBaselineSettings]{createTargetBaselineSettings()}} } \concept{Aggregate} diff --git a/man/createCharacterizationSettings.Rd b/man/createCharacterizationSettings.Rd index b70f89a..d37c407 100644 --- a/man/createCharacterizationSettings.Rd +++ b/man/createCharacterizationSettings.Rd @@ -36,7 +36,11 @@ Specify one or more timeToEvent, dechallengeRechallenge and aggregateCovariate s # example code drSet <- createDechallengeRechallengeSettings( - targetIds = c(1,2), + studyPopulationSettings = createStudyPopulationSettings( + targetIds = c(1,2), + limitToFirstInNDays = 0, + minPriorObservation = 0 + ), outcomeIds = 3 ) @@ -46,9 +50,9 @@ cSet <- createCharacterizationSettings( } \seealso{ -Other LargeScale: -\code{\link{loadCharacterizationSettings}()}, -\code{\link{runCharacterizationAnalyses}()}, -\code{\link{saveCharacterizationSettings}()} +Other LargeScale: +\code{\link[=loadCharacterizationSettings]{loadCharacterizationSettings()}}, +\code{\link[=runCharacterizationAnalyses]{runCharacterizationAnalyses()}}, +\code{\link[=saveCharacterizationSettings]{saveCharacterizationSettings()}} } \concept{LargeScale} diff --git a/man/createCharacterizationTables.Rd b/man/createCharacterizationTables.Rd index e412d4e..dc9e6ca 100644 --- a/man/createCharacterizationTables.Rd +++ b/man/createCharacterizationTables.Rd @@ -52,8 +52,8 @@ createCharacterizationTables( } \seealso{ -Other Database: -\code{\link{createSqliteDatabase}()}, -\code{\link{insertResultsToDatabase}()} +Other Database: +\code{\link[=createSqliteDatabase]{createSqliteDatabase()}}, +\code{\link[=insertResultsToDatabase]{insertResultsToDatabase()}} } \concept{Database} diff --git a/man/createDechallengeRechallengeSettings.Rd b/man/createDechallengeRechallengeSettings.Rd index 5bae700..33c43c6 100644 --- a/man/createDechallengeRechallengeSettings.Rd +++ b/man/createDechallengeRechallengeSettings.Rd @@ -5,14 +5,14 @@ \title{Create dechallenge rechallenge study settings} \usage{ createDechallengeRechallengeSettings( - targetIds, + studyPopulationSettings, outcomeIds, dechallengeStopInterval = 30, dechallengeEvaluationWindow = 30 ) } \arguments{ -\item{targetIds}{A list of cohortIds for the target cohorts} +\item{studyPopulationSettings}{An object created using \code{createStudyPopulationSettings} of a list of \code{createStudyPopulationSettings} that specifies cohort inclusion criteria} \item{outcomeIds}{A list of cohortIds for the outcome cohorts} @@ -28,15 +28,14 @@ Create dechallenge rechallenge study settings } \examples{ drSet <- createDechallengeRechallengeSettings( - targetIds = c(1,2), + studyPopulationSettings = createStudyPopulationSettings( + targetIds = c(1,2), + limitToFirstInNDays = 0, + minPriorObservation = 0 + ), outcomeIds = 3 ) -} -\seealso{ -Other DechallengeRechallenge: -\code{\link{computeDechallengeRechallengeAnalyses}()}, -\code{\link{computeRechallengeFailCaseSeriesAnalyses}()} } \concept{DechallengeRechallenge} diff --git a/man/createDuringCovariateSettings.Rd b/man/createDuringCovariateSettings.Rd index 99c7254..1dffe35 100644 --- a/man/createDuringCovariateSettings.Rd +++ b/man/createDuringCovariateSettings.Rd @@ -105,7 +105,7 @@ settings <- createDuringCovariateSettings( } \seealso{ -Other CovariateSetting: -\code{\link{getDbDuringCovariateData}()} +Other CovariateSetting: +\code{\link[=getDbDuringCovariateData]{getDbDuringCovariateData()}} } \concept{CovariateSetting} diff --git a/man/createRiskFactorSettings.Rd b/man/createRiskFactorSettings.Rd index 2c08abe..1ca8322 100644 --- a/man/createRiskFactorSettings.Rd +++ b/man/createRiskFactorSettings.Rd @@ -5,10 +5,8 @@ \title{Create risk factor study settings} \usage{ createRiskFactorSettings( - targetIds, + studyPopulationSettings, outcomeIds, - limitToFirstInNDays = 99999, - minPriorObservation = 0, outcomeWashoutDays = 0, riskWindowStart = 1, startAnchor = "cohort start", @@ -28,21 +26,15 @@ createRiskFactorSettings( useProcedureOccurrenceShortTerm = TRUE, useMeasurementShortTerm = TRUE, useObservationShortTerm = TRUE, useDeviceExposureShortTerm = TRUE, useVisitConceptCountShortTerm = TRUE, endDays = 0, longTermStartDays = -365, - shortTermStartDays = -30), - minTargetSize = 0, - minTwithOSize = 0 + shortTermStartDays = -30) ) } \arguments{ -\item{targetIds}{A list of cohortIds for the target cohorts} +\item{studyPopulationSettings}{A list of objects created using \code{createStudyPopulationSettings} that specifies target cohorts and inclusion criteria} \item{outcomeIds}{A list of cohortIds for the outcome cohorts} -\item{limitToFirstInNDays}{whether to limit each target cohort to the first entry into the cohort per N days per subject} - -\item{minPriorObservation}{The minimum time (in days) in the database a patient in the target cohorts must be observed prior to index} - -\item{outcomeWashoutDays}{Patients with the outcome within outcomeWashout days prior to index are excluded from the risk factor analysis} +\item{outcomeWashoutDays}{A single integer value. Patients with the outcome within outcomeWashout days prior to index are excluded from the risk factor analysis} \item{riskWindowStart}{The start of the risk window (in days) relative to the `startAnchor`.} @@ -55,10 +47,6 @@ or `"cohort end"`.} or `"cohort end"`.} \item{covariateSettings}{An object created using \code{FeatureExtraction::createCovariateSettings}} - -\item{minTargetSize}{The minimum size of the target cohorts for them to have aggregate covariates calculated} - -\item{minTwithOSize}{The minimum size of the cohorts corresponding to patients in the target with the outcome during time-at-risk for them to have aggregate covariates calculated} } \value{ A list with the settings @@ -69,9 +57,12 @@ Create risk factor study settings \examples{ riskFactorSetting <- createRiskFactorSettings( - targetIds = c(1,2), + studyPopulationSettings = createStudyPopulationSettings( + targetIds = c(1,2), + minPriorObservation = 365, + limitToFirstInNDays = 99999 + ), outcomeIds = c(3), - minPriorObservation = 365, outcomeWashoutDays = 90, riskWindowStart = 1, startAnchor = "cohort start", @@ -81,8 +72,8 @@ riskFactorSetting <- createRiskFactorSettings( } \seealso{ -Other Aggregate: -\code{\link{createCaseSeriesSettings}()}, -\code{\link{createTargetBaselineSettings}()} +Other Aggregate: +\code{\link[=createCaseSeriesSettings]{createCaseSeriesSettings()}}, +\code{\link[=createTargetBaselineSettings]{createTargetBaselineSettings()}} } \concept{Aggregate} diff --git a/man/createSqliteDatabase.Rd b/man/createSqliteDatabase.Rd index 8852ba4..a89dbf5 100644 --- a/man/createSqliteDatabase.Rd +++ b/man/createSqliteDatabase.Rd @@ -25,8 +25,8 @@ charResultDbCD <- createSqliteDatabase() } \seealso{ -Other Database: -\code{\link{createCharacterizationTables}()}, -\code{\link{insertResultsToDatabase}()} +Other Database: +\code{\link[=createCharacterizationTables]{createCharacterizationTables()}}, +\code{\link[=insertResultsToDatabase]{insertResultsToDatabase()}} } \concept{Database} diff --git a/man/createStudyPopulationSettings.Rd b/man/createStudyPopulationSettings.Rd new file mode 100644 index 0000000..f75194b --- /dev/null +++ b/man/createStudyPopulationSettings.Rd @@ -0,0 +1,61 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/StudyPopulation.R +\name{createStudyPopulationSettings} +\alias{createStudyPopulationSettings} +\title{create the study population settings} +\usage{ +createStudyPopulationSettings( + targetIds, + limitToFirstInNDays = 0, + minPriorObservation = 0, + nestingCohortId = NULL, + minAge = NULL, + maxAge = NULL, + studyStartDate = NULL, + studyEndDate = NULL, + genderConceptIds = NULL +) +} +\arguments{ +\item{targetIds}{A target cohort id or vector of target cohort ids to do the subsetting to} + +\item{limitToFirstInNDays}{Should only the first exposure in N days per subject be included?} + +\item{minPriorObservation}{The minimum required continuous observation time prior to index +date for a person to be included in the cohort.} + +\item{nestingCohortId}{A cohort definition id to restrict the target cohort. Patient in the target cohort +are only included if they are also in the nesting cohort at index.} + +\item{minAge}{The minimum age required to be in the target at index} + +\item{maxAge}{The maximum age required to be in the target at index} + +\item{studyStartDate}{The earliest date to be included into the target. Date format is 'yyyymmdd'.} + +\item{studyEndDate}{The latest date to be included into the target. Date format is 'yyyymmdd'.} + +\item{genderConceptIds}{A target cohort subject's gender concept to restrict to} +} +\value{ +A data.frame containing all the settings required +for creating the study populations of interest +} +\description{ +create the study population settings +} +\examples{ +# Create study population settings with a washout period of 365 days and +# restricted to adults for target dates that occur for the first time in 365 days. +populationSettings <- createStudyPopulationSettings( + targetId = 1, + limitToFirstInNDays = 365, + minPriorObservation = 365, + minAge = 18 + ) +} +\seealso{ +Other helper: +\code{\link[=exampleOmopConnectionDetails]{exampleOmopConnectionDetails()}} +} +\concept{helper} diff --git a/man/createTargetBaselineSettings.Rd b/man/createTargetBaselineSettings.Rd index fbd5406..afc3522 100644 --- a/man/createTargetBaselineSettings.Rd +++ b/man/createTargetBaselineSettings.Rd @@ -5,9 +5,7 @@ \title{Create target baseline aggregate covariate study settings} \usage{ createTargetBaselineSettings( - targetIds, - limitToFirstInNDays = 99999, - minPriorObservation = 0, + studyPopulationSettings, covariateSettings = FeatureExtraction::createCovariateSettings(useDemographicsGender = TRUE, useDemographicsAge = TRUE, useDemographicsAgeGroup = TRUE, useDemographicsRace = TRUE, useDemographicsEthnicity = TRUE, useDemographicsIndexYear = TRUE, @@ -26,11 +24,7 @@ createTargetBaselineSettings( ) } \arguments{ -\item{targetIds}{A list of cohortIds for the target cohorts} - -\item{limitToFirstInNDays}{Whether to remove target cohort entries that occur within limitToFirstInNDays of a prior entry. limitToFirstInNDays = 99999 means limit to first entry.} - -\item{minPriorObservation}{The minimum time (in days) in the database a patient in the target cohorts must be observed prior to index} +\item{studyPopulationSettings}{An object created using \code{createStudyPopulationSettings} or a list of \code{createStudyPopulationSettings} that specifies specific populations of interest} \item{covariateSettings}{An object created using \code{FeatureExtraction::createCovariateSettings}} } @@ -43,15 +37,17 @@ Create target baseline aggregate covariate study settings \examples{ aggregateSetting <- createTargetBaselineSettings( - targetIds = c(1,2), + studyPopulationSettings = createStudyPopulationSettings( + targetIds = 1:2, limitToFirstInNDays = 99999, minPriorObservation = 365 + ) ) } \seealso{ -Other Aggregate: -\code{\link{createCaseSeriesSettings}()}, -\code{\link{createRiskFactorSettings}()} +Other Aggregate: +\code{\link[=createCaseSeriesSettings]{createCaseSeriesSettings()}}, +\code{\link[=createRiskFactorSettings]{createRiskFactorSettings()}} } \concept{Aggregate} diff --git a/man/createTimeToEventSettings.Rd b/man/createTimeToEventSettings.Rd index 275b65c..11053e8 100644 --- a/man/createTimeToEventSettings.Rd +++ b/man/createTimeToEventSettings.Rd @@ -4,10 +4,10 @@ \alias{createTimeToEventSettings} \title{Create time to event study settings} \usage{ -createTimeToEventSettings(targetIds, outcomeIds) +createTimeToEventSettings(studyPopulationSettings, outcomeIds) } \arguments{ -\item{targetIds}{A list of cohortIds for the target cohorts} +\item{studyPopulationSettings}{An object created using \code{createStudyPopulationSettings} or a list of \code{createStudyPopulationSettings} that specifies cohort inclusion criteria} \item{outcomeIds}{A list of cohortIds for the outcome cohorts} } @@ -21,14 +21,14 @@ Create time to event study settings # example code tteSet <- createTimeToEventSettings( - targetIds = c(1,2), + studyPopulationSettings = createStudyPopulationSettings( + targetIds = c(1,2), + limitToFirstInNDays = 0, + minPriorObservation = 0 + ), outcomeIds = 3 ) -} -\seealso{ -Other TimeToEvent: -\code{\link{computeTimeToEventAnalyses}()} } \concept{TimeToEvent} diff --git a/man/exampleOmopConnectionDetails.Rd b/man/exampleOmopConnectionDetails.Rd index b09de2a..cf9287c 100644 --- a/man/exampleOmopConnectionDetails.Rd +++ b/man/exampleOmopConnectionDetails.Rd @@ -23,5 +23,9 @@ conDet <- exampleOmopConnectionDetails() connectionHandler <- ResultModelManager::ConnectionHandler$new(conDet) +} +\seealso{ +Other helper: +\code{\link[=createStudyPopulationSettings]{createStudyPopulationSettings()}} } \concept{helper} diff --git a/man/getDbDuringCovariateData.Rd b/man/getDbDuringCovariateData.Rd index f421791..b6e5731 100644 --- a/man/getDbDuringCovariateData.Rd +++ b/man/getDbDuringCovariateData.Rd @@ -106,7 +106,7 @@ DatabaseConnector::disconnect(connection) } \seealso{ -Other CovariateSetting: -\code{\link{createDuringCovariateSettings}()} +Other CovariateSetting: +\code{\link[=createDuringCovariateSettings]{createDuringCovariateSettings()}} } \concept{CovariateSetting} diff --git a/man/insertResultsToDatabase.Rd b/man/insertResultsToDatabase.Rd index 9e5f136..29179d8 100644 --- a/man/insertResultsToDatabase.Rd +++ b/man/insertResultsToDatabase.Rd @@ -41,7 +41,11 @@ Calls ResultModelManager uploadResults function to upload the csv files #conDet <- exampleOmopConnectionDetails() #tteSet <- createTimeToEventSettings( -#targetIds = c(1,2), +# studyPopulationSettings = createStudyPopulationSettings( +# targetIds = c(1,2), +# limitToFirstInNDays = 0, +# minPriorObservation = 0 +# ), # outcomeIds = 3 # ) @@ -80,8 +84,8 @@ Calls ResultModelManager uploadResults function to upload the csv files } \seealso{ -Other Database: -\code{\link{createCharacterizationTables}()}, -\code{\link{createSqliteDatabase}()} +Other Database: +\code{\link[=createCharacterizationTables]{createCharacterizationTables()}}, +\code{\link[=createSqliteDatabase]{createSqliteDatabase()}} } \concept{Database} diff --git a/man/loadCharacterizationSettings.Rd b/man/loadCharacterizationSettings.Rd index 86b2a48..b41ae6a 100644 --- a/man/loadCharacterizationSettings.Rd +++ b/man/loadCharacterizationSettings.Rd @@ -24,7 +24,11 @@ Input the directory containing the 'characterizationSettings.json' file and load setPath <- file.path(tempdir(), 'charSet.json') drSet <- createDechallengeRechallengeSettings( - targetIds = c(1,2), + studyPopulationSettings = createStudyPopulationSettings( + targetIds = c(1,2), + limitToFirstInNDays = 0, + minPriorObservation = 0 + ), outcomeIds = 3 ) @@ -42,9 +46,9 @@ setting <- loadCharacterizationSettings(setPath) } \seealso{ -Other LargeScale: -\code{\link{createCharacterizationSettings}()}, -\code{\link{runCharacterizationAnalyses}()}, -\code{\link{saveCharacterizationSettings}()} +Other LargeScale: +\code{\link[=createCharacterizationSettings]{createCharacterizationSettings()}}, +\code{\link[=runCharacterizationAnalyses]{runCharacterizationAnalyses()}}, +\code{\link[=saveCharacterizationSettings]{saveCharacterizationSettings()}} } \concept{LargeScale} diff --git a/man/runCharacterizationAnalyses.Rd b/man/runCharacterizationAnalyses.Rd index e558d80..0014d86 100644 --- a/man/runCharacterizationAnalyses.Rd +++ b/man/runCharacterizationAnalyses.Rd @@ -10,6 +10,8 @@ runCharacterizationAnalyses( targetTable, outcomeDatabaseSchema, outcomeTable, + nestingCohortTable = targetTable, + nestingCohortDatabaseSchema = targetDatabaseSchema, outputDatabaseSchema = targetDatabaseSchema, outputTable = "characterization_cohort", tempEmulationSchema = getOption("sqlRenderTempEmulationSchema"), @@ -28,7 +30,9 @@ runCharacterizationAnalyses( minCharacterizationMean = 0.001, minCovariateCount = 0, mode = "CohortIncidence", - minSMD = 0 + minSMD = 0, + minTargetSize = 0, + minCaseSize = 0 ) } \arguments{ @@ -46,6 +50,10 @@ this should include both the database and schema name, for example \item{outcomeTable}{Name of the outcome cohort table.} +\item{nestingCohortTable}{The cohort table to extract the nesting cohort from} + +\item{nestingCohortDatabaseSchema}{The schema containing the nestingCohortTable} + \item{outputDatabaseSchema}{The schema where the characterization cohort table will be saved into} \item{outputTable}{The table name where the characterization cohort table will be saved into} @@ -85,6 +93,10 @@ can be created} \item{mode}{Select from Efficient (no exclusions to target based on washout)/CohortIncidence (excludes targets with outcome in washout if they have no time at risk)/PatientLevelPrediction (excludes targets with outcome during washout prior to index)} \item{minSMD}{The minimum standardized mean difference for the risk factor analysis} + +\item{minTargetSize}{The minimum target size to be included in targetBaseline, riskFactor or caseSeries} + +\item{minCaseSize}{The minimum case or non-case size to be included in riskFactor or caseSeries} } \value{ Multiple csv files in the outputDirectory. @@ -102,7 +114,11 @@ specified saveDirectory conDet <- exampleOmopConnectionDetails() tteSet <- createTimeToEventSettings( - targetIds = c(1,2), + studyPopulationSettings = createStudyPopulationSettings( + targetIds = c(1,2), + limitToFirstInNDays = 0, + minPriorObservation = 0 + ), outcomeIds = 3 ) @@ -123,9 +139,9 @@ runCharacterizationAnalyses( } \seealso{ -Other LargeScale: -\code{\link{createCharacterizationSettings}()}, -\code{\link{loadCharacterizationSettings}()}, -\code{\link{saveCharacterizationSettings}()} +Other LargeScale: +\code{\link[=createCharacterizationSettings]{createCharacterizationSettings()}}, +\code{\link[=loadCharacterizationSettings]{loadCharacterizationSettings()}}, +\code{\link[=saveCharacterizationSettings]{saveCharacterizationSettings()}} } \concept{LargeScale} diff --git a/man/saveCharacterizationSettings.Rd b/man/saveCharacterizationSettings.Rd index c5f037b..55e5735 100644 --- a/man/saveCharacterizationSettings.Rd +++ b/man/saveCharacterizationSettings.Rd @@ -22,7 +22,11 @@ Input the characterization settings and output a json file to a file named 'char } \examples{ drSet <- createDechallengeRechallengeSettings( - targetIds = c(1,2), + studyPopulationSettings = createStudyPopulationSettings( + targetIds = c(1,2), + limitToFirstInNDays = 0, + minPriorObservation = 0 + ), outcomeIds = 3 ) @@ -37,9 +41,9 @@ saveCharacterizationSettings( } \seealso{ -Other LargeScale: -\code{\link{createCharacterizationSettings}()}, -\code{\link{loadCharacterizationSettings}()}, -\code{\link{runCharacterizationAnalyses}()} +Other LargeScale: +\code{\link[=createCharacterizationSettings]{createCharacterizationSettings()}}, +\code{\link[=loadCharacterizationSettings]{loadCharacterizationSettings()}}, +\code{\link[=runCharacterizationAnalyses]{runCharacterizationAnalyses()}} } \concept{LargeScale} diff --git a/man/viewCharacterization.Rd b/man/viewCharacterization.Rd index 10d7b78..6a1f710 100644 --- a/man/viewCharacterization.Rd +++ b/man/viewCharacterization.Rd @@ -25,7 +25,9 @@ Input is the output of ... conDet <- exampleOmopConnectionDetails() tteSet <- createTimeToEventSettings( - targetIds = c(1,2), +studyPopulationSettings = createStudyPopulationSettings( + targetIds = c(1,2) + ), outcomeIds = 3 ) diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R index 8714918..47b9179 100644 --- a/tests/testthat/setup.R +++ b/tests/testthat/setup.R @@ -6,3 +6,29 @@ withr::defer( }, testthat::teardown_env() ) + +skipIfCreateTargetCohortSqlUnavailable <- function() { + sqlAvailable <- !inherits( + try( + SqlRender::loadRenderTranslateSql( + sqlFilename = "CreateTargetCohortTable.sql", + packageName = "Characterization", + dbms = "sqlite", + tempEmulationSchema = "main", + characterization_schema = "main", + characterization_table = "char_table", + target_attrition_table = "target_attrition", + target_count_table = "target_count", + case_attrition_table = "case_attrition", + case_count_table = "case_count" + ), + silent = TRUE + ), + "try-error" + ) + + testthat::skip_if_not( + condition = sqlAvailable, + message = "CreateTargetCohortTable.sql not resolvable in this test context" + ) +} diff --git a/tests/testthat/test-CaseSeries.R b/tests/testthat/test-CaseSeries.R index c994174..b8fbba1 100644 --- a/tests/testthat/test-CaseSeries.R +++ b/tests/testthat/test-CaseSeries.R @@ -15,10 +15,12 @@ test_that("createCaseSeriesSettings", { ) res <- createCaseSeriesSettings( - targetIds = targetIds, + studyPopulationSettings = createStudyPopulationSettings( + targetIds = targetIds, + limitToFirstInNDays = 9, + minPriorObservation = 10 + ), outcomeIds = outcomeIds, - limitToFirstInNDays = 9, - minPriorObservation = 10, outcomeWashoutDays = 365, riskWindowStart = 1, startAnchor = 'cohort start', @@ -30,7 +32,7 @@ test_that("createCaseSeriesSettings", { ) testthat::expect_equal( - res$targetIds, + res$studyPopulationSettings$targetId, targetIds ) testthat::expect_equal( @@ -39,12 +41,12 @@ test_that("createCaseSeriesSettings", { ) testthat::expect_equal( - res$minPriorObservation, + unique(res$studyPopulationSettings$minPriorObservation), 10 ) testthat::expect_equal( - res$limitToFirstInNDays, + unique(res$studyPopulationSettings$limitToFirstInNDays), 9 ) @@ -91,10 +93,12 @@ test_that("error when using temporal features - risk factors", { testthat::expect_error( res <- createCaseSeriesSettings( - targetIds = targetIds, + studyPopulationSettings = createStudyPopulationSettings( + targetIds = targetIds, + limitToFirstInNDays = 9, + minPriorObservation = 10 + ), outcomeIds = outcomeIds, - limitToFirstInNDays = 9, - minPriorObservation = 10, outcomeWashoutDays = 365, riskWindowStart = 1, startAnchor = 'cohort start', @@ -111,10 +115,12 @@ test_that("error when using temporal features - risk factors", { testthat::expect_error( res <- createCaseSeriesSettings( - targetIds = targetIds, + studyPopulationSettings = createStudyPopulationSettings( + targetIds = targetIds, + limitToFirstInNDays = 9, + minPriorObservation = 10 + ), outcomeIds = outcomeIds, - limitToFirstInNDays = 9, - minPriorObservation = 10, outcomeWashoutDays = 365, riskWindowStart = 1, startAnchor = 'cohort start', @@ -137,10 +143,12 @@ test_that("createCaseSeriesSettings covariateList", { covariateSettings <- list(covariateSettings1, covariateSettings2) res <- createCaseSeriesSettings( - targetIds = targetIds, + studyPopulationSettings = createStudyPopulationSettings( + targetIds = targetIds, + limitToFirstInNDays = 9, + minPriorObservation = 10 + ), outcomeIds = outcomeIds, - limitToFirstInNDays = 9, - minPriorObservation = 10, outcomeWashoutDays = 365, riskWindowStart = 1, startAnchor = 'cohort start', @@ -150,7 +158,7 @@ test_that("createCaseSeriesSettings covariateList", { ) testthat::expect_equal( - res$targetIds, + res$studyPopulationSettings$targetId, targetIds ) testthat::expect_equal( @@ -172,10 +180,12 @@ test_that("getCaseSeriesJobs", { limitToFirstInNDays <- sample(300, 1) res <- createCaseSeriesSettings( - targetIds = targetIds, + studyPopulationSettings = createStudyPopulationSettings( + targetIds = targetIds, + minPriorObservation = minPriorObservation, + limitToFirstInNDays = limitToFirstInNDays + ), outcomeIds = outcomeIds, - minPriorObservation = minPriorObservation, - limitToFirstInNDays = limitToFirstInNDays, outcomeWashoutDays = 365, riskWindowStart = 1, startAnchor = 'cohort start', @@ -216,18 +226,28 @@ test_that("getCaseSeriesJobs", { testthat::expect_true(nrow(jobDf) == 2) # now check nTargetJobs = 3 + charSettings <- createCharacterizationSettings( + caseSeriesSettings = res + ) jobDf <- getCaseSeriesJobs( - characterizationSettings = createCharacterizationSettings( - caseSeriesSettings = res - ), + characterizationSettings = charSettings, nTargetJobs = 3 ) testthat::expect_true(nrow(jobDf) == 3) # check the target ids - testthat::expect_true(ParallelLogger::convertJsonToSettings(jobDf$settings[1])$targetIds == targetIds[1]) - testthat::expect_true(ParallelLogger::convertJsonToSettings(jobDf$settings[2])$targetIds == targetIds[2]) - testthat::expect_true(ParallelLogger::convertJsonToSettings(jobDf$settings[3])$targetIds == targetIds[3]) + tId1 <- charSettings$characterizationTargetLookup$characterizationTargetId[ + charSettings$characterizationTargetLookup$targetId == res$studyPopulationSettings$targetId[1] + ] + testthat::expect_true(ParallelLogger::convertJsonToSettings(jobDf$settings[1])$characterizationTargetIds == tId1) + tId2 <- charSettings$characterizationTargetLookup$characterizationTargetId[ + charSettings$characterizationTargetLookup$targetId == res$studyPopulationSettings$targetId[2] + ] + testthat::expect_true(ParallelLogger::convertJsonToSettings(jobDf$settings[2])$characterizationTargetIds == tId2) + tId3 <- charSettings$characterizationTargetLookup$characterizationTargetId[ + charSettings$characterizationTargetLookup$targetId == res$studyPopulationSettings$targetId[3] + ] + testthat::expect_true(ParallelLogger::convertJsonToSettings(jobDf$settings[3])$characterizationTargetIds == tId3) # now check nTargetJobs = 4 jobDf <- getCaseSeriesJobs( @@ -250,6 +270,8 @@ test_that("getCaseSeriesJobs", { }) test_that("computeCaseSeriesAnalyses", { + skipIfCreateTargetCohortSqlUnavailable() + targetIds <- c(1, 2, 4) outcomeIds <- c(3) covariateSettings <- createDuringCovariateSettings( @@ -258,10 +280,12 @@ test_that("computeCaseSeriesAnalyses", { ) res <- createCaseSeriesSettings( - targetIds = targetIds, + studyPopulationSettings = createStudyPopulationSettings( + targetIds = targetIds, + limitToFirstInNDays = 365, + minPriorObservation = 30 + ), outcomeIds = outcomeIds, - limitToFirstInNDays = 365, - minPriorObservation = 30, outcomeWashoutDays = 365, riskWindowStart = 1, startAnchor = 'cohort start', @@ -312,6 +336,8 @@ test_that("computeCaseSeriesAnalyses", { characterizationTable = tables$characterizationTable, # contains char cohorts targetSettingsTable = tables$targetSettingsTable, # contains map between settings and char cohort id caseSettingsTable = tables$caseSettingsTable, + caseCountTable = tables$caseCountTable, + minCaseSize = 0, tempEmulationSchema = 'main', settings = ParallelLogger::convertJsonToSettings(jobDf$settings[1]), databaseId = "madeup", @@ -376,14 +402,18 @@ test_that("computeCaseSeriesAnalyses", { # testing case series include/exclude covs test_that("testing during covs", { +skipIfCreateTargetCohortSqlUnavailable() + targetIds <- c(1, 2, 4) outcomeIds <- c(3) res <- createCaseSeriesSettings( - targetIds = targetIds, + studyPopulationSettings = createStudyPopulationSettings( + targetIds = targetIds, + limitToFirstInNDays = 365, + minPriorObservation = 30 + ), outcomeIds = outcomeIds, - limitToFirstInNDays = 365, - minPriorObservation = 30, outcomeWashoutDays = 365, riskWindowStart = 1, startAnchor = 'cohort start', @@ -427,7 +457,7 @@ data1 <- FeatureExtraction::getDbCovariateData( cohortTable = 'char_cohort_set1_db1', cohortDatabaseSchema = "main", cohortIds = c(10,20,40), # the targets - rowIdField = 'row_number', + rowIdField = 'row_id', exportToTable = FALSE, aggregated = TRUE, minCharacterizationMean = 0.01, @@ -453,7 +483,7 @@ data2 <- FeatureExtraction::getDbCovariateData( cohortTable = 'char_cohort_set1_db1', cohortDatabaseSchema = "main", cohortIds = c(10,20,40), # the targets - rowIdField = 'row_number', + rowIdField = 'row_id', exportToTable = FALSE, aggregated = TRUE, minCharacterizationMean = 0.01, @@ -476,7 +506,7 @@ data3 <- FeatureExtraction::getDbCovariateData( cohortTable = 'char_cohort_set1_db1', cohortDatabaseSchema = "main", cohortIds = c(10,20,40), # the targets - rowIdField = 'row_number', + rowIdField = 'row_id', exportToTable = FALSE, aggregated = TRUE, minCharacterizationMean = 0.01, diff --git a/tests/testthat/test-CohortGeneration.R b/tests/testthat/test-CohortGeneration.R index 5048087..a154f22 100644 --- a/tests/testthat/test-CohortGeneration.R +++ b/tests/testthat/test-CohortGeneration.R @@ -1,35 +1,161 @@ context("CohortGeneration") +test_that("generateOutcomeEras executes on sqlite", { + skipIfCreateTargetCohortSqlUnavailable() + + sqlitePath <- tempfile(fileext = ".sqlite") + on.exit(unlink(sqlitePath, force = TRUE), add = TRUE) + + connectionDetails <- DatabaseConnector::createConnectionDetails( + dbms = "sqlite", + server = sqlitePath + ) + connection <- DatabaseConnector::connect(connectionDetails = connectionDetails) + on.exit(DatabaseConnector::disconnect(connection), add = TRUE) + + DatabaseConnector::insertTable( + connection = connection, + databaseSchema = "main", + tableName = "cohort", + data = data.frame( + cohort_definition_id = c(3, 3, 3, 3), + subject_id = c(1, 1, 1, 2), + cohort_start_date = as.Date(c("2020-01-01", "2020-06-01", "2021-07-01", "2020-03-01")), + cohort_end_date = as.Date(c("2020-01-10", "2020-06-10", "2021-07-10", "2020-03-05")) + ) + ) + + DatabaseConnector::executeSql( + connection = connection, + sql = "CREATE TABLE main.outcome_era (cohort_definition_id BIGINT, outcome_washout BIGINT, subject_id BIGINT, cohort_start_date DATE, cohort_end_date DATE);", + progressBar = FALSE, + reportOverallTime = FALSE + ) + + sql <- SqlRender::loadRenderTranslateSql( + sqlFilename = "OutcomeEras.sql", + packageName = "Characterization", + dbms = "sqlite", + tempEmulationSchema = "main", + characterization_schema = "main", + outcome_era_table = "outcome_era", + outcome_ids = "3", + outcome_washout = 365, + cohort_schema = "main", + cohort_table = "cohort" + ) + + # let it run without stopping as test is later + testthat::expect_error( + DatabaseConnector::executeSql( + connection = connection, + sql = sql, + progressBar = FALSE, + reportOverallTime = FALSE + ), + NA + ) + + eras <- DatabaseConnector::querySql( + connection = connection, + sql = "SELECT cohort_definition_id, outcome_washout, subject_id, cohort_start_date, cohort_end_date FROM main.outcome_era ORDER BY subject_id, cohort_start_date" + ) + + expected <- data.frame( + cohort_definition_id = c(3, 3,3), + outcome_washout = c(365, 365, 365), + subject_id = c(1, 1, 2), + cohort_start_date = as.Date(c("2020-01-01", "2021-07-01","2020-03-01")), + cohort_end_date = as.Date(c("2020-06-10", "2021-07-10","2020-03-05")) + ) + + testthat::expect_equal(eras, expected) + + + # now test rerunning with another washout + sql <- SqlRender::loadRenderTranslateSql( + sqlFilename = "OutcomeEras.sql", + packageName = "Characterization", + dbms = "sqlite", + tempEmulationSchema = "main", + characterization_schema = "main", + outcome_era_table = "outcome_era", + outcome_ids = "3", + outcome_washout = 365*10, + cohort_schema = "main", + cohort_table = "cohort" + ) + + # let it run without stopping as test is later + testthat::expect_error( + DatabaseConnector::executeSql( + connection = connection, + sql = sql, + progressBar = FALSE, + reportOverallTime = FALSE + ), + NA + ) + + eras <- DatabaseConnector::querySql( + connection = connection, + sql = "SELECT cohort_definition_id, outcome_washout, subject_id, cohort_start_date, cohort_end_date FROM main.outcome_era ORDER BY subject_id, cohort_start_date" + ) + + expected <- data.frame( + cohort_definition_id = c(3,3,3,3,3), + outcome_washout = c(365, 3650, 365, 365,3650), + subject_id = c(1, 1, 1, 2, 2), + cohort_start_date = as.Date(c("2020-01-01","2020-01-01", "2021-07-01","2020-03-01", "2020-03-01")), + cohort_end_date = as.Date(c("2020-06-10","2021-07-10", "2021-07-10","2020-03-05", "2020-03-05")) + ) + + testthat::expect_equal(eras, expected) + + +}) + + test_that("getCohortJobs", { targetIds <- c(1, 2, 4) outcomeIds <- c(3) timeToEventSettings1 <- createTimeToEventSettings( - targetIds = 1, + createStudyPopulationSettings( + targetIds = 1 + ), outcomeIds = c(3, 4) ) timeToEventSettings2 <- createTimeToEventSettings( - targetIds = 2, + createStudyPopulationSettings( + targetIds = 2 + ), outcomeIds = c(3, 4) ) dechallengeRechallengeSettings <- createDechallengeRechallengeSettings( - targetIds = targetIds, + createStudyPopulationSettings( + targetIds = targetIds + ), outcomeIds = outcomeIds, dechallengeStopInterval = 30, dechallengeEvaluationWindow = 31 ) targetBaselineSettings1 <- createTargetBaselineSettings( - targetIds = targetIds, + createStudyPopulationSettings( + targetIds = targetIds + ), covariateSettings = FeatureExtraction::createCovariateSettings( useDemographicsGender = TRUE ) ) targetBaselineSettings2 <- createTargetBaselineSettings( - targetIds = targetIds, + createStudyPopulationSettings( + targetIds = targetIds + ), covariateSettings = FeatureExtraction::createCovariateSettings( useDemographicsAge = TRUE, useDemographicsRace = TRUE @@ -37,7 +163,11 @@ test_that("getCohortJobs", { ) riskFactorSettings <- createRiskFactorSettings( - targetIds = targetIds, + createStudyPopulationSettings( + targetIds = targetIds, + limitToFirstInNDays = 365, + minPriorObservation = 365 + ), outcomeIds = outcomeIds, riskWindowStart = 1, startAnchor = "cohort start", @@ -51,7 +181,11 @@ test_that("getCohortJobs", { ) caseSeriesSettings <- createCaseSeriesSettings( - targetIds = targetIds, + createStudyPopulationSettings( + targetIds = targetIds, + limitToFirstInNDays = 365, + minPriorObservation = 365 + ), outcomeIds = outcomeIds, riskWindowStart = 1, startAnchor = "cohort start", @@ -86,9 +220,9 @@ jobs <- getCohortJobs( nTargetJobs = 1 ) -testthat::expect_true(nrow(jobs$targets) == 3) +testthat::expect_true(nrow(jobs$targets) == 6) testthat::expect_true(nrow(jobs$cases) == 3) -testthat::expect_true(nrow(jobs$jobs) == 2) +testthat::expect_true(nrow(jobs$jobs) == 3) testthat::expect_true(sum(ParallelLogger::convertJsonToSettings(jobs$jobs$settings[1])$targetIds %in% targetIds) == 3) @@ -99,9 +233,9 @@ jobs <- getCohortJobs( nTargetJobs = 2 ) -testthat::expect_true(nrow(jobs$targets) == 3) +testthat::expect_true(nrow(jobs$targets) == 6) testthat::expect_true(nrow(jobs$cases) == 3) -testthat::expect_true(nrow(jobs$jobs) == 4) +testthat::expect_true(nrow(jobs$jobs) == 6) testthat::expect_true(sum(unique(c(ParallelLogger::convertJsonToSettings(jobs$jobs$settings[1])$targetIds, ParallelLogger::convertJsonToSettings(jobs$jobs$settings[2])$targetIds)) %in% targetIds) == 3) @@ -112,9 +246,9 @@ jobs <- getCohortJobs( nTargetJobs = 3 ) -testthat::expect_true(nrow(jobs$targets) == 3) +testthat::expect_true(nrow(jobs$targets) == 6) testthat::expect_true(nrow(jobs$cases) == 3) -testthat::expect_true(nrow(jobs$jobs) == 6) +testthat::expect_true(nrow(jobs$jobs) == 9) testthat::expect_true(sum(unique( c(ParallelLogger::convertJsonToSettings(jobs$jobs$settings[1])$targetIds, @@ -129,9 +263,9 @@ jobs <- getCohortJobs( nTargetJobs = 4 ) -testthat::expect_true(nrow(jobs$targets) == 3) +testthat::expect_true(nrow(jobs$targets) == 6) testthat::expect_true(nrow(jobs$cases) == 3) -testthat::expect_true(nrow(jobs$jobs) == 6) +testthat::expect_true(nrow(jobs$jobs) == 9) testthat::expect_true(sum(unique( c(ParallelLogger::convertJsonToSettings(jobs$jobs$settings[1])$targetIds, @@ -147,9 +281,9 @@ jobs <- getCohortJobs( nTargetJobs = 4 ) -testthat::expect_true(nrow(jobs$targets) == 3) +testthat::expect_true(nrow(jobs$targets) == 6) testthat::expect_true(nrow(jobs$cases) == 3) -testthat::expect_true(nrow(jobs$jobs) == 9) +testthat::expect_true(nrow(jobs$jobs) == (12 + 1)) # one more due to outcome eras testthat::expect_true(sum(unique( c(ParallelLogger::convertJsonToSettings(jobs$jobs$settings[1])$targetIds, @@ -164,9 +298,9 @@ jobs <- getCohortJobs( nTargetJobs = 4 ) -testthat::expect_true(nrow(jobs$targets) == 3) +testthat::expect_true(nrow(jobs$targets) == 6) testthat::expect_true(nrow(jobs$cases) == 3) -testthat::expect_true(nrow(jobs$jobs) == 9) +testthat::expect_true(nrow(jobs$jobs) == (12 + 1)) # 1 extra outcome era testthat::expect_true(sum(unique( c(ParallelLogger::convertJsonToSettings(jobs$jobs$settings[1])$targetIds, diff --git a/tests/testthat/test-ExportingCsvFiles.R b/tests/testthat/test-ExportingCsvFiles.R index 3e455d8..ec6fce1 100644 --- a/tests/testthat/test-ExportingCsvFiles.R +++ b/tests/testthat/test-ExportingCsvFiles.R @@ -732,8 +732,9 @@ test_that("exportAttrition", { # create example attrition andromeda <- Andromeda::andromeda() - andromeda$attrition <- data.frame( - cohortDefinitionId = c(10,20,30,40, 11,21,31,12,22,32), + andromeda$target_attrition <- data.frame( + characterizationCohortId = c(10,20,30,40, 11,21,31,12,22,32), + attrOrder = 1:10, attrReason = c('Target first in 365 - 365 prior obs', 'Target first in 365 - 365 prior obs', 'Target first in 365 - 365 prior obs', @@ -743,10 +744,14 @@ test_that("exportAttrition", { '3. Has outcome during TAR', '3. Has outcome during TAR' ), - n = c(1000,50,400,350, + nEvents = c(1000,50,400,350, 50,10,60, 50,10,60 ), + nPeople = c(1000,50,400,350, + 50,10,60, + 50,10,60 + ), databaseId = 'db', settingId = 'set1' ) @@ -754,43 +759,9 @@ test_that("exportAttrition", { # save to temp folder saveCharacterizationAndromeda( andromeda = andromeda, - outputFolder = file.path(tempFolder3,'attrition') + outputFolder = file.path(tempFolder3,'target_attrition') ) - # now create target and case settings - target_settings <- data.frame( - target_id = c(1,2,3,4), - limit_to_first_in_n_days = rep(365, 4), - min_prior_observation = rep(365, 4), - setting_id = 'set1', - characterization_target_id = c(10,20,30,40), - database_id = 'db' - ) - - case_settings <- data.frame( - outcome_id = rep(3,3), - outcome_washout_days = rep(90,3), - risk_window_start = rep(1,3), - start_anchor = rep('cohort_start',3), - risk_window_end = rep(365,3), - end_anchor = rep('cohort_start',3), - runtype = rep('PLP',3), - characterization_case_id = c(1,2,3), - setting_id = 'set1', - characterization_target_id = c(10,20,40), - database_id = 'db' - ) - - utils::write.csv( - x = target_settings, - file = file.path(tempFolder3, 'c_target_settings.csv') - ) - - utils::write.csv( - x = case_settings, - file = file.path(tempFolder3, 'c_case_settings.csv') - ) - exportAttrition( executionPath = tempFolder3, outputFolder = tempFolder3, @@ -799,11 +770,11 @@ exportAttrition( ) # load attrition -testthat::expect_true(file.exists(file.path(tempFolder3, 'c_attrition.csv'))) +testthat::expect_true(file.exists(file.path(tempFolder3, 'c_target_attrition.csv'))) -attrition <- utils::read.csv(file.path(tempFolder3, 'c_attrition.csv')) -testthat::expect_true(nrow(attrition) == 16) -testthat::expect_true(sum(colnames(attrition) %in% c('cohort_definition_id', 'attr_reason', 'n', 'database_id', 'setting_id')) == 5) +target_attrition <- utils::read.csv(file.path(tempFolder3, 'c_target_attrition.csv')) +testthat::expect_true(nrow(target_attrition) == 10) +testthat::expect_true(sum(colnames(target_attrition) %in% c('characterization_cohort_id','attr_order', 'attr_reason', 'n_people','n_events', 'database_id', 'setting_id')) == 7) # now test the minCellCount @@ -813,55 +784,23 @@ exportAttrition( csvFilePrefix = 'c_', minCellCount = 50 ) -attrition <- utils::read.csv(file.path(tempFolder3, 'c_attrition.csv')) -testthat::expect_true(sum(attrition$n < 50 & attrition$n != -50) == 0) -testthat::expect_true(sum(colnames(attrition) %in% c('cohort_definition_id', 'attr_reason', 'n', 'database_id', 'setting_id')) == 5) - -# now test csvFilePrefix -utils::write.csv( - x = target_settings, - file = file.path(tempFolder3, 'cccd_target_settings.csv') -) +target_attrition <- utils::read.csv(file.path(tempFolder3, 'c_target_attrition.csv')) +testthat::expect_true(sum(target_attrition$n_people < 50 & target_attrition$n_people != -50) == 0) +testthat::expect_true(sum(colnames(target_attrition) %in% c('characterization_cohort_id','attr_order', 'attr_reason', 'n_people','n_events', 'database_id', 'setting_id')) == 7) + -utils::write.csv( - x = case_settings, - file = file.path(tempFolder3, 'cccd_case_settings.csv') -) exportAttrition( executionPath = tempFolder3, outputFolder = tempFolder3, csvFilePrefix = 'cccd_', minCellCount = 12 ) -attrition <- utils::read.csv(file.path(tempFolder3, 'cccd_attrition.csv')) -testthat::expect_true(sum(attrition$n < 12 & attrition$n != -12) == 0) -testthat::expect_true(sum(colnames(attrition) %in% c('cohort_definition_id', 'attr_reason', 'n', 'database_id', 'setting_id')) == 5) +target_attrition <- utils::read.csv(file.path(tempFolder3, 'cccd_target_attrition.csv')) +testthat::expect_true(sum(target_attrition$n_people < 12 & target_attrition$n_people != -12) == 0) +testthat::expect_true(sum(colnames(target_attrition) %in% c('characterization_cohort_id','attr_order', 'attr_reason', 'n_people','n_events', 'database_id', 'setting_id')) == 7) -# test when no case_settings -utils::write.csv( - x = target_settings, - file = file.path(tempFolder3, 'c2_target_settings.csv') -) -return <- exportAttrition( - executionPath = tempFolder3, - outputFolder = tempFolder3, - csvFilePrefix = 'c2_', - minCellCount = 12 -) -attrition <- utils::read.csv(file.path(tempFolder3, 'c2_attrition.csv')) -testthat::expect_true(sum(attrition$n < 12 & attrition$n != -12) == 0) -testthat::expect_true(sum(colnames(attrition) %in% c('cohort_definition_id', 'attr_reason', 'n', 'database_id', 'setting_id')) == 5) -testthat::expect_true(nrow(attrition) == 4) +# TODO test case_attrition -# test no target or case settings -return <- exportAttrition( - executionPath = tempFolder3, - outputFolder = tempFolder3, - csvFilePrefix = 'c3_', - minCellCount = 12 -) -testthat::expect_false(return) -testthat::expect_true(!file.exists(file.path(tempFolder3, 'c3_attrition.csv'))) }) diff --git a/tests/testthat/test-RiskFactor.R b/tests/testthat/test-RiskFactor.R index fb90ae8..f851bab 100644 --- a/tests/testthat/test-RiskFactor.R +++ b/tests/testthat/test-RiskFactor.R @@ -19,10 +19,12 @@ test_that("createRiskFactorSettings", { ) res <- createRiskFactorSettings( - targetIds = targetIds, + studyPopulationSettings = createStudyPopulationSettings( + targetIds = targetIds, + limitToFirstInNDays = 9, + minPriorObservation = 10 + ), outcomeIds = outcomeIds, - limitToFirstInNDays = 9, - minPriorObservation = 10, outcomeWashoutDays = 365, riskWindowStart = 1, startAnchor = 'cohort start', @@ -32,7 +34,7 @@ test_that("createRiskFactorSettings", { ) testthat::expect_equal( - res$targetIds, + res$studyPopulationSettings$targetId, targetIds ) testthat::expect_equal( @@ -41,12 +43,12 @@ test_that("createRiskFactorSettings", { ) testthat::expect_equal( - res$minPriorObservation, + unique(res$studyPopulationSettings$minPriorObservation), 10 ) testthat::expect_equal( - res$limitToFirstInNDays, + unique(res$studyPopulationSettings$limitToFirstInNDays), 9 ) @@ -84,10 +86,12 @@ test_that("error when using temporal features - risk factors", { testthat::expect_error( res <- createRiskFactorSettings( - targetIds = targetIds, + studyPopulationSettings = createStudyPopulationSettings( + targetIds = targetIds, + limitToFirstInNDays = 9, + minPriorObservation = 10 + ), outcomeIds = outcomeIds, - limitToFirstInNDays = 9, - minPriorObservation = 10, outcomeWashoutDays = 365, riskWindowStart = 1, startAnchor = 'cohort start', @@ -104,10 +108,12 @@ test_that("error when using temporal features - risk factors", { testthat::expect_error( res <- createRiskFactorSettings( - targetIds = targetIds, + studyPopulationSettings = createStudyPopulationSettings( + targetIds = targetIds, + limitToFirstInNDays = 9, + minPriorObservation = 10 + ), outcomeIds = outcomeIds, - limitToFirstInNDays = 9, - minPriorObservation = 10, outcomeWashoutDays = 365, riskWindowStart = 1, startAnchor = 'cohort start', @@ -132,10 +138,12 @@ test_that("createRiskFactorSettings covariateList", { covariateSettings <- list(covariateSettings1, covariateSettings2) res <- createRiskFactorSettings( - targetIds = targetIds, + studyPopulationSettings = createStudyPopulationSettings( + targetIds = targetIds, + limitToFirstInNDays = 9, + minPriorObservation = 10 + ), outcomeIds = outcomeIds, - limitToFirstInNDays = 9, - minPriorObservation = 10, outcomeWashoutDays = 365, riskWindowStart = 1, startAnchor = 'cohort start', @@ -145,7 +153,7 @@ test_that("createRiskFactorSettings covariateList", { ) testthat::expect_equal( - res$targetIds, + res$studyPopulationSettings$targetId, targetIds ) testthat::expect_equal( @@ -168,10 +176,12 @@ test_that("getRiskFactorJobs", { limitToFirstInNDays <- sample(300, 1) res <- createRiskFactorSettings( - targetIds = targetIds, + studyPopulationSettings = createStudyPopulationSettings( + targetIds = targetIds, + minPriorObservation = minPriorObservation, + limitToFirstInNDays = limitToFirstInNDays + ), outcomeIds = outcomeIds, - minPriorObservation = minPriorObservation, - limitToFirstInNDays = limitToFirstInNDays, outcomeWashoutDays = 365, riskWindowStart = 1, startAnchor = 'cohort start', @@ -215,18 +225,28 @@ test_that("getRiskFactorJobs", { testthat::expect_true(nrow(jobDf) == 2) # now check nTargetJobs = 3 + charSettings <- createCharacterizationSettings( + riskFactorSettings = res + ) jobDf <- getRiskFactorJobs( - characterizationSettings = createCharacterizationSettings( - riskFactorSettings = res - ), + characterizationSettings = charSettings, nTargetJobs = 3 ) testthat::expect_true(nrow(jobDf) == 3) # check the target ids - testthat::expect_true(ParallelLogger::convertJsonToSettings(jobDf$settings[1])$targetIds == targetIds[1]) - testthat::expect_true(ParallelLogger::convertJsonToSettings(jobDf$settings[2])$targetIds == targetIds[2]) - testthat::expect_true(ParallelLogger::convertJsonToSettings(jobDf$settings[3])$targetIds == targetIds[3]) + tId1 <- charSettings$characterizationTargetLookup$characterizationTargetId[ + charSettings$characterizationTargetLookup$targetId == res$studyPopulationSettings$targetId[1] + ] + testthat::expect_true(ParallelLogger::convertJsonToSettings(jobDf$settings[1])$characterizationTargetIds == tId1) + tId2 <- charSettings$characterizationTargetLookup$characterizationTargetId[ + charSettings$characterizationTargetLookup$targetId == res$studyPopulationSettings$targetId[2] + ] + testthat::expect_true(ParallelLogger::convertJsonToSettings(jobDf$settings[2])$characterizationTargetIds == tId2) + tId3 <- charSettings$characterizationTargetLookup$characterizationTargetId[ + charSettings$characterizationTargetLookup$targetId == res$studyPopulationSettings$targetId[3] + ] + testthat::expect_true(ParallelLogger::convertJsonToSettings(jobDf$settings[3])$characterizationTargetIds == tId3) # now check nTargetJobs = 4 jobDf <- getRiskFactorJobs( @@ -249,6 +269,8 @@ test_that("getRiskFactorJobs", { }) test_that("computeRiskFactorAnalyses", { + skipIfCreateTargetCohortSqlUnavailable() + targetIds <- c(1, 2, 4) outcomeIds <- c(3) covariateSettings <- FeatureExtraction::createCovariateSettings( @@ -258,10 +280,12 @@ test_that("computeRiskFactorAnalyses", { ) res <- createRiskFactorSettings( - targetIds = targetIds, + studyPopulationSettings = createStudyPopulationSettings( + targetIds = targetIds, + limitToFirstInNDays = 365, + minPriorObservation = 30 + ), outcomeIds = outcomeIds, - limitToFirstInNDays = 365, - minPriorObservation = 30, outcomeWashoutDays = 365, riskWindowStart = 1, startAnchor = 'cohort start', @@ -312,6 +336,8 @@ test_that("computeRiskFactorAnalyses", { characterizationTable = tables$characterizationTable, # contains char cohorts targetSettingsTable = tables$targetSettingsTable, # contains map between settings and char cohort id caseSettingsTable = tables$caseSettingsTable, + caseCountTable = , tables$caseCountTable, + minCaseSize = 0, tempEmulationSchema = 'main', settings = ParallelLogger::convertJsonToSettings(jobDf$settings[1]), databaseId = "madeup", diff --git a/tests/testthat/test-StudyPopulation.R b/tests/testthat/test-StudyPopulation.R new file mode 100644 index 0000000..2fbb69f --- /dev/null +++ b/tests/testthat/test-StudyPopulation.R @@ -0,0 +1,53 @@ + +test_that("replaceNull", { + + testthat::expect_equal(replaceNull(0,545),0) + testthat::expect_equal(replaceNull(NULL,545),545) + + testthat::expect_equal(replaceNull('0','545'),'0') + testthat::expect_equal(replaceNull(NULL,'545'),'545') + +}) + +test_that("createStudyPopulationSettings", { + + set <- createStudyPopulationSettings(targetIds = c(232,23)) + testthat::expect_true(nrow(set) == 2) + + set <- createStudyPopulationSettings(targetIds = c(232,23,232)) + testthat::expect_true(nrow(set) == 2) + + set <- createStudyPopulationSettings(targetIds = 232, + nestingCohortId = 12) + testthat::expect_true(nrow(set) == 1) + testthat::expect_true(set$targetId == 232) + testthat::expect_true(set$nestingCohortId == 12) + + set <- createStudyPopulationSettings(targetIds = 232, minAge = 18) + testthat::expect_true(nrow(set) == 1) + testthat::expect_true(set$targetId == 232) + testthat::expect_true(set$minAge == 18) + + set <- createStudyPopulationSettings(targetIds = 23, minAge = 18, + genderConceptIds = c(32434,1212)) + testthat::expect_true(nrow(set) == 1) + testthat::expect_true(set$targetId == 23) + testthat::expect_true(set$minAge == 18) + testthat::expect_true(set$genderConceptIds == '1212,32434') + + +}) + +test_that("combineStudyPopulationSettings", { + set <- list( + createStudyPopulationSettings(targetIds = c(232,23,232)), + createStudyPopulationSettings(targetIds = 232, + nestingCohortId = 12), + createStudyPopulationSettings(targetIds = 232, minAge = 18), + createStudyPopulationSettings(targetIds = 23, minAge = 18, genderConceptIds = c(32434,1212)) + ) + + res <- combineStudyPopulationSettings(set) + testthat::expect_true(nrow(res) == 5) + testthat::expect_true('targetId' %in% colnames(res)) +}) diff --git a/tests/testthat/test-dbs.R b/tests/testthat/test-dbs.R index 0444539..1f6b879 100644 --- a/tests/testthat/test-dbs.R +++ b/tests/testthat/test-dbs.R @@ -181,38 +181,42 @@ for (dbmsPlatform in dbmsPlatforms) { targetIds <- c(1, 2, 4) outcomeIds <- c(3) + studyPop1 <- createStudyPopulationSettings(targetIds = 1) + studyPop2 <- createStudyPopulationSettings(targetIds = 2) + studyPopAll <- createStudyPopulationSettings(targetIds = targetIds) + timeToEventSettings1 <- createTimeToEventSettings( - targetIds = 1, + studyPopulationSettings = studyPop1, outcomeIds = c(3, 4) ) timeToEventSettings2 <- createTimeToEventSettings( - targetIds = 2, + studyPopulationSettings = studyPop2, outcomeIds = c(3, 4) ) dechallengeRechallengeSettings <- createDechallengeRechallengeSettings( - targetIds = targetIds, + studyPopulationSettings = studyPopAll, outcomeIds = outcomeIds, dechallengeStopInterval = 30, dechallengeEvaluationWindow = 31 ) targetBaselineSettings1 <- createTargetBaselineSettings( - targetIds = targetIds, + studyPopulationSettings = studyPopAll, covariateSettings = FeatureExtraction::createCovariateSettings( useDemographicsGender = TRUE, useDemographicsAge = TRUE ) ) targetBaselineSettings2 <- createTargetBaselineSettings( - targetIds = targetIds, + studyPopulationSettings = studyPopAll, covariateSettings = FeatureExtraction::createCovariateSettings( useConditionOccurrenceLongTerm = TRUE ) ) riskFactorSettings <- createRiskFactorSettings( - targetIds = targetIds, + studyPopulationSettings = studyPopAll, outcomeIds = outcomeIds, riskWindowStart = 1, startAnchor = "cohort start", @@ -224,7 +228,7 @@ for (dbmsPlatform in dbmsPlatforms) { ) caseSeriesSettings <- createCaseSeriesSettings( - targetIds = targetIds, + studyPopulationSettings = studyPopAll, outcomeIds = outcomeIds, riskWindowStart = 1, startAnchor = "cohort start", @@ -258,6 +262,8 @@ for (dbmsPlatform in dbmsPlatforms) { targetTable = dbmsDetails$cohortTable, outcomeDatabaseSchema = dbmsDetails$cohortDatabaseSchema, outcomeTable = dbmsDetails$cohortTable, + nestingCohortTable = dbmsDetails$cohortTable, + nestingCohortDatabaseSchema = dbmsDetails$cohortDatabaseSchema, characterizationSettings = characterizationSettings, outputDirectory = file.path(tempFolder, "csv"), outputDatabaseSchema = dbmsDetails$cohortDatabaseSchema, diff --git a/tests/testthat/test-dechallengeRechallenge.R b/tests/testthat/test-dechallengeRechallenge.R index 093bca6..5110bec 100644 --- a/tests/testthat/test-dechallengeRechallenge.R +++ b/tests/testthat/test-dechallengeRechallenge.R @@ -15,7 +15,11 @@ test_that("createDechallengeRechallengeSettings", { outcomeIds <- sample(x = 100, size = sample(10, 1)) res <- createDechallengeRechallengeSettings( - targetIds = targetIds, + studyPopulationSettings = createStudyPopulationSettings( + targetIds = targetIds, + limitToFirstInNDays = 0, + minPriorObservation = 0 + ), outcomeIds = outcomeIds, dechallengeStopInterval = 30, dechallengeEvaluationWindow = 31 @@ -26,12 +30,12 @@ test_that("createDechallengeRechallengeSettings", { ) testthat::expect_equal( - res$targetCohortDefinitionIds, + res$studyPopulationSettings$targetId, targetIds ) testthat::expect_equal( - res$outcomeCohortDefinitionIds, + res$outcomeIds, outcomeIds ) @@ -47,22 +51,62 @@ test_that("createDechallengeRechallengeSettings", { }) test_that("computeDechallengeRechallengeAnalyses", { + skipIfCreateTargetCohortSqlUnavailable() + targetIds <- c(2) outcomeIds <- c(3, 4) - res <- createDechallengeRechallengeSettings( - targetIds = targetIds, + drSet <- createDechallengeRechallengeSettings( + studyPopulationSettings = createStudyPopulationSettings( + targetIds = targetIds, + limitToFirstInNDays = 0, + minPriorObservation = 0 + ), outcomeIds = outcomeIds, dechallengeStopInterval = 30, dechallengeEvaluationWindow = 30 ) + charSet <- createCharacterizationSettings( + dechallengeRechallengeSettings = drSet + ) + + jobDf <- getDechallengeRechallengeJobs( + characterizationSettings = charSet, + nTargetJobs = 1 + ) + dcLoc <- tempfile("runADechal") - dc <- computeDechallengeRechallengeAnalyses( + tables <- generateCohorts( + characterizationSettings = charSet, + mode = 'PatientLevelPrediction', + incremental = FALSE, + executionPath = dcLoc, connectionDetails = connectionDetails, targetDatabaseSchema = "main", targetTable = "cohort", - settings = res, + outcomeDatabaseSchema = "main", + outcomeTable = "cohort", + outputDatabaseSchema = 'main', + outputTable = 'char_cohort', + cdmDatabaseSchema = "main", + tempEmulationSchema = "main", + progressBar = FALSE, + settingHash = 'set1', + dbHash = 'db1' + ) + + # make the cohorts in a table + + dc <- computeDechallengeRechallengeAnalyses( + connectionDetails = connectionDetails, + #targetDatabaseSchema = "main", + #targetTable = "cohort", + outcomeDatabaseSchema = "main", + outcomeTable = "cohort", + characterizationDatabaseSchema = "main", + characterizationTable = tables$characterizationTable, + settings = charSet$dechallengeRechallengeSettings[[1]], databaseId = "testing", outputFolder = dcLoc ) @@ -122,21 +166,84 @@ test_that("computeDechallengeRechallengeAnalyses", { camelCaseToSnakeCase = FALSE ) + DatabaseConnector::insertTable( + data = data.frame( + person_id = 1:4, + observation_period_start_date = rep(as.Date('1900-01-01'), 4), + observation_period_end_date = rep(as.Date('2100-01-01'), 4) + ), + connection = con, + databaseSchema = "main", + tableName = "observation_period", + createTable = TRUE, + dropTableIfExists = TRUE, + camelCaseToSnakeCase = FALSE + ) + + DatabaseConnector::insertTable( + data = data.frame( + person_id = 1:4, + year_of_birth = rep(1980, 4), + gender_concept_id = rep(0, 4) + ), + connection = con, + databaseSchema = "main", + tableName = "person", + createTable = TRUE, + dropTableIfExists = TRUE, + camelCaseToSnakeCase = FALSE + ) + DatabaseConnector::disconnect(con) - res <- createDechallengeRechallengeSettings( - targetIds = 1, + drSet <- createDechallengeRechallengeSettings( + studyPopulationSettings = createStudyPopulationSettings( + targetIds = 1 + ), outcomeIds = 2, dechallengeStopInterval = 30, dechallengeEvaluationWindow = 30 ) + charSet <- createCharacterizationSettings( + dechallengeRechallengeSettings = drSet + ) + + jobDf <- getDechallengeRechallengeJobs( + characterizationSettings = charSet, + nTargetJobs = 1 + ) + dcLoc <- tempfile("runADechal2") - dc <- computeDechallengeRechallengeAnalyses( + + tables <- generateCohorts( + characterizationSettings = charSet, + mode = 'PatientLevelPrediction', + incremental = FALSE, + executionPath = dcLoc, connectionDetails = connectionDetailsReal, targetDatabaseSchema = "main", targetTable = "cohort_dechal", - settings = res, + outcomeDatabaseSchema = "main", + outcomeTable = "cohort_dechal", + outputDatabaseSchema = 'main', + outputTable = 'char_cohort', + cdmDatabaseSchema = "main", + tempEmulationSchema = "main", + progressBar = FALSE, + settingHash = 'set1', + dbHash = 'db1' + ) + + dc <- computeDechallengeRechallengeAnalyses( + connectionDetails = connectionDetailsReal, + #targetDatabaseSchema = "main", + #targetTable = "cohort_dechal", + outcomeDatabaseSchema = "main", + outcomeTable = "cohort_dechal", + characterizationDatabaseSchema = "main", + characterizationTable = tables$characterizationTable, + settings = charSet$dechallengeRechallengeSettings[[1]], databaseId = "testing", outputFolder = dcLoc ) @@ -154,6 +261,8 @@ test_that("computeDechallengeRechallengeAnalyses", { }) test_that("computeRechallengeFailCaseSeriesAnalyses with known data", { + skipIfCreateTargetCohortSqlUnavailable() + # check with made up date # subject 1 has 1 exposure for 30 days # subject 2 has 4 exposures for ~30 days with ~30 day gaps @@ -206,23 +315,84 @@ test_that("computeRechallengeFailCaseSeriesAnalyses with known data", { dropTableIfExists = TRUE, camelCaseToSnakeCase = FALSE ) + DatabaseConnector::insertTable( + data = data.frame( + person_id = 1:4, + observation_period_start_date = rep(as.Date('1900-01-01'), 4), + observation_period_end_date = rep(as.Date('2100-01-01'), 4) + ), + connection = con, + databaseSchema = "main", + tableName = "observation_period", + createTable = TRUE, + dropTableIfExists = TRUE, + camelCaseToSnakeCase = FALSE + ) + + DatabaseConnector::insertTable( + data = data.frame( + person_id = 1:4, + year_of_birth = rep(1980, 4), + gender_concept_id = rep(0, 4) + ), + connection = con, + databaseSchema = "main", + tableName = "person", + createTable = TRUE, + dropTableIfExists = TRUE, + camelCaseToSnakeCase = FALSE + ) DatabaseConnector::disconnect(con) - set <- createDechallengeRechallengeSettings( - targetIds = 1, + drSet <- createDechallengeRechallengeSettings( + studyPopulationSettings = createStudyPopulationSettings( + targetIds = 1 + ), outcomeIds = 2, dechallengeStopInterval = 30, dechallengeEvaluationWindow = 30 # 31 ) + charSet <- createCharacterizationSettings( + dechallengeRechallengeSettings = drSet + ) + + + jobDf <- getDechallengeRechallengeJobs( + characterizationSettings = charSet, + nTargetJobs = 1 + ) dcLoc <- tempfile("runADechal2") + + tables <- generateCohorts( + characterizationSettings = charSet, + mode = 'PatientLevelPrediction', + incremental = FALSE, + executionPath = dcLoc, + connectionDetails = connectionDetailsReal, + targetDatabaseSchema = "main", + targetTable = "cohort", + outcomeDatabaseSchema = "main", + outcomeTable = "cohort", + outputDatabaseSchema = 'main', + outputTable = 'char_cohort', + cdmDatabaseSchema = "main", + tempEmulationSchema = "main", + progressBar = FALSE, + settingHash = 'set1', + dbHash = 'db1' + ) + dc <- computeRechallengeFailCaseSeriesAnalyses( connectionDetails = connectionDetailsReal, targetDatabaseSchema = "main", targetTable = "cohort", - settings = set, + targetSettingsTable = tables$targetSettingsTable, + settings = charSet$dechallengeRechallengeSettings[[1]], outcomeDatabaseSchema = "main", outcomeTable = "cohort", + characterizationDatabaseSchema = "main", + characterizationTable = tables$characterizationTable, databaseId = "testing", outputFolder = dcLoc ) @@ -240,7 +410,10 @@ test_that("computeRechallengeFailCaseSeriesAnalyses with known data", { connectionDetails = connectionDetailsReal, targetDatabaseSchema = "main", targetTable = "cohort", - settings = set, + targetSettingsTable = tables$targetSettingsTable, + characterizationDatabaseSchema = "main", + characterizationTable = tables$characterizationTable, + settings = charSet$dechallengeRechallengeSettings[[1]], outcomeDatabaseSchema = "main", outcomeTable = "cohort", databaseId = "testing", @@ -262,20 +435,24 @@ test_that("computeRechallengeFailCaseSeriesAnalyses with known data", { # add test for job creation code -test_that("computeDechallengeRechallengeAnalyses", { +test_that("getDechallengeRechallengeJobs", { targetIds <- c(2, 5, 6, 7, 8) outcomeIds <- c(3, 4, 9, 10) res <- createDechallengeRechallengeSettings( - targetIds = targetIds, + createStudyPopulationSettings( + targetIds = targetIds + ), outcomeIds = outcomeIds, dechallengeStopInterval = 30, dechallengeEvaluationWindow = 30 ) + charSettings <- createCharacterizationSettings( + dechallengeRechallengeSettings = res + ) + jobs <- getDechallengeRechallengeJobs( - characterizationSettings = createCharacterizationSettings( - dechallengeRechallengeSettings = res - ), + characterizationSettings = charSettings, nTargetJobs = 1 ) @@ -286,17 +463,22 @@ test_that("computeDechallengeRechallengeAnalyses", { targetIdFromSettings <- do.call( what = unique, args = lapply(1:nrow(jobs), function(i) { - ParallelLogger::convertJsonToSettings(jobs$settings[i])$targetCohortDefinitionIds + ParallelLogger::convertJsonToSettings(jobs$settings[i])$characterizationTargetIds }) ) - testthat::expect_true(sum(targetIds %in% targetIdFromSettings) == + + originalTs <- charSettings$characterizationTargetLookup$targetId[ + charSettings$characterizationTargetLookup$characterizationTargetId %in% targetIdFromSettings + ] + + testthat::expect_true(sum(targetIds %in% originalTs) == length(targetIds)) # check all outcome ids are in there outcomeIdFromSettings <- do.call( what = unique, args = lapply(1:nrow(jobs), function(i) { - ParallelLogger::convertJsonToSettings(jobs$settings[i])$outcomeCohortDefinitionIds + ParallelLogger::convertJsonToSettings(jobs$settings[i])$outcomeIds }) ) testthat::expect_true(sum(outcomeIds %in% outcomeIdFromSettings) == @@ -305,9 +487,7 @@ test_that("computeDechallengeRechallengeAnalyses", { # checking more threads 3 jobs <- getDechallengeRechallengeJobs( - characterizationSettings = createCharacterizationSettings( - dechallengeRechallengeSettings = res - ), + characterizationSettings = charSettings, nTargetJobs = 3 ) @@ -318,17 +498,22 @@ test_that("computeDechallengeRechallengeAnalyses", { targetIdFromSettings <- do.call( what = c, args = lapply(1:nrow(jobs), function(i) { - ParallelLogger::convertJsonToSettings(jobs$settings[i])$targetCohortDefinitionIds + ParallelLogger::convertJsonToSettings(jobs$settings[i])$characterizationTargetIds }) ) - testthat::expect_true(sum(targetIds %in% targetIdFromSettings) == + + originalTs <- charSettings$characterizationTargetLookup$targetId[ + charSettings$characterizationTargetLookup$characterizationTargetId %in% targetIdFromSettings + ] + + testthat::expect_true(sum(targetIds %in% originalTs) == length(targetIds)) # check all outcome ids are in there outcomeIdFromSettings <- do.call( what = c, args = lapply(1:nrow(jobs), function(i) { - ParallelLogger::convertJsonToSettings(jobs$settings[i])$outcomeCohortDefinitionIds + ParallelLogger::convertJsonToSettings(jobs$settings[i])$outcomeIds }) ) testthat::expect_true(sum(outcomeIds %in% outcomeIdFromSettings) == @@ -338,9 +523,7 @@ test_that("computeDechallengeRechallengeAnalyses", { # checking more threads than needed 20 jobs <- getDechallengeRechallengeJobs( - characterizationSettings = createCharacterizationSettings( - dechallengeRechallengeSettings = res - ), + characterizationSettings = charSettings, nTargetJobs = 20 ) @@ -351,17 +534,20 @@ test_that("computeDechallengeRechallengeAnalyses", { targetIdFromSettings <- do.call( what = c, args = lapply(1:nrow(jobs), function(i) { - ParallelLogger::convertJsonToSettings(jobs$settings[i])$targetCohortDefinitionIds + ParallelLogger::convertJsonToSettings(jobs$settings[i])$characterizationTargetIds }) ) - testthat::expect_true(sum(targetIds %in% targetIdFromSettings) == + originalTs <- charSettings$characterizationTargetLookup$targetId[ + charSettings$characterizationTargetLookup$characterizationTargetId %in% targetIdFromSettings + ] + testthat::expect_true(sum(targetIds %in% originalTs) == length(targetIds)) # check all outcome ids are in there outcomeIdFromSettings <- do.call( what = c, args = lapply(1:nrow(jobs), function(i) { - ParallelLogger::convertJsonToSettings(jobs$settings[i])$outcomeCohortDefinitionIds + ParallelLogger::convertJsonToSettings(jobs$settings[i])$outcomeIds }) ) testthat::expect_true(sum(outcomeIds %in% outcomeIdFromSettings) == diff --git a/tests/testthat/test-manualData.R b/tests/testthat/test-manualData.R index 4d3245b..508f5cd 100644 --- a/tests/testthat/test-manualData.R +++ b/tests/testthat/test-manualData.R @@ -1,12 +1,14 @@ context("manual data") manualData <- file.path(tempdir(), "manual.sqlite") -on.exit(file.remove(manualData), add = TRUE) +on.exit(unlink(manualData, force = TRUE), add = TRUE) manualData2 <- file.path(tempdir(), "manual2.sqlite") -on.exit(file.remove(manualData2), add = TRUE) +on.exit(unlink(manualData2, force = TRUE), add = TRUE) test_that("manual data runCharacterizationAnalyses", { + skipIfCreateTargetCohortSqlUnavailable() + # this test creates made-up OMOP CDM data # and runs runCharacterizationAnalyses on the data # to check whether the results are as expected @@ -147,19 +149,29 @@ test_that("manual data runCharacterizationAnalyses", { ) # create settings and run + manualStudyPopulation <- createStudyPopulationSettings( + targetIds = 1, + limitToFirstInNDays = 99999, + minPriorObservation = 365 + ) + + manualStudyPopulationDc <- createStudyPopulationSettings( + targetIds = 1, + limitToFirstInNDays = 0, + minPriorObservation = 0 + ) + characterizationSettings <- createCharacterizationSettings( timeToEventSettings = createTimeToEventSettings( - targetIds = 1, + studyPopulationSettings = manualStudyPopulation, outcomeIds = 2 ), dechallengeRechallengeSettings = createDechallengeRechallengeSettings( - targetIds = 1, + studyPopulationSettings = manualStudyPopulationDc, outcomeIds = 2 ), targetBaselineSettings = createTargetBaselineSettings( - targetIds = 1, - limitToFirstInNDays = 99999, - minPriorObservation = 365, + studyPopulationSettings = manualStudyPopulation, covariateSettings = FeatureExtraction::createCovariateSettings( useDemographicsAge = TRUE, useDemographicsGender = TRUE, @@ -168,10 +180,8 @@ test_that("manual data runCharacterizationAnalyses", { ), riskFactorSettings = createRiskFactorSettings( - targetIds = 1, + studyPopulationSettings = manualStudyPopulation, outcomeIds = 2, - limitToFirstInNDays = 99999, - minPriorObservation = 365, outcomeWashoutDays = 30, riskWindowStart = 1, riskWindowEnd = 90, @@ -183,10 +193,8 @@ test_that("manual data runCharacterizationAnalyses", { ), caseSeriesSettings = createCaseSeriesSettings( - targetIds = 1, + studyPopulationSettings = manualStudyPopulation, outcomeIds = 2, - limitToFirstInNDays = 99999, - minPriorObservation = 365, outcomeWashoutDays = 30, riskWindowStart = 1, riskWindowEnd = 90, @@ -195,12 +203,15 @@ test_that("manual data runCharacterizationAnalyses", { ) ) ) + runCharacterizationAnalyses( connectionDetails = connectionDetailsManual, targetDatabaseSchema = schema, targetTable = "cohort", outcomeDatabaseSchema = schema, outcomeTable = "cohort", + nestingCohortTable = "cohort", + nestingCohortDatabaseSchema = schema, cdmDatabaseSchema = schema, characterizationSettings = characterizationSettings, outputDirectory = file.path(tempdir(), "result"), @@ -239,8 +250,12 @@ test_that("manual data runCharacterizationAnalyses", { # TODO: check in code whether minCellCount < or <= dechal <- utils::read.csv(file.path(tempdir(), "result", "c_dechallenge_rechallenge.csv")) - testthat::expect_true(dechal$num_exposure_eras == 13) - testthat::expect_true(dechal$num_persons_exposed == 10) + + # person 1 not included since target exposure is outside obs + # so 13 exposures less 1 = 12 eras and 10 people less 1 is 9 people + testthat::expect_true(dechal$num_exposure_eras == 12) + testthat::expect_true(dechal$num_persons_exposed == 9) + testthat::expect_true(dechal$num_cases == 6) testthat::expect_true(dechal$dechallenge_attempt == 5) testthat::expect_true(dechal$dechallenge_success == 5) @@ -268,14 +283,14 @@ test_that("manual data runCharacterizationAnalyses", { # targetId = 1, limitToFirstInNDays = 99999,minPriorObservation = 365, tset <- utils::read.csv(file.path(tempdir(), "result", "c_target_settings.csv")) - testthat::expect_true(tset$target_id == 1) - testthat::expect_true(tset$limit_to_first_in_n_days == 99999) - testthat::expect_true(tset$min_prior_observation == 365) - testthat::expect_true(tset$characterization_target_id == tset$target_id*10) + testthat::expect_true(tset$target_id[2] == 1) + testthat::expect_true(tset$limit_to_first_in_n_days[2] == 99999) + testthat::expect_true(tset$min_prior_observation[2] == 365) + testthat::expect_true(tset$characterization_target_id[2] == 2*10) - attrition <- utils::read.csv(file.path(tempdir(), "result", "c_attrition.csv")) + attrition <- utils::read.csv(file.path(tempdir(), "result", "c_target_attrition.csv")) # there should be 9 people as the first subject has cohort date outside observation - testthat::expect_true(attrition$n[attrition$cohort_definition_id==10] == 9) + testthat::expect_true(max(attrition$n_people[attrition$characterization_target_id==10]) == 9) # useDemographicsAge = TRUE, useDemographicsGender = TRUE, useConditionEraAnyTimePrior = TRUE covs <- utils::read.csv(file.path(tempdir(), "result", "c_target_covariates.csv")) @@ -287,7 +302,7 @@ test_that("manual data runCharacterizationAnalyses", { # data is all female so make sure female cov has average_value of 1 testthat::expect_true(covs$average_value[covs$covariate_id == 8532001] == 1) - testthat::expect_true(covs$sum_value[covs$covariate_id == 8532001] == attrition$n[attrition$cohort_definition_id==10]) + testthat::expect_true(covs$sum_value[covs$covariate_id == 8532001] == max(attrition$n_people[attrition$characterization_target_id==10])) covs_cont <- utils::read.csv(file.path(tempdir(), "result", "c_target_covariates_continuous.csv")) testthat::expect_true(1002 %in% covs_cont$covariate_id) diff --git a/tests/testthat/test-runCharacterization.R b/tests/testthat/test-runCharacterization.R index b1792e1..fb27845 100644 --- a/tests/testthat/test-runCharacterization.R +++ b/tests/testthat/test-runCharacterization.R @@ -8,30 +8,40 @@ test_that("runCharacterizationAnalyses", { outcomeIds <- c(3) timeToEventSettings1 <- createTimeToEventSettings( - targetIds = 1, + studyPopulationSettings = createStudyPopulationSettings( + targetIds = 1 + ), outcomeIds = c(3, 4) ) timeToEventSettings2 <- createTimeToEventSettings( - targetIds = 2, + studyPopulationSettings = createStudyPopulationSettings( + targetIds = 2 + ), outcomeIds = c(3, 4) ) dechallengeRechallengeSettings <- createDechallengeRechallengeSettings( - targetIds = targetIds, + studyPopulationSettings = createStudyPopulationSettings( + targetIds = targetIds + ), outcomeIds = outcomeIds, dechallengeStopInterval = 30, dechallengeEvaluationWindow = 31 ) targetBaselineSettings1 <- createTargetBaselineSettings( - targetIds = targetIds, + studyPopulationSettings = createStudyPopulationSettings( + targetIds = targetIds + ), covariateSettings = FeatureExtraction::createCovariateSettings( useDemographicsGender = TRUE ) ) targetBaselineSettings2 <- createTargetBaselineSettings( - targetIds = targetIds, + studyPopulationSettings = createStudyPopulationSettings( + targetIds = targetIds + ), covariateSettings = FeatureExtraction::createCovariateSettings( useDemographicsAge = TRUE, useDemographicsRace = TRUE @@ -39,7 +49,9 @@ test_that("runCharacterizationAnalyses", { ) riskFactorSettings <- createRiskFactorSettings( - targetIds = targetIds, + studyPopulationSettings = createStudyPopulationSettings( + targetIds = targetIds + ), outcomeIds = outcomeIds, riskWindowStart = 1, startAnchor = "cohort start", @@ -53,7 +65,9 @@ test_that("runCharacterizationAnalyses", { ) caseSeriesSettings <- createCaseSeriesSettings( - targetIds = targetIds, + studyPopulationSettings = createStudyPopulationSettings( + targetIds = targetIds + ), outcomeIds = outcomeIds, riskWindowStart = 1, startAnchor = "cohort start", @@ -88,9 +102,23 @@ test_that("runCharacterizationAnalyses", { testthat::expect_true( length(characterizationSettings$timeToEventSettings) == 2 ) + testthat::expect_true( + length(characterizationSettings$timeToEventSettings[[1]]$characterizationTargetIds) == 1 + ) + testthat::expect_true( + is.null(characterizationSettings$timeToEventSettings[[1]]$studyPopulationSettings) + ) + testthat::expect_true( length(characterizationSettings$dechallengeRechallengeSettings) == 1 ) + testthat::expect_true( + length(characterizationSettings$dechallengeRechallengeSettings[[1]]$characterizationTargetIds) == 3 + ) + testthat::expect_true( + is.null(characterizationSettings$dechallengeRechallengeSettings[[1]]$studyPopulationSettings) + ) + testthat::expect_true( length(characterizationSettings$targetBaselineSettings) == 2 ) @@ -101,39 +129,11 @@ test_that("runCharacterizationAnalyses", { length(characterizationSettings$caseSeriesSettings) == 1 ) - tempFile <- tempfile(fileext = ".json") - on.exit(unlink(tempFile)) - saveLoc <- saveCharacterizationSettings( - settings = characterizationSettings, - fileName = tempFile - ) - - testthat::expect_true(file.exists(tempFile)) - - loadedSettings <- loadCharacterizationSettings( - fileName = tempFile - ) - - # In R, empty arrays are automatically of type 'logical.' When loading JSON - # they are currently automatically of type 'list'. Neither is right or wrong, - # so ignoring distinction: - convertEmptyListToEmptyLogical <- function(object) { - if (is.list(object)) { - if (length(object) == 0) { - return(vector(mode = "logical", length = 0)) - } else { - return(lapply(object, convertEmptyListToEmptyLogical)) - } - } else { - return(object) - } - } - testthat::expect_equivalent(characterizationSettings, convertEmptyListToEmptyLogical(loadedSettings)) + skipIfCreateTargetCohortSqlUnavailable() tempFolder <- tempfile("Characterization") on.exit(unlink(tempFolder, recursive = TRUE), add = TRUE) - runCharacterizationAnalyses( connectionDetails = connectionDetails, cdmDatabaseSchema = "main", @@ -141,6 +141,8 @@ test_that("runCharacterizationAnalyses", { targetTable = "cohort", outcomeDatabaseSchema = "main", outcomeTable = "cohort", + nestingCohortDatabaseSchema = 'main', + nestingCohortTable = "cohort", characterizationSettings = characterizationSettings, outputDatabaseSchema = 'main', @@ -209,18 +211,26 @@ test_that("runCharacterizationAnalyses", { file = file.path(tempFolder, "result", "c_time_to_event.csv"), show_col_types = FALSE ) + + charTids <- characterizationSettings$characterizationTargetLookup$characterizationTargetId[ + characterizationSettings$characterizationTargetLookup$targetId %in% c(1, 2) + ] + + testthat::expect_equivalent( - unique(tte$target_cohort_definition_id), - c(1, 2) + unique(tte$characterization_target_id), + unique(charTids) ) }) manualDataMin <- file.path(tempdir(), "manual_min.sqlite") -on.exit(file.remove(manualDataMin), add = TRUE) +on.exit(unlink(manualDataMin, force = TRUE), add = TRUE) test_that("min cell count works", { + skipIfCreateTargetCohortSqlUnavailable() + tempFolder <- tempfile("CharacterizationMin") on.exit(unlink(tempFolder, recursive = TRUE), add = TRUE) @@ -258,12 +268,10 @@ test_that("min cell count works", { obs_period <- data.frame( observation_period_id = 1:10, person_id = 1:10, - observation_period_start_date = rep("2000-12-31", 10), - observation_period_end_date = c("2000-12-31", rep("2020-12-31", 9)), + observation_period_start_date = rep(as.Date("2000-12-31"), 10), + observation_period_end_date = c(as.Date("2000-12-31"), rep(as.Date("2020-12-31"), 9)), period_type_concept_id = rep(1, 10) ) - obs_period$observation_period_start_date <- as.Date(obs_period$observation_period_start_date) - obs_period$observation_period_end_date <- as.Date(obs_period$observation_period_end_date) DatabaseConnector::insertTable( connection = con, databaseSchema = schema, @@ -361,18 +369,22 @@ test_that("min cell count works", { ) # create settings and run + minCellStudyPopulation <- createStudyPopulationSettings( + targetIds = 1, + minPriorObservation = 365 + ) + characterizationSettings <- createCharacterizationSettings( timeToEventSettings = createTimeToEventSettings( - targetIds = 1, + studyPopulationSettings = minCellStudyPopulation, outcomeIds = 2 ), dechallengeRechallengeSettings = createDechallengeRechallengeSettings( - targetIds = 1, + studyPopulationSettings = minCellStudyPopulation, outcomeIds = 2 ), targetBaselineSettings = createTargetBaselineSettings( - targetIds = 1, - minPriorObservation = 365, + studyPopulationSettings = minCellStudyPopulation, covariateSettings = FeatureExtraction::createCovariateSettings( useDemographicsAge = TRUE, useDemographicsGender = TRUE, @@ -388,6 +400,8 @@ test_that("min cell count works", { targetTable = "cohort", outcomeDatabaseSchema = "main", outcomeTable = "cohort", + nestingCohortDatabaseSchema = 'main', + nestingCohortTable = "cohort", characterizationSettings = characterizationSettings, outputDirectory = file.path(tempFolder, "result_mincell"), executionPath = file.path(tempFolder, "execution_mincell"), diff --git a/tests/testthat/test-targetAnalysis.R b/tests/testthat/test-targetAnalysis.R index fd0cfe8..85dd29e 100644 --- a/tests/testthat/test-targetAnalysis.R +++ b/tests/testthat/test-targetAnalysis.R @@ -16,15 +16,17 @@ test_that("createTargetBaselineSettings", { ) res <- createTargetBaselineSettings( - targetIds = targetIds, - limitToFirstInNDays = 9, - minPriorObservation = 10, + studyPopulationSettings = createStudyPopulationSettings( + targetIds = targetIds, + limitToFirstInNDays = 9, + minPriorObservation = 10, + ), covariateSettings = covariateSettings ) testthat::expect_equal( - res$targetIds, - targetIds + unique(res$studyPopulationSettings$targetId), + unique(targetIds) ) testthat::expect_equal( res$covariateSettings[[1]], @@ -32,12 +34,12 @@ test_that("createTargetBaselineSettings", { ) testthat::expect_equal( - res$minPriorObservation, + unique(res$studyPopulationSettings$minPriorObservation), 10 ) testthat::expect_equal( - res$limitToFirstInNDays, + unique(res$studyPopulationSettings$limitToFirstInNDays), 9 ) @@ -49,9 +51,11 @@ test_that("error when using temporal features", { testthat::expect_error( createTargetBaselineSettings( - targetIds = targetIds, - limitToFirstInNDays = 9, - minPriorObservation = 10, + studyPopulationSettings = createStudyPopulationSettings( + targetIds = targetIds, + limitToFirstInNDays = 9, + minPriorObservation = 10, + ), covariateSettings = temporalCovariateSettings ) ) @@ -63,9 +67,11 @@ test_that("error when using temporal features", { testthat::expect_error( createTargetBaselineSettings( - targetIds = targetIds, - limitToFirstInNDays = 9, - minPriorObservation = 10, + studyPopulationSettings = createStudyPopulationSettings( + targetIds = targetIds, + limitToFirstInNDays = 9, + minPriorObservation = 10, + ), covariateSettings = temporalCovariateSettings ) ) @@ -84,13 +90,15 @@ test_that("createTargetBaselineSettings covariateList", { covariateSettings <- list(covariateSettings1, covariateSettings2) res <- createTargetBaselineSettings( - targetIds = targetIds, + studyPopulationSettings = createStudyPopulationSettings( + targetIds = targetIds + ), covariateSettings = covariateSettings ) testthat::expect_equal( - res$targetIds, - targetIds + unique(res$studyPopulationSettings$targetId), + unique(targetIds) ) testthat::expect_equal( res$covariateSettings, @@ -110,10 +118,14 @@ test_that("getTargetBaselineJobs", { minPriorObservation <- sample(30, 1) limitToFirstInNDays <- sample(300, 1) - res <- createTargetBaselineSettings( + studyPop <- createStudyPopulationSettings( targetIds = targetIds, minPriorObservation = minPriorObservation, - limitToFirstInNDays = limitToFirstInNDays, + limitToFirstInNDays = limitToFirstInNDays + ) + + res <- createTargetBaselineSettings( + studyPopulationSettings = studyPop, covariateSettings = covariateSettings ) @@ -130,7 +142,7 @@ test_that("getTargetBaselineJobs", { testthat::expect_true(nrow(jobDf) == 1) testthat::expect_true( - paste(c("t_1", minPriorObservation,limitToFirstInNDays), collapse ='_') %in% jobDf$executionFolder + paste("t_1", collapse ='_') %in% jobDf$executionFolder ) settings <- ParallelLogger::convertJsonToSettings(jobDf$settings[1]) @@ -157,25 +169,35 @@ test_that("getTargetBaselineJobs", { testthat::expect_true( sum(c( - paste0(c("t_1", minPriorObservation,limitToFirstInNDays), collapse = '_'), - paste0(c("t_2", minPriorObservation,limitToFirstInNDays), collapse = '_') + paste0("t_1", collapse = '_'), + paste0("t_2", collapse = '_') ) %in% jobDf$executionFolder) == 2 ) # now check nTargetJobs = 3 + charSettings <- createCharacterizationSettings( + targetBaselineSettings = res + ) jobDf <- getTargetBaselineJobs( - characterizationSettings = createCharacterizationSettings( - targetBaselineSettings = res - ), + characterizationSettings = charSettings, nTargetJobs = 3 ) testthat::expect_true(nrow(jobDf) == 3) # check the target ids - testthat::expect_true(ParallelLogger::convertJsonToSettings(jobDf$settings[1])$targetIds == targetIds[1]) - testthat::expect_true(ParallelLogger::convertJsonToSettings(jobDf$settings[2])$targetIds == targetIds[2]) - testthat::expect_true(ParallelLogger::convertJsonToSettings(jobDf$settings[3])$targetIds == targetIds[3]) + tId1 <- charSettings$characterizationTargetLookup$characterizationTargetId[ + charSettings$characterizationTargetLookup$targetId == res$studyPopulationSettings$targetId[1] + ] + testthat::expect_true(ParallelLogger::convertJsonToSettings(jobDf$settings[1])$characterizationTargetIds == tId1) + tId2 <- charSettings$characterizationTargetLookup$characterizationTargetId[ + charSettings$characterizationTargetLookup$targetId == res$studyPopulationSettings$targetId[2] + ] + testthat::expect_true(ParallelLogger::convertJsonToSettings(jobDf$settings[2])$characterizationTargetIds == tId2) + tId3 <- charSettings$characterizationTargetLookup$characterizationTargetId[ + charSettings$characterizationTargetLookup$targetId == res$studyPopulationSettings$targetId[3] + ] + testthat::expect_true(ParallelLogger::convertJsonToSettings(jobDf$settings[3])$characterizationTargetIds == tId3) # now check nTargetJobs = 4 jobDf <- getTargetBaselineJobs( @@ -198,6 +220,8 @@ test_that("getTargetBaselineJobs", { }) test_that("computeTargetBaselineAnalyses", { + skipIfCreateTargetCohortSqlUnavailable() + targetIds <- c(1, 2, 4) covariateSettings <- FeatureExtraction::createCovariateSettings( useDemographicsGender = TRUE, @@ -206,9 +230,11 @@ test_that("computeTargetBaselineAnalyses", { ) res <- createTargetBaselineSettings( - targetIds = targetIds, - limitToFirstInNDays = 365, - minPriorObservation = 30, + createStudyPopulationSettings( + targetIds = targetIds, + limitToFirstInNDays = 365, + minPriorObservation = 30 + ), covariateSettings = covariateSettings ) @@ -247,6 +273,8 @@ test_that("computeTargetBaselineAnalyses", { cdmVersion = 5, targetDatabaseSchema = "main", targetTable = "cohort", + targetCountTable = tables$targetCountTable, + minTargetSize = 0, characterizationDatabaseSchema = 'main', characterizationTable = tables$characterizationTable, # contains char cohorts diff --git a/tests/testthat/test-timeToEvent.R b/tests/testthat/test-timeToEvent.R index d9111c6..cf3a9be 100644 --- a/tests/testthat/test-timeToEvent.R +++ b/tests/testthat/test-timeToEvent.R @@ -5,12 +5,14 @@ test_that("createTimeToEventSettings", { outcomeIds <- sample(x = 100, size = sample(10, 1)) res <- createTimeToEventSettings( - targetIds = targetIds, + studyPopulationSettings = createStudyPopulationSettings( + targetIds = targetIds + ), outcomeIds = outcomeIds ) testthat::expect_true( - length(unique(res$targetIds)) == length(targetIds) + length(unique(res$studyPopulationSettings$targetId)) == length(targetIds) ) testthat::expect_true( @@ -19,22 +21,58 @@ test_that("createTimeToEventSettings", { }) test_that("computeTimeToEventSettings", { + skipIfCreateTargetCohortSqlUnavailable() + targetIds <- c(1, 2) outcomeIds <- c(3, 4) res <- createTimeToEventSettings( - targetIds = targetIds, + studyPopulationSettings = createStudyPopulationSettings( + targetIds = targetIds + ), outcomeIds = outcomeIds ) + characterizationSettings <- createCharacterizationSettings( + timeToEventSettings = res + ) + + jobDf <- getTimeToEventJobs( + characterizationSettings = characterizationSettings, + nTargetJobs = 1 + ) + tteFolder <- tempfile("tte") + tables <- generateCohorts( + characterizationSettings = characterizationSettings, + mode = 'PatientLevelPrediction', + incremental = FALSE, + executionPath = tteFolder, + connectionDetails = connectionDetails, + targetDatabaseSchema = "main", + targetTable = "cohort", + outcomeDatabaseSchema = "main", + outcomeTable = "cohort", + outputDatabaseSchema = 'main', + outputTable = 'char_cohort', + cdmDatabaseSchema = "main", + tempEmulationSchema = "main", + progressBar = FALSE, + settingHash = 'set1', + dbHash = 'db1' + ) + computeTimeToEventAnalyses( connectionDetails = connectionDetails, cdmDatabaseSchema = "main", targetDatabaseSchema = "main", targetTable = "cohort", - settings = res, + outcomeDatabaseSchema = "main", + outcomeTable = "cohort", + characterizationDatabaseSchema = 'main', + characterizationTable = tables$characterizationTable, + settings = ParallelLogger::convertJsonToSettings(jobDf$settings[1]), outputFolder = tteFolder, databaseId = "tte_test" ) @@ -55,14 +93,18 @@ test_that("computeTimeToEventSettings", { ) ) <= length(targetIds) ) + + charTargetIds <- characterizationSettings$characterizationTargetLookup$characterizationTargetId[ + characterizationSettings$characterizationTargetLookup$targetId %in% targetIds + ] + testthat::expect_true( sum(unique( - tte$targetCohortDefinitionId - ) %in% targetIds) == - length(unique(tte$targetCohortDefinitionId)) + tte$characterizationTargetId + ) %in% charTargetIds) == + length(unique(tte$characterizationTargetId)) ) - testthat::expect_true( length( unique( diff --git a/tests/testthat/test-viewShiny.R b/tests/testthat/test-viewShiny.R index 006ffbb..885265b 100644 --- a/tests/testthat/test-viewShiny.R +++ b/tests/testthat/test-viewShiny.R @@ -16,34 +16,40 @@ test_that("ensure_installed", { }) test_that("prepareCharacterizationShiny works", { + skipIfCreateTargetCohortSqlUnavailable() + targetIds <- c(1, 2, 4) outcomeIds <- c(3) + studyPop1 <- createStudyPopulationSettings(targetIds = 1) + studyPop2 <- createStudyPopulationSettings(targetIds = 2) + studyPopAll <- createStudyPopulationSettings(targetIds = targetIds) + timeToEventSettings1 <- createTimeToEventSettings( - targetIds = 1, + studyPopulationSettings = studyPop1, outcomeIds = c(3, 4) ) timeToEventSettings2 <- createTimeToEventSettings( - targetIds = 2, + studyPopulationSettings = studyPop2, outcomeIds = c(3, 4) ) dechallengeRechallengeSettings <- createDechallengeRechallengeSettings( - targetIds = targetIds, + studyPopulationSettings = studyPopAll, outcomeIds = outcomeIds, dechallengeStopInterval = 30, dechallengeEvaluationWindow = 31 ) targetSettings1 <- createTargetBaselineSettings( - targetIds = targetIds, + studyPopulationSettings = studyPopAll, covariateSettings = FeatureExtraction::createCovariateSettings( useDemographicsGender = TRUE ) ) targetSettings2 <- createTargetBaselineSettings( - targetIds = targetIds, + studyPopulationSettings = studyPopAll, covariateSettings = FeatureExtraction::createCovariateSettings( useDemographicsAge = TRUE, useDemographicsRace = TRUE @@ -71,6 +77,8 @@ test_that("prepareCharacterizationShiny works", { targetTable = "cohort", outcomeDatabaseSchema = "main", outcomeTable = "cohort", + nestingCohortDatabaseSchema = 'main', + nestingCohortTable = "cohort", outputDatabaseSchema = 'main', outputTable = 'char_cohort', diff --git a/vignettes/Specification.Rmd b/vignettes/Specification.Rmd index 75aa9ef..27c7317 100644 --- a/vignettes/Specification.Rmd +++ b/vignettes/Specification.Rmd @@ -25,7 +25,7 @@ vignette: > ## Inputs -A vector of targetIds and a vector of outcomeIds +A studyPopulationSettings object (containing targetIds and any target population restrictions) and a vector of outcomeIds. ## Output @@ -206,7 +206,7 @@ knitr::kable( ## Inputs -A vector of targetIds, a vector of outcomeIds, an integer dechallengeStopInterval and an integer dechallengeEvaluationWindow. +A studyPopulationSettings object (containing targetIds and any target population restrictions), a vector of outcomeIds, an integer dechallengeStopInterval and an integer dechallengeEvaluationWindow. ## Output @@ -336,7 +336,7 @@ knitr::kable( ## Inputs -A vector of targetIds plus the minimum prior observation required for the target cohorts and minimum time before target exposures and specifying which features to extract (covariateSettings). +A studyPopulationSettings object (containing targetIds plus target population restrictions such as minimum prior observation and first-exposure limits) and covariateSettings specifying which features to extract. ## Outputs @@ -360,9 +360,11 @@ covariateSettings <- FeatureExtraction::createCovariateSettings( ) targetSettings <- Characterization::createTargetBaselineSettings( - targetIds = c(1,2), - limitToFirstInNDays = limitToFirstInNDays, - minPriorObservation = minPriorObservation, + studyPopulationSettings = Characterization::createStudyPopulationSettings( + targetIds = c(1,2), + limitToFirstInNDays = limitToFirstInNDays, + minPriorObservation = minPriorObservation + ), covariateSettings = covariateSettings ) @@ -425,7 +427,7 @@ This analysis lets users compare the mean values of the features between databas ## Inputs -A vector of targetIds and outcomeIds plus the minimum prior observation required for the target cohorts, the outcome washout days for the outcomes, settings for the time-at-risk and covariate settings specifying which features to extract. +A studyPopulationSettings object (containing targetIds plus target population restrictions), outcomeIds, outcome washout days, time-at-risk settings, and covariate settings specifying which features to extract. ## Outputs @@ -454,10 +456,12 @@ covariateSettings <- FeatureExtraction::createCovariateSettings( ) rfSettings <- Characterization::createRiskFactorSettings( - targetIds = targetId, + studyPopulationSettings = Characterization::createStudyPopulationSettings( + targetIds = targetId, + limitToFirstInNDays = limitToFirstInNDays, + minPriorObservation = minPriorObservation + ), outcomeIds = outcomeId, - limitToFirstInNDays = limitToFirstInNDays, - minPriorObservation = minPriorObservation, outcomeWashoutDays = outcomeWashoutDays, riskWindowStart = riskWindowStart, startAnchor = startAnchor, @@ -619,7 +623,7 @@ The cases series looks at the patients in a target cohort who have the outcome d ## Inputs -A vector of targetIds and outcomeIds plus the minimum prior observation required for the target cohorts, the outcome washout days for the outcomes, settings for the time-at-risk and covariate settings specifying which features to extract. +A studyPopulationSettings object (containing targetIds plus target population restrictions), outcomeIds, outcome washout days, time-at-risk settings, and covariate settings specifying which features to extract. In addition you need to specify how long before target index to extract before index features (preTargetIndexDays) and how long after outcome index to extract after index features (postOutcomeIndexDays). @@ -659,10 +663,12 @@ caseCovariateSettings <- Characterization::createDuringCovariateSettings( ) caseSeriesSettings <- Characterization::createCaseSeriesSettings( - targetIds = targetId, + studyPopulationSettings = Characterization::createStudyPopulationSettings( + targetIds = targetId, + limitToFirstInNDays = limitToFirstInNDays, + minPriorObservation = minPriorObservation + ), outcomeIds = outcomeId, - limitToFirstInNDays = limitToFirstInNDays, - minPriorObservation = minPriorObservation, outcomeWashoutDays = outcomeWashoutDays, riskWindowStart = riskWindowStart, startAnchor = startAnchor, diff --git a/vignettes/UsingPackage.Rmd b/vignettes/UsingPackage.Rmd index b1f47bb..cf7d066 100644 --- a/vignettes/UsingPackage.Rmd +++ b/vignettes/UsingPackage.Rmd @@ -34,7 +34,7 @@ This vignette describes how you can use the Characterization package for various First we need to install the `Characterization` package: ```{r tidy=TRUE,eval=FALSE} -remotes::install_github("ohdsi/Characterization") +install.packages('Characterization') ``` and then load it: @@ -54,9 +54,7 @@ connectionDetails <- Characterization::exampleOmopConnectionDetails() To run an 'Target Baseline Covariate' analysis you need to create a setting object using `createTargetBaselineSettings`. This requires specifying: -- one or more targetIds (these must be pre-generated in a cohort table) -- a limitToFirstInNDays that removes target exposures that occur within this number of days of a prior exposure. Use 99999 to restrict to first target exposure. -- a minPriorObservation that specifies the minimum number of days in the database a person needs to have at target index to be included. +- studyPopulationSettings created using `createStudyPopulationSettings` to define targetIds and population restrictions. - the covariate settings using `FeatureExtraction::createCovariateSettings` or by creating your own custom feature extraction code. Using the Eunomia data were we previous generated four cohorts, we can use cohort ids 1,2 and 4 as the targetIds: @@ -79,9 +77,11 @@ If we want to create the aggregate features for all our target cohort restricted ```{r eval=TRUE} exampleTargetBaselineSettings <- createTargetBaselineSettings( - targetIds = exampleTargetIds, - limitToFirstInNDays = 99999, - minPriorObservation = 365, + studyPopulationSettings = createStudyPopulationSettings( + targetIds = exampleTargetIds, + limitToFirstInNDays = 99999, + minPriorObservation = 365 + ), covariateSettings = exampleCovariateSettings ) ``` @@ -118,10 +118,8 @@ You can then see the results in the location `file.path(tempdir(), 'example_char To run an 'Risk Factor Covariate' analysis you need to create a setting object using `createRiskFactorSettings`. This requires specifying: -- one or more targetIds (these must be pre-generated in a cohort table) +- studyPopulationSettings created using `createStudyPopulationSettings` to define targetIds and population restrictions. - one or more outcomeIds (these must be pre-generated in a cohort table) -- a limitToFirstInNDays that removes target exposures that occur within this number of days of a prior exposure. Use 99999 to restrict to first target exposure. -- a minPriorObservation that specifies the minimum number of days in the database a person needs to have at target index to be included. - the covariate settings using `FeatureExtraction::createCovariateSettings` or by creating your own custom feature extraction code. - the time-at-risk settings + riskWindowStart @@ -150,13 +148,15 @@ If we want to create the aggregate features for all our cases/non-cases which ar ```{r eval=TRUE} exampleRiskFactorSettings <- createRiskFactorSettings( - targetIds = exampleTargetIds, + studyPopulationSettings = createStudyPopulationSettings( + targetIds = exampleTargetIds, + limitToFirstInNDays = 99999, # limit to first target exposure + minPriorObservation = 365 + ), outcomeIds = exampleOutcomeIds, - limitToFirstInNDays = 99999, # limit to first target exposure riskWindowStart = 1, startAnchor = "cohort start", riskWindowEnd = 365, endAnchor = "cohort start", outcomeWashoutDays = 9999, - minPriorObservation = 365, covariateSettings = exampleCovariateSettings ) ``` @@ -202,10 +202,8 @@ You can then see the results in the location `file.path(tempdir(), 'example_char To run an 'Case Series Covariate' analysis you need to create a setting object using `createCaseSeriesSettings`. This requires specifying: -- one or more targetIds (these must be pre-generated in a cohort table) +- studyPopulationSettings created using `createStudyPopulationSettings` to define targetIds and population restrictions. - one or more outcomeIds (these must be pre-generated in a cohort table) -- a limitToFirstInNDays that removes target exposures that occur within this number of days of a prior exposure. Use 99999 to restrict to first target exposure. -- a minPriorObservation that specifies the minimum number of days in the database a person needs to have at target index to be included. - the case covariate settings using `Characterization::createDuringCovariateSettings` or by creating your own custom feature extraction code. - the time-at-risk settings + riskWindowStart @@ -235,13 +233,15 @@ We also need to specify two variables `casePreTargetDuration` which is the numbe ```{r eval=TRUE} exampleCaseSeriesSettings <- createCaseSeriesSettings( - targetIds = exampleTargetIds, + studyPopulationSettings = createStudyPopulationSettings( + targetIds = exampleTargetIds, + limitToFirstInNDays = 99999, # limit to first target index + minPriorObservation = 365 + ), outcomeIds = exampleOutcomeIds, - limitToFirstInNDays = 99999, # limit to first target index riskWindowStart = 1, startAnchor = "cohort start", riskWindowEnd = 365, endAnchor = "cohort start", outcomeWashoutDays = 9999, - minPriorObservation = 365, caseCovariateSettings = exampleCaseCovariateSettings, casePreTargetDuration = 90, casePostOutcomeDuration = 90 @@ -282,7 +282,7 @@ You can then see the results in the location `file.path(tempdir(), 'example_char To run a 'Dechallenge Rechallenge' analysis you need to create a setting object using `createDechallengeRechallengeSettings`. This requires specifying: -- one or more targetIds (these must be pre-generated in a cohort table) +- studyPopulationSettings created using `createStudyPopulationSettings` to define targetIds and population restrictions. - one or more outcomeIds (these must be pre-generated in a cohort table) - dechallengeStopInterval - dechallengeEvaluationWindow @@ -298,7 +298,9 @@ If we want to create the dechallenge rechallenge for all our target cohorts and ```{r eval=TRUE} exampleDechallengeRechallengeSettings <- createDechallengeRechallengeSettings( - targetIds = exampleTargetIds, + studyPopulationSettings = createStudyPopulationSettings( + targetIds = exampleTargetIds + ), outcomeIds = exampleOutcomeIds, dechallengeStopInterval = 30, dechallengeEvaluationWindow = 31 @@ -339,12 +341,14 @@ failed <- computeRechallengeFailCaseSeriesAnalyses( To run a 'Time-to-event' analysis you need to create a setting object using `createTimeToEventSettings`. This requires specifying: -- one or more targetIds (these must be pre-generated in a cohort table) +- studyPopulationSettings created using `createStudyPopulationSettings` to define targetIds and population restrictions. - one or more outcomeIds (these must be pre-generated in a cohort table) ```{r eval=TRUE} exampleTimeToEventSettings <- createTimeToEventSettings( - targetIds = exampleTargetIds, + studyPopulationSettings = createStudyPopulationSettings( + targetIds = exampleTargetIds + ), outcomeIds = exampleOutcomeIds ) ```