diff --git a/CreateResultsDataModel.R b/CreateResultsDataModel.R index 8daf88c..c8158a3 100644 --- a/CreateResultsDataModel.R +++ b/CreateResultsDataModel.R @@ -1,40 +1,57 @@ -################################################################################ -# INSTRUCTIONS: The code below assumes you have access to a PostgreSQL database -# and permissions to create tables in an existing schema specified by the -# resultsDatabaseSchema parameter. -# -# See the Working with results section -# of the UsingThisTemplate.md for more details. -# -# More information about working with results produced by running Strategus -# is found at: -# https://ohdsi.github.io/Strategus/articles/WorkingWithResults.html -# ############################################################################## - -# Code for creating the result schema and tables in a PostgreSQL database -resultsDatabaseSchema <- "results" -analysisSpecifications <- ParallelLogger::loadSettingsFromJson( - fileName = "inst/sampleStudy/sampleStudyAnalysisSpecification.json" -) - -resultsDatabaseConnectionDetails <- DatabaseConnector::createConnectionDetails( - dbms = "postgresql", - server = Sys.getenv("OHDSI_RESULTS_DATABASE_SERVER"), - user = Sys.getenv("OHDSI_RESULTS_DATABASE_USER"), - password = Sys.getenv("OHDSI_RESULTS_DATABASE_PASSWORD") -) - -# Create results data model ------------------------- - -# Use the 1st results folder to define the results data model -resultsFolder <- list.dirs(path = "results", full.names = T, recursive = F)[1] -resultsDataModelSettings <- Strategus::createResultsDataModelSettings( - resultsDatabaseSchema = resultsDatabaseSchema, - resultsFolder = file.path(resultsFolder, "strategusOutput") -) - -Strategus::createResultDataModel( - analysisSpecifications = analysisSpecifications, - resultsDataModelSettings = resultsDataModelSettings, - resultsConnectionDetails = resultsDatabaseConnectionDetails -) \ No newline at end of file +# Create database objects for results ------------------------------------------ + +# libraries -------------------------------------------------------------------- + +source("./_StartHere/03-upload-results/config/01-UploadResultsConfig.R") +source("./util/database/StrategusDatabaseUtil.R") + +# implementation --------------------------------------------------------------- + +# create a connection to use to create the schema if it does not exist ---- +bootStrapConnectionDetails <- StrategusDatabaseUtil$getConnectionDetails ( + dbms = dbms, + connectionString = bootStrapConnectionString +) + +# create the database if it does not exist ---- +conn <- DatabaseConnector::connect(bootStrapConnectionDetails) +StrategusDatabaseUtil$createDatabaseIfItDoesNotExist(dbName, conn) +DatabaseConnector::disconnect(conn) + +# resultsConnectionDetails ---- +resultsConnectionDetails <- StrategusDatabaseUtil$getConnectionDetails ( + dbms = dbms, + connectionString = connectionString +) + +# create the schema if it does not exist ---- +conn <- DatabaseConnector::connect(resultsConnectionDetails) +StrategusDatabaseUtil$createSchemaIfItDoesNotExist(schemaName, conn) +DatabaseConnector::disconnect(conn) + +# analysisSpecifications ---- +analysisSpecifications <- ParallelLogger::loadSettingsFromJson ( + fileName = analysisSpecificationFilePath +) + +# resultsDataModelSettings ---- +resultsDataModelSettings <- Strategus::createResultsDataModelSettings ( + resultsDatabaseSchema = schemaName, + resultsFolder = resultsPath +) + +# Create results data model ------------------------- + +# Use the 1st results folder to define the results data model +resultsFolder <- list.dirs(path = resultsPath, full.names = T, recursive = F)[1] +resultsDataModelSettings <- Strategus::createResultsDataModelSettings( + resultsDatabaseSchema = schemaName, + resultsFolder = file.path(resultsFolder, "strategusOutput") +) + +Strategus::createResultDataModel( + analysisSpecifications = analysisSpecifications, + resultsDataModelSettings = resultsDataModelSettings, + resultsConnectionDetails = resultsConnectionDetails +) + diff --git a/CreateStrategusAnalysisSpecification.R b/CreateStrategusAnalysisSpecification.R index a2b6b73..81aea77 100644 --- a/CreateStrategusAnalysisSpecification.R +++ b/CreateStrategusAnalysisSpecification.R @@ -1,571 +1,586 @@ -################################################################################ -# INSTRUCTIONS: Make sure you have downloaded your cohorts using -# DownloadCohorts.R and that those cohorts are stored in the "inst" folder -# of the project. This script is written to use the sample study cohorts -# located in "inst/sampleStudy" so you will need to modify this in the code -# below. -# -# See the Create analysis specifications section -# of the UsingThisTemplate.md for more details. -# -# More information about Strategus HADES modules can be found at: -# https://ohdsi.github.io/Strategus/reference/index.html#omop-cdm-hades-modules. -# This help page also contains links to the corresponding HADES package that -# further details. -# ############################################################################## -library(dplyr) -library(Strategus) - -# Time-at-risks (TARs) for the outcomes of interest in your study -timeAtRisks <- tibble( - label = c("On treatment"), - riskWindowStart = c(1), - startAnchor = c("cohort start"), - riskWindowEnd = c(0), - endAnchor = c("cohort end") -) - -# PLP time-at-risks should try to use fixed-time TARs -plpTimeAtRisks <- tibble( - riskWindowStart = c(1), - startAnchor = c("cohort start"), - riskWindowEnd = c(365), - endAnchor = c("cohort start"), -) - -# If you are not restricting your study to a specific time window, -# please make these strings empty -studyStartDate <- '20171201' #YYYYMMDD -studyEndDate <- '20231231' #YYYYMMDD -# Some of the settings require study dates with hyphens -studyStartDateWithHyphens <- gsub("(\\d{4})(\\d{2})(\\d{2})", "\\1-\\2-\\3", studyStartDate) -studyEndDateWithHyphens <- gsub("(\\d{4})(\\d{2})(\\d{2})", "\\1-\\2-\\3", studyEndDate) - - -# Consider these settings for estimation ---------------------------------------- - -useCleanWindowForPriorOutcomeLookback <- FALSE # If FALSE, lookback window is all time prior, i.e., including only first events -psMatchMaxRatio <- 1 # If bigger than 1, the outcome model will be conditioned on the matched set - -# Shared Resources ------------------------------------------------------------- -# Get the list of cohorts - NOTE: you should modify this for your -# study to retrieve the cohorts you downloaded as part of -# DownloadCohorts.R -cohortDefinitionSet <- CohortGenerator::getCohortDefinitionSet( - settingsFileName = "inst/sampleStudy/Cohorts.csv", - jsonFolder = "inst/sampleStudy/cohorts", - sqlFolder = "inst/sampleStudy/sql/sql_server" -) - -# OPTIONAL: Create a subset to define the new user cohorts -# More information: https://ohdsi.github.io/CohortGenerator/articles/CreatingCohortSubsetDefinitions.html -subset1 <- CohortGenerator::createCohortSubsetDefinition( - name = "New Users", - definitionId = 1, - subsetOperators = list( - CohortGenerator::createLimitSubset( - priorTime = 365, - limitTo = "firstEver" - ) - ) -) - -cohortDefinitionSet <- cohortDefinitionSet |> - CohortGenerator::addCohortSubsetDefinition(subset1, targetCohortIds = c(1,2)) - -negativeControlOutcomeCohortSet <- CohortGenerator::readCsv( - file = "inst/sampleStudy/negativeControlOutcomes.csv" -) - -if (any(duplicated(cohortDefinitionSet$cohortId, negativeControlOutcomeCohortSet$cohortId))) { - stop("*** Error: duplicate cohort IDs found ***") -} - -# Create some data frames to hold the cohorts we'll use in each analysis --------------- -# Outcomes: The outcome for this study is cohort_id == 3 -oList <- cohortDefinitionSet %>% - filter(.data$cohortId == 3) %>% - mutate(outcomeCohortId = cohortId, outcomeCohortName = cohortName) %>% - select(outcomeCohortId, outcomeCohortName) %>% - mutate(cleanWindow = 365) - -# For the CohortMethod analysis we'll use the subsetted cohorts -cmTcList <- data.frame( - targetCohortId = 1001, - targetCohortName = "celecoxib new users", - comparatorCohortId = 2001, - comparatorCohortName = "diclofenac new users" -) - -# For the CohortMethod LSPS we'll need to exclude the drugs of interest in this -# study -excludedCovariateConcepts <- data.frame( - conceptId = c(1118084, 1124300), - conceptName = c("celecoxib", "diclofenac") -) - -# For the SCCS analysis we'll use the all exposure cohorts -sccsTList <- data.frame( - targetCohortId = c(1,2), - targetCohortName = c("celecoxib", "diclofenac") -) - -# CohortGeneratorModule -------------------------------------------------------- -cgModuleSettingsCreator <- CohortGeneratorModule$new() -cohortDefinitionShared <- cgModuleSettingsCreator$createCohortSharedResourceSpecifications(cohortDefinitionSet) -negativeControlsShared <- cgModuleSettingsCreator$createNegativeControlOutcomeCohortSharedResourceSpecifications( - negativeControlOutcomeCohortSet = negativeControlOutcomeCohortSet, - occurrenceType = "first", - detectOnDescendants = TRUE -) -cohortGeneratorModuleSpecifications <- cgModuleSettingsCreator$createModuleSpecifications( - generateStats = TRUE -) - -# CohortDiagnoticsModule Settings --------------------------------------------- -cdModuleSettingsCreator <- CohortDiagnosticsModule$new() -cohortDiagnosticsModuleSpecifications <- cdModuleSettingsCreator$createModuleSpecifications( - cohortIds = cohortDefinitionSet$cohortId, - runInclusionStatistics = TRUE, - runIncludedSourceConcepts = TRUE, - runOrphanConcepts = TRUE, - runTimeSeries = FALSE, - runVisitContext = TRUE, - runBreakdownIndexEvents = TRUE, - runIncidenceRate = TRUE, - runCohortRelationship = TRUE, - runTemporalCohortCharacterization = TRUE, - minCharacterizationMean = 0.01 -) - -# CharacterizationModule Settings --------------------------------------------- -cModuleSettingsCreator <- CharacterizationModule$new() -characterizationModuleSpecifications <- cModuleSettingsCreator$createModuleSpecifications( - targetIds = cohortDefinitionSet$cohortId, # NOTE: This is all T/C/I/O - outcomeIds = oList$outcomeCohortId, - minPriorObservation = 365, - dechallengeStopInterval = 30, - dechallengeEvaluationWindow = 30, - riskWindowStart = timeAtRisks$riskWindowStart, - startAnchor = timeAtRisks$startAnchor, - riskWindowEnd = timeAtRisks$riskWindowEnd, - endAnchor = timeAtRisks$endAnchor, - covariateSettings = FeatureExtraction::createDefaultCovariateSettings(), - minCharacterizationMean = .01 -) - - -# CohortIncidenceModule -------------------------------------------------------- -ciModuleSettingsCreator <- CohortIncidenceModule$new() -tcIds <- cohortDefinitionSet %>% - filter(!cohortId %in% oList$outcomeCohortId & isSubset) %>% - pull(cohortId) -targetList <- lapply( - tcIds, - function(cohortId) { - CohortIncidence::createCohortRef( - id = cohortId, - name = cohortDefinitionSet$cohortName[cohortDefinitionSet$cohortId == cohortId] - ) - } -) -outcomeList <- lapply( - seq_len(nrow(oList)), - function(i) { - CohortIncidence::createOutcomeDef( - id = i, - name = cohortDefinitionSet$cohortName[cohortDefinitionSet$cohortId == oList$outcomeCohortId[i]], - cohortId = oList$outcomeCohortId[i], - cleanWindow = oList$cleanWindow[i] - ) - } -) - -tars <- list() -for (i in seq_len(nrow(timeAtRisks))) { - tars[[i]] <- CohortIncidence::createTimeAtRiskDef( - id = i, - startWith = gsub("cohort ", "", timeAtRisks$startAnchor[i]), - endWith = gsub("cohort ", "", timeAtRisks$endAnchor[i]), - startOffset = timeAtRisks$riskWindowStart[i], - endOffset = timeAtRisks$riskWindowEnd[i] - ) -} -analysis1 <- CohortIncidence::createIncidenceAnalysis( - targets = tcIds, - outcomes = seq_len(nrow(oList)), - tars = seq_along(tars) -) -# irStudyWindow <- CohortIncidence::createDateRange( -# startDate = studyStartDateWithHyphens, -# endDate = studyEndDateWithHyphens -# ) -irDesign <- CohortIncidence::createIncidenceDesign( - targetDefs = targetList, - outcomeDefs = outcomeList, - tars = tars, - analysisList = list(analysis1), - #studyWindow = irStudyWindow, - strataSettings = CohortIncidence::createStrataSettings( - byYear = TRUE, - byGender = TRUE, - byAge = TRUE, - ageBreaks = seq(0, 110, by = 10) - ) -) -cohortIncidenceModuleSpecifications <- ciModuleSettingsCreator$createModuleSpecifications( - irDesign = irDesign$toList() -) - - -# CohortMethodModule ----------------------------------------------------------- -cmModuleSettingsCreator <- CohortMethodModule$new() -covariateSettings <- FeatureExtraction::createDefaultCovariateSettings( - addDescendantsToExclude = TRUE # Keep TRUE because you're excluding concepts -) -outcomeList <- append( - lapply(seq_len(nrow(oList)), function(i) { - if (useCleanWindowForPriorOutcomeLookback) - priorOutcomeLookback <- oList$cleanWindow[i] - else - priorOutcomeLookback <- 99999 - CohortMethod::createOutcome( - outcomeId = oList$outcomeCohortId[i], - outcomeOfInterest = TRUE, - trueEffectSize = NA, - priorOutcomeLookback = priorOutcomeLookback - ) - }), - lapply(negativeControlOutcomeCohortSet$cohortId, function(i) { - CohortMethod::createOutcome( - outcomeId = i, - outcomeOfInterest = FALSE, - trueEffectSize = 1 - ) - }) -) -targetComparatorOutcomesList <- list() -for (i in seq_len(nrow(cmTcList))) { - targetComparatorOutcomesList[[i]] <- CohortMethod::createTargetComparatorOutcomes( - targetId = cmTcList$targetCohortId[i], - comparatorId = cmTcList$comparatorCohortId[i], - outcomes = outcomeList, - excludedCovariateConceptIds = c( - cmTcList$targetConceptId[i], - cmTcList$comparatorConceptId[i], - excludedCovariateConcepts$conceptId - ) - ) -} -getDbCohortMethodDataArgs <- CohortMethod::createGetDbCohortMethodDataArgs( - restrictToCommonPeriod = TRUE, - studyStartDate = studyStartDate, - studyEndDate = studyEndDate, - maxCohortSize = 0, - covariateSettings = covariateSettings -) -createPsArgs = CohortMethod::createCreatePsArgs( - maxCohortSizeForFitting = 250000, - errorOnHighCorrelation = TRUE, - stopOnError = FALSE, # Setting to FALSE to allow Strategus complete all CM operations; when we cannot fit a model, the equipoise diagnostic should fail - estimator = "att", - prior = Cyclops::createPrior( - priorType = "laplace", - exclude = c(0), - useCrossValidation = TRUE - ), - control = Cyclops::createControl( - noiseLevel = "silent", - cvType = "auto", - seed = 1, - resetCoefficients = TRUE, - tolerance = 2e-07, - cvRepetitions = 1, - startingVariance = 0.01 - ) -) -matchOnPsArgs = CohortMethod::createMatchOnPsArgs( - maxRatio = psMatchMaxRatio, - caliper = 0.2, - caliperScale = "standardized logit", - allowReverseMatch = FALSE, - stratificationColumns = c() -) -# stratifyByPsArgs <- CohortMethod::createStratifyByPsArgs( -# numberOfStrata = 5, -# stratificationColumns = c(), -# baseSelection = "all" -# ) -computeSharedCovariateBalanceArgs = CohortMethod::createComputeCovariateBalanceArgs( - maxCohortSize = 250000, - covariateFilter = NULL -) -computeCovariateBalanceArgs = CohortMethod::createComputeCovariateBalanceArgs( - maxCohortSize = 250000, - covariateFilter = FeatureExtraction::getDefaultTable1Specifications() -) -fitOutcomeModelArgs = CohortMethod::createFitOutcomeModelArgs( - modelType = "cox", - stratified = psMatchMaxRatio != 1, - useCovariates = FALSE, - inversePtWeighting = FALSE, - prior = Cyclops::createPrior( - priorType = "laplace", - useCrossValidation = TRUE - ), - control = Cyclops::createControl( - cvType = "auto", - seed = 1, - resetCoefficients = TRUE, - startingVariance = 0.01, - tolerance = 2e-07, - cvRepetitions = 1, - noiseLevel = "quiet" - ) -) -cmAnalysisList <- list() -for (i in seq_len(nrow(timeAtRisks))) { - createStudyPopArgs <- CohortMethod::createCreateStudyPopulationArgs( - firstExposureOnly = FALSE, - washoutPeriod = 0, - removeDuplicateSubjects = "keep first", - censorAtNewRiskWindow = TRUE, - removeSubjectsWithPriorOutcome = TRUE, - priorOutcomeLookback = 99999, - riskWindowStart = timeAtRisks$riskWindowStart[[i]], - startAnchor = timeAtRisks$startAnchor[[i]], - riskWindowEnd = timeAtRisks$riskWindowEnd[[i]], - endAnchor = timeAtRisks$endAnchor[[i]], - minDaysAtRisk = 1, - maxDaysAtRisk = 99999 - ) - cmAnalysisList[[i]] <- CohortMethod::createCmAnalysis( - analysisId = i, - description = sprintf( - "Cohort method, %s", - timeAtRisks$label[i] - ), - getDbCohortMethodDataArgs = getDbCohortMethodDataArgs, - createStudyPopArgs = createStudyPopArgs, - createPsArgs = createPsArgs, - matchOnPsArgs = matchOnPsArgs, - # stratifyByPsArgs = stratifyByPsArgs, - computeSharedCovariateBalanceArgs = computeSharedCovariateBalanceArgs, - computeCovariateBalanceArgs = computeCovariateBalanceArgs, - fitOutcomeModelArgs = fitOutcomeModelArgs - ) -} -cohortMethodModuleSpecifications <- cmModuleSettingsCreator$createModuleSpecifications( - cmAnalysisList = cmAnalysisList, - targetComparatorOutcomesList = targetComparatorOutcomesList, - analysesToExclude = NULL, - refitPsForEveryOutcome = FALSE, - refitPsForEveryStudyPopulation = FALSE, - cmDiagnosticThresholds = CohortMethod::createCmDiagnosticThresholds( - mdrrThreshold = Inf, - easeThreshold = 0.25, - sdmThreshold = 0.1, - equipoiseThreshold = 0.2, - generalizabilitySdmThreshold = 1 # NOTE using default here - ) -) - - -# SelfControlledCaseSeriesmodule ----------------------------------------------- -sccsModuleSettingsCreator <- SelfControlledCaseSeriesModule$new() -uniqueTargetIds <- sccsTList$targetCohortId - -eoList <- list() -for (targetId in uniqueTargetIds) { - for (outcomeId in oList$outcomeCohortId) { - eoList[[length(eoList) + 1]] <- SelfControlledCaseSeries::createExposuresOutcome( - outcomeId = outcomeId, - exposures = list( - SelfControlledCaseSeries::createExposure( - exposureId = targetId, - trueEffectSize = NA - ) - ) - ) - } - for (outcomeId in negativeControlOutcomeCohortSet$cohortId) { - eoList[[length(eoList) + 1]] <- SelfControlledCaseSeries::createExposuresOutcome( - outcomeId = outcomeId, - exposures = list(SelfControlledCaseSeries::createExposure( - exposureId = targetId, - trueEffectSize = 1 - )) - ) - } -} -sccsAnalysisList <- list() -analysisToInclude <- data.frame() -# NOTE - NOT USING NESTING BY INDICATION -#for (i in seq_len(nrow(sccsIList))) { - #indicationId <- sccsIList$indicationCohortId[i] - getDbSccsDataArgs <- SelfControlledCaseSeries::createGetDbSccsDataArgs( - maxCasesPerOutcome = 1000000, - useNestingCohort = FALSE, - #nestingCohortId = indicationId, - studyStartDate = studyStartDate, - studyEndDate = studyEndDate, - deleteCovariatesSmallCount = 0 - ) - createStudyPopulationArgs = SelfControlledCaseSeries::createCreateStudyPopulationArgs( - firstOutcomeOnly = TRUE, - naivePeriod = 365, - minAge = 18, - genderConceptIds = c(8507, 8532) - ) - covarPreExp <- SelfControlledCaseSeries::createEraCovariateSettings( - label = "Pre-exposure", - includeEraIds = "exposureId", - start = -30, - startAnchor = "era start", - end = -1, - endAnchor = "era start", - firstOccurrenceOnly = FALSE, - allowRegularization = FALSE, - profileLikelihood = FALSE, - exposureOfInterest = FALSE - ) - calendarTimeSettings <- SelfControlledCaseSeries::createCalendarTimeCovariateSettings( - calendarTimeKnots = 5, - allowRegularization = TRUE, - computeConfidenceIntervals = FALSE - ) - # seasonalitySettings <- SelfControlledCaseSeries:createSeasonalityCovariateSettings( - # seasonKnots = 5, - # allowRegularization = TRUE, - # computeConfidenceIntervals = FALSE - # ) - fitSccsModelArgs <- SelfControlledCaseSeries::createFitSccsModelArgs( - prior = Cyclops::createPrior("laplace", useCrossValidation = TRUE), - control = Cyclops::createControl( - cvType = "auto", - selectorType = "byPid", - startingVariance = 0.1, - seed = 1, - resetCoefficients = TRUE, - noiseLevel = "quiet") - ) - for (j in seq_len(nrow(timeAtRisks))) { - covarExposureOfInt <- SelfControlledCaseSeries::createEraCovariateSettings( - label = "Main", - includeEraIds = "exposureId", - start = timeAtRisks$riskWindowStart[j], - startAnchor = gsub("cohort", "era", timeAtRisks$startAnchor[j]), - end = timeAtRisks$riskWindowEnd[j], - endAnchor = gsub("cohort", "era", timeAtRisks$endAnchor[j]), - firstOccurrenceOnly = FALSE, - allowRegularization = FALSE, - profileLikelihood = TRUE, - exposureOfInterest = TRUE - ) - createSccsIntervalDataArgs <- SelfControlledCaseSeries::createCreateSccsIntervalDataArgs( - eraCovariateSettings = list(covarPreExp, covarExposureOfInt), - # seasonalityCovariateSettings = seasonalityCovariateSettings, - calendarTimeCovariateSettings = calendarTimeSettings - ) - description <- "SCCS" - description <- sprintf("%s, male, female, age >= %s", description, createStudyPopulationArgs$minAge) - description <- sprintf("%s, %s", description, timeAtRisks$label[j]) - sccsAnalysisList[[length(sccsAnalysisList) + 1]] <- SelfControlledCaseSeries::createSccsAnalysis( - analysisId = length(sccsAnalysisList) + 1, - description = description, - getDbSccsDataArgs = getDbSccsDataArgs, - createStudyPopulationArgs = createStudyPopulationArgs, - createIntervalDataArgs = createSccsIntervalDataArgs, - fitSccsModelArgs = fitSccsModelArgs - ) - } -#} -selfControlledModuleSpecifications <- sccsModuleSettingsCreator$createModuleSpecifications( - sccsAnalysisList = sccsAnalysisList, - exposuresOutcomeList = eoList, - combineDataFetchAcrossOutcomes = FALSE, - sccsDiagnosticThresholds = SelfControlledCaseSeries::createSccsDiagnosticThresholds( - mdrrThreshold = Inf, - easeThreshold = 0.25, - timeTrendPThreshold = 0.05, - preExposurePThreshold = 0.05 - ) -) - -# PatientLevelPredictionModule ------------------------------------------------- -plpModuleSettingsCreator <- PatientLevelPredictionModule$new() - -modelSettings <- list( - lassoLogisticRegression = PatientLevelPrediction::setLassoLogisticRegression(), - randomForest = PatientLevelPrediction::setRandomForest() -) -modelDesignList <- list() -for (cohortId in tcIds) { - for (j in seq_len(nrow(plpTimeAtRisks))) { - for (k in seq_len(nrow(oList))) { - if (useCleanWindowForPriorOutcomeLookback) { - priorOutcomeLookback <- oList$cleanWindow[k] - } else { - priorOutcomeLookback <- 99999 - } - for (mSetting in modelSettings) { - modelDesignList[[length(modelDesignList) + 1]] <- PatientLevelPrediction::createModelDesign( - targetId = cohortId, - outcomeId = oList$outcomeCohortId[k], - restrictPlpDataSettings = PatientLevelPrediction::createRestrictPlpDataSettings( - sampleSize = 1000000, - studyStartDate = studyStartDate, - studyEndDate = studyEndDate, - firstExposureOnly = FALSE, - washoutPeriod = 0 - ), - populationSettings = PatientLevelPrediction::createStudyPopulationSettings( - riskWindowStart = plpTimeAtRisks$riskWindowStart[j], - startAnchor = plpTimeAtRisks$startAnchor[j], - riskWindowEnd = plpTimeAtRisks$riskWindowEnd[j], - endAnchor = plpTimeAtRisks$endAnchor[j], - removeSubjectsWithPriorOutcome = TRUE, - priorOutcomeLookback = priorOutcomeLookback, - requireTimeAtRisk = FALSE, - binary = TRUE, - includeAllOutcomes = TRUE, - firstExposureOnly = FALSE, - washoutPeriod = 0, - minTimeAtRisk = plpTimeAtRisks$riskWindowEnd[j] - plpTimeAtRisks$riskWindowStart[j], - restrictTarToCohortEnd = FALSE - ), - covariateSettings = FeatureExtraction::createCovariateSettings( - useDemographicsGender = TRUE, - useDemographicsAgeGroup = TRUE, - useConditionGroupEraLongTerm = TRUE, - useDrugGroupEraLongTerm = TRUE, - useVisitConceptCountLongTerm = TRUE - ), - preprocessSettings = PatientLevelPrediction::createPreprocessSettings(), - modelSettings = mSetting - ) - } - } - } -} -plpModuleSpecifications <- plpModuleSettingsCreator$createModuleSpecifications( - modelDesignList = modelDesignList -) - - -# Create the analysis specifications ------------------------------------------ -analysisSpecifications <- Strategus::createEmptyAnalysisSpecificiations() |> - Strategus::addSharedResources(cohortDefinitionShared) |> - Strategus::addSharedResources(negativeControlsShared) |> - Strategus::addModuleSpecifications(cohortGeneratorModuleSpecifications) |> - Strategus::addModuleSpecifications(cohortDiagnosticsModuleSpecifications) |> - Strategus::addModuleSpecifications(characterizationModuleSpecifications) |> - Strategus::addModuleSpecifications(cohortIncidenceModuleSpecifications) |> - Strategus::addModuleSpecifications(cohortMethodModuleSpecifications) |> - Strategus::addModuleSpecifications(selfControlledModuleSpecifications) |> - Strategus::addModuleSpecifications(plpModuleSpecifications) - -ParallelLogger::saveSettingsToJson( - analysisSpecifications, - file.path("inst", "sampleStudy", "sampleStudyAnalysisSpecification.json") -) \ No newline at end of file +# INSTRUCTIONS ################################################################# +# Make sure you have downloaded your cohorts using +# DownloadCohorts.R and that those cohorts are stored in the "inst" folder +# of the project. This script is written to use the sample study cohorts +# located in "inst/sampleStudy" so you will need to modify this in the code +# below. +# +# See the Create analysis specifications section +# of the UsingThisTemplate.md for more details. +# +# More information about Strategus HADES modules can be found at: +# https://ohdsi.github.io/Strategus/reference/index.html#omop-cdm-hades-modules. +# This help page also contains links to the corresponding HADES package that +# further details. +# ############################################################################## + +# libraries -------------------------------------------------------------------- + +library(dplyr) +library(Strategus) +source("./_StartHere/01-create-study/config/01-AuthorStudyConfiguration.R") + +# Shared Resources, Variables, and settings ----------------------------------- + +# # # +# +# This section contains code that defines and manipulates resources, variables and settings +# used by multiple modules. +# +# # # + +# add web authorization if indicated ---- +if (useWebApiAuthorization == TRUE) { + ROhdsiWebApi::authorizeWebApi ( + baseUrl = baseUrl, + authMethod = "windows" + ) +} + +# dates with hyphens ---- +studyStartDateWithHyphens <- gsub("(\\d{4})(\\d{2})(\\d{2})", "\\1-\\2-\\3", studyStartDate) +studyEndDateWithHyphens <- gsub("(\\d{4})(\\d{2})(\\d{2})", "\\1-\\2-\\3", studyEndDate) + +# negative controls ---- +negativeControlOutcomeCohortSet <- CohortGenerator::readCsv( + file = negativeControlOutcomesFile +) + +# cohortDefinitionSet ---- +cohortDefinitionSet <- CohortGenerator::getCohortDefinitionSet( + settingsFileName = settingsFileName, + jsonFolder = jsonFolder, + sqlFolder = sqlFolder +) + +# timeAtRisks ---- +timeAtRisks <- tibble( + label = c(tarLabel), + riskWindowStart = c(tarRiskWindowStart), + startAnchor = c(tarStartAnchor), + riskWindowEnd = c(tarRiskWindowEnd), + endAnchor = c(tarEndAnchor) +) + +# createNewUserSubset ---- +if(createNewUsersSubset == TRUE) { + # More information: https://ohdsi.github.io/CohortGenerator/articles/CreatingCohortSubsetDefinitions.html + subset1 <- CohortGenerator::createCohortSubsetDefinition( + name = "New Users", + definitionId = newUsersDefinitionId, + subsetOperators = list( + CohortGenerator::createLimitSubset( + priorTime = newUsersPriorTime, + limitTo = newUsersLimitTo + ) + ) + ) +} + +# cohortDefinitionSet ---- +cohortDefinitionSet <- CohortGenerator::addCohortSubsetDefinition ( + cohortDefinitionSet, + subset1, + targetCohortIds = c(1,2) +) + +if (any(duplicated(cohortDefinitionSet$cohortId, negativeControlOutcomeCohortSet$cohortId))) { + stop("*** Error: duplicate cohort IDs found ***") +} + +# Create some data frames to hold the cohorts we'll use in each analysis ---- +oList <- cohortDefinitionSet %>% + filter(.data$cohortId == outcomeCohortId) %>% + mutate(outcomeCohortId = cohortId, outcomeCohortName = cohortName) %>% + select(outcomeCohortId, outcomeCohortName) %>% + mutate(cleanWindow = cleanWindow) + +cmTcList <- data.frame( + targetCohortId = targetCohortId, + targetCohortName = targetCohortName, + comparatorCohortId = comparatorCohortId, + comparatorCohortName = comparatorCohortId +) + +# CohortGeneratorModule -------------------------------------------------------- +cgModuleSettingsCreator <- CohortGeneratorModule$new() +cohortDefinitionShared <- cgModuleSettingsCreator$createCohortSharedResourceSpecifications(cohortDefinitionSet) +negativeControlsShared <- cgModuleSettingsCreator$createNegativeControlOutcomeCohortSharedResourceSpecifications( + negativeControlOutcomeCohortSet = negativeControlOutcomeCohortSet, + occurrenceType = "first", + detectOnDescendants = TRUE +) +cohortGeneratorModuleSpecifications <- cgModuleSettingsCreator$createModuleSpecifications( + generateStats = TRUE +) + +# CohortDiagnoticsModule Settings --------------------------------------------- +cdModuleSettingsCreator <- CohortDiagnosticsModule$new() +cohortDiagnosticsModuleSpecifications <- cdModuleSettingsCreator$createModuleSpecifications( + cohortIds = cohortDefinitionSet$cohortId, + runInclusionStatistics = TRUE, + runIncludedSourceConcepts = TRUE, + runOrphanConcepts = TRUE, + runTimeSeries = FALSE, + runVisitContext = TRUE, + runBreakdownIndexEvents = TRUE, + runIncidenceRate = TRUE, + runCohortRelationship = TRUE, + runTemporalCohortCharacterization = TRUE, + minCharacterizationMean = 0.01 +) + +# CharacterizationModule Settings --------------------------------------------- +cModuleSettingsCreator <- CharacterizationModule$new() +characterizationModuleSpecifications <- cModuleSettingsCreator$createModuleSpecifications( + targetIds = cohortDefinitionSet$cohortId, # NOTE: This is all T/C/I/O + outcomeIds = oList$outcomeCohortId, + # TODO: PICKUP HERE (JEG) + minPriorObservation = charMinPriorObservation, + dechallengeStopInterval = charDechallengeStopInterval, + dechallengeEvaluationWindow = charDechallengeEvaluationWindow, + riskWindowStart = timeAtRisks$riskWindowStart, + startAnchor = timeAtRisks$startAnchor, + riskWindowEnd = timeAtRisks$riskWindowEnd, + endAnchor = timeAtRisks$endAnchor, + covariateSettings = FeatureExtraction::createDefaultCovariateSettings(), + minCharacterizationMean = .01 +) + +# CohortIncidenceModule -------------------------------------------------------- +ciModuleSettingsCreator <- CohortIncidenceModule$new() +tcIds <- cohortDefinitionSet %>% + filter(!cohortId %in% oList$outcomeCohortId & isSubset) %>% + pull(cohortId) +targetList <- lapply( + tcIds, + function(cohortId) { + CohortIncidence::createCohortRef( + id = cohortId, + name = cohortDefinitionSet$cohortName[cohortDefinitionSet$cohortId == cohortId] + ) + } +) +outcomeList <- lapply( + seq_len(nrow(oList)), + function(i) { + CohortIncidence::createOutcomeDef( + id = i, + name = cohortDefinitionSet$cohortName[cohortDefinitionSet$cohortId == oList$outcomeCohortId[i]], + cohortId = oList$outcomeCohortId[i], + cleanWindow = oList$cleanWindow[i] + ) + } +) + +tars <- list() +for (i in seq_len(nrow(timeAtRisks))) { + tars[[i]] <- CohortIncidence::createTimeAtRiskDef( + id = i, + startWith = gsub("cohort ", "", timeAtRisks$startAnchor[i]), + endWith = gsub("cohort ", "", timeAtRisks$endAnchor[i]), + startOffset = timeAtRisks$riskWindowStart[i], + endOffset = timeAtRisks$riskWindowEnd[i] + ) +} +analysis1 <- CohortIncidence::createIncidenceAnalysis( + targets = tcIds, + outcomes = seq_len(nrow(oList)), + tars = seq_along(tars) +) +# irStudyWindow <- CohortIncidence::createDateRange( +# startDate = studyStartDateWithHyphens, +# endDate = studyEndDateWithHyphens +# ) +irDesign <- CohortIncidence::createIncidenceDesign( + targetDefs = targetList, + outcomeDefs = outcomeList, + tars = tars, + analysisList = list(analysis1), + #studyWindow = irStudyWindow, + strataSettings = CohortIncidence::createStrataSettings( + byYear = TRUE, + byGender = TRUE, + byAge = TRUE, + ageBreaks = seq(0, 110, by = 10) + ) +) +cohortIncidenceModuleSpecifications <- ciModuleSettingsCreator$createModuleSpecifications( + irDesign = irDesign$toList() +) + + +# CohortMethodModule ----------------------------------------------------------- + +excludedCovariateConcepts <- data.frame( + conceptId = excludeConceptIdList, + conceptName = excludeConceptNameList +) + +cmModuleSettingsCreator <- CohortMethodModule$new() +covariateSettings <- FeatureExtraction::createDefaultCovariateSettings( + addDescendantsToExclude = TRUE # Keep TRUE because you're excluding concepts +) +outcomeList <- append( + lapply(seq_len(nrow(oList)), function(i) { + if (useCleanWindowForPriorOutcomeLookback) + priorOutcomeLookback <- oList$cleanWindow[i] + else + priorOutcomeLookback <- 99999 + CohortMethod::createOutcome( + outcomeId = oList$outcomeCohortId[i], + outcomeOfInterest = TRUE, + trueEffectSize = NA, + priorOutcomeLookback = priorOutcomeLookback + ) + }), + lapply(negativeControlOutcomeCohortSet$cohortId, function(i) { + CohortMethod::createOutcome( + outcomeId = i, + outcomeOfInterest = FALSE, + trueEffectSize = 1 + ) + }) +) +targetComparatorOutcomesList <- list() +for (i in seq_len(nrow(cmTcList))) { + targetComparatorOutcomesList[[i]] <- CohortMethod::createTargetComparatorOutcomes( + targetId = cmTcList$targetCohortId[i], + comparatorId = cmTcList$comparatorCohortId[i], + outcomes = outcomeList, + excludedCovariateConceptIds = c( + cmTcList$targetConceptId[i], + cmTcList$comparatorConceptId[i], + excludedCovariateConcepts$conceptId + ) + ) +} +getDbCohortMethodDataArgs <- CohortMethod::createGetDbCohortMethodDataArgs( + restrictToCommonPeriod = TRUE, + studyStartDate = studyStartDate, + studyEndDate = studyEndDate, + maxCohortSize = 0, + covariateSettings = covariateSettings +) +createPsArgs = CohortMethod::createCreatePsArgs( + maxCohortSizeForFitting = 250000, + errorOnHighCorrelation = TRUE, + stopOnError = FALSE, # Setting to FALSE to allow Strategus complete all CM operations; when we cannot fit a model, the equipoise diagnostic should fail + estimator = "att", + prior = Cyclops::createPrior( + priorType = "laplace", + exclude = c(0), + useCrossValidation = TRUE + ), + control = Cyclops::createControl( + noiseLevel = "silent", + cvType = "auto", + seed = 1, + resetCoefficients = TRUE, + tolerance = 2e-07, + cvRepetitions = 1, + startingVariance = 0.01 + ) +) +matchOnPsArgs = CohortMethod::createMatchOnPsArgs( + maxRatio = psMatchMaxRatio, + caliper = 0.2, + caliperScale = "standardized logit", + allowReverseMatch = FALSE, + stratificationColumns = c() +) +# stratifyByPsArgs <- CohortMethod::createStratifyByPsArgs( +# numberOfStrata = 5, +# stratificationColumns = c(), +# baseSelection = "all" +# ) +computeSharedCovariateBalanceArgs = CohortMethod::createComputeCovariateBalanceArgs( + maxCohortSize = 250000, + covariateFilter = NULL +) +computeCovariateBalanceArgs = CohortMethod::createComputeCovariateBalanceArgs( + maxCohortSize = 250000, + covariateFilter = FeatureExtraction::getDefaultTable1Specifications() +) +fitOutcomeModelArgs = CohortMethod::createFitOutcomeModelArgs( + modelType = "cox", + stratified = psMatchMaxRatio != 1, + useCovariates = FALSE, + inversePtWeighting = FALSE, + prior = Cyclops::createPrior( + priorType = "laplace", + useCrossValidation = TRUE + ), + control = Cyclops::createControl( + cvType = "auto", + seed = 1, + resetCoefficients = TRUE, + startingVariance = 0.01, + tolerance = 2e-07, + cvRepetitions = 1, + noiseLevel = "quiet" + ) +) +cmAnalysisList <- list() +for (i in seq_len(nrow(timeAtRisks))) { + createStudyPopArgs <- CohortMethod::createCreateStudyPopulationArgs( + firstExposureOnly = FALSE, + washoutPeriod = 0, + removeDuplicateSubjects = "keep first", + censorAtNewRiskWindow = TRUE, + removeSubjectsWithPriorOutcome = TRUE, + priorOutcomeLookback = 99999, + riskWindowStart = timeAtRisks$riskWindowStart[[i]], + startAnchor = timeAtRisks$startAnchor[[i]], + riskWindowEnd = timeAtRisks$riskWindowEnd[[i]], + endAnchor = timeAtRisks$endAnchor[[i]], + minDaysAtRisk = 1, + maxDaysAtRisk = 99999 + ) + cmAnalysisList[[i]] <- CohortMethod::createCmAnalysis( + analysisId = i, + description = sprintf( + "Cohort method, %s", + timeAtRisks$label[i] + ), + getDbCohortMethodDataArgs = getDbCohortMethodDataArgs, + createStudyPopArgs = createStudyPopArgs, + createPsArgs = createPsArgs, + matchOnPsArgs = matchOnPsArgs, + # stratifyByPsArgs = stratifyByPsArgs, + computeSharedCovariateBalanceArgs = computeSharedCovariateBalanceArgs, + computeCovariateBalanceArgs = computeCovariateBalanceArgs, + fitOutcomeModelArgs = fitOutcomeModelArgs + ) +} +cohortMethodModuleSpecifications <- cmModuleSettingsCreator$createModuleSpecifications( + cmAnalysisList = cmAnalysisList, + targetComparatorOutcomesList = targetComparatorOutcomesList, + analysesToExclude = NULL, + refitPsForEveryOutcome = FALSE, + refitPsForEveryStudyPopulation = FALSE, + cmDiagnosticThresholds = CohortMethod::createCmDiagnosticThresholds( + mdrrThreshold = Inf, + easeThreshold = 0.25, + sdmThreshold = 0.1, + equipoiseThreshold = 0.2, + generalizabilitySdmThreshold = 1 # NOTE using default here + ) +) + + +# SelfControlledCaseSeriesmodule ----------------------------------------------- + +sccsTList <- data.frame( + targetCohortId = sccsTargetCohortId, + targetCohortName = sscsTargetCohortName +) + +sccsModuleSettingsCreator <- SelfControlledCaseSeriesModule$new() +uniqueTargetIds <- sccsTList$targetCohortId + +eoList <- list() +for (targetId in uniqueTargetIds) { + for (outcomeId in oList$outcomeCohortId) { + eoList[[length(eoList) + 1]] <- SelfControlledCaseSeries::createExposuresOutcome( + outcomeId = outcomeId, + exposures = list( + SelfControlledCaseSeries::createExposure( + exposureId = targetId, + trueEffectSize = NA + ) + ) + ) + } + for (outcomeId in negativeControlOutcomeCohortSet$cohortId) { + eoList[[length(eoList) + 1]] <- SelfControlledCaseSeries::createExposuresOutcome( + outcomeId = outcomeId, + exposures = list(SelfControlledCaseSeries::createExposure( + exposureId = targetId, + trueEffectSize = 1 + )) + ) + } +} +sccsAnalysisList <- list() +analysisToInclude <- data.frame() +# NOTE - NOT USING NESTING BY INDICATION +#for (i in seq_len(nrow(sccsIList))) { + #indicationId <- sccsIList$indicationCohortId[i] + getDbSccsDataArgs <- SelfControlledCaseSeries::createGetDbSccsDataArgs( + maxCasesPerOutcome = 1000000, + useNestingCohort = FALSE, + #nestingCohortId = indicationId, + studyStartDate = studyStartDate, + studyEndDate = studyEndDate, + deleteCovariatesSmallCount = 0 + ) + createStudyPopulationArgs = SelfControlledCaseSeries::createCreateStudyPopulationArgs( + firstOutcomeOnly = TRUE, + naivePeriod = 365, + minAge = 18, + genderConceptIds = c(8507, 8532) + ) + covarPreExp <- SelfControlledCaseSeries::createEraCovariateSettings( + label = "Pre-exposure", + includeEraIds = "exposureId", + start = -30, + startAnchor = "era start", + end = -1, + endAnchor = "era start", + firstOccurrenceOnly = FALSE, + allowRegularization = FALSE, + profileLikelihood = FALSE, + exposureOfInterest = FALSE + ) + calendarTimeSettings <- SelfControlledCaseSeries::createCalendarTimeCovariateSettings( + calendarTimeKnots = 5, + allowRegularization = TRUE, + computeConfidenceIntervals = FALSE + ) + # seasonalitySettings <- SelfControlledCaseSeries:createSeasonalityCovariateSettings( + # seasonKnots = 5, + # allowRegularization = TRUE, + # computeConfidenceIntervals = FALSE + # ) + fitSccsModelArgs <- SelfControlledCaseSeries::createFitSccsModelArgs( + prior = Cyclops::createPrior("laplace", useCrossValidation = TRUE), + control = Cyclops::createControl( + cvType = "auto", + selectorType = "byPid", + startingVariance = 0.1, + seed = 1, + resetCoefficients = TRUE, + noiseLevel = "quiet") + ) + for (j in seq_len(nrow(timeAtRisks))) { + covarExposureOfInt <- SelfControlledCaseSeries::createEraCovariateSettings( + label = "Main", + includeEraIds = "exposureId", + start = timeAtRisks$riskWindowStart[j], + startAnchor = gsub("cohort", "era", timeAtRisks$startAnchor[j]), + end = timeAtRisks$riskWindowEnd[j], + endAnchor = gsub("cohort", "era", timeAtRisks$endAnchor[j]), + firstOccurrenceOnly = FALSE, + allowRegularization = FALSE, + profileLikelihood = TRUE, + exposureOfInterest = TRUE + ) + createSccsIntervalDataArgs <- SelfControlledCaseSeries::createCreateSccsIntervalDataArgs( + eraCovariateSettings = list(covarPreExp, covarExposureOfInt), + # seasonalityCovariateSettings = seasonalityCovariateSettings, + calendarTimeCovariateSettings = calendarTimeSettings + ) + description <- "SCCS" + description <- sprintf("%s, male, female, age >= %s", description, createStudyPopulationArgs$minAge) + description <- sprintf("%s, %s", description, timeAtRisks$label[j]) + sccsAnalysisList[[length(sccsAnalysisList) + 1]] <- SelfControlledCaseSeries::createSccsAnalysis( + analysisId = length(sccsAnalysisList) + 1, + description = description, + getDbSccsDataArgs = getDbSccsDataArgs, + createStudyPopulationArgs = createStudyPopulationArgs, + createIntervalDataArgs = createSccsIntervalDataArgs, + fitSccsModelArgs = fitSccsModelArgs + ) + } +#} +selfControlledModuleSpecifications <- sccsModuleSettingsCreator$createModuleSpecifications( + sccsAnalysisList = sccsAnalysisList, + exposuresOutcomeList = eoList, + combineDataFetchAcrossOutcomes = FALSE, + sccsDiagnosticThresholds = SelfControlledCaseSeries::createSccsDiagnosticThresholds( + mdrrThreshold = Inf, + easeThreshold = 0.25, + timeTrendPThreshold = 0.05, + preExposurePThreshold = 0.05 + ) +) + +# PatientLevelPredictionModule ------------------------------------------------- + +# PLP time-at-risks should try to use fixed-time TARs +plpTimeAtRisks <- tibble( + riskWindowStart = c(plpTarRiskWindowStart), + startAnchor = c(plpTarStartAnchor), + riskWindowEnd = c(plpTarRiskWindowEnd), + endAnchor = c(plpTarEndAnchor), +) + +plpModuleSettingsCreator <- PatientLevelPredictionModule$new() + +modelSettings <- list( + lassoLogisticRegression = PatientLevelPrediction::setLassoLogisticRegression(), + randomForest = PatientLevelPrediction::setRandomForest() +) +modelDesignList <- list() +for (cohortId in tcIds) { + for (j in seq_len(nrow(plpTimeAtRisks))) { + for (k in seq_len(nrow(oList))) { + if (useCleanWindowForPriorOutcomeLookback) { + priorOutcomeLookback <- oList$cleanWindow[k] + } else { + priorOutcomeLookback <- 99999 + } + for (mSetting in modelSettings) { + modelDesignList[[length(modelDesignList) + 1]] <- PatientLevelPrediction::createModelDesign( + targetId = cohortId, + outcomeId = oList$outcomeCohortId[k], + restrictPlpDataSettings = PatientLevelPrediction::createRestrictPlpDataSettings( + sampleSize = 1000000, + studyStartDate = studyStartDate, + studyEndDate = studyEndDate, + firstExposureOnly = FALSE, + washoutPeriod = 0 + ), + populationSettings = PatientLevelPrediction::createStudyPopulationSettings( + riskWindowStart = plpTimeAtRisks$riskWindowStart[j], + startAnchor = plpTimeAtRisks$startAnchor[j], + riskWindowEnd = plpTimeAtRisks$riskWindowEnd[j], + endAnchor = plpTimeAtRisks$endAnchor[j], + removeSubjectsWithPriorOutcome = TRUE, + priorOutcomeLookback = priorOutcomeLookback, + requireTimeAtRisk = FALSE, + binary = TRUE, + includeAllOutcomes = TRUE, + firstExposureOnly = FALSE, + washoutPeriod = 0, + minTimeAtRisk = plpTimeAtRisks$riskWindowEnd[j] - plpTimeAtRisks$riskWindowStart[j], + restrictTarToCohortEnd = FALSE + ), + covariateSettings = FeatureExtraction::createCovariateSettings( + useDemographicsGender = TRUE, + useDemographicsAgeGroup = TRUE, + useConditionGroupEraLongTerm = TRUE, + useDrugGroupEraLongTerm = TRUE, + useVisitConceptCountLongTerm = TRUE + ), + preprocessSettings = PatientLevelPrediction::createPreprocessSettings(), + modelSettings = mSetting + ) + } + } + } +} +plpModuleSpecifications <- plpModuleSettingsCreator$createModuleSpecifications( + modelDesignList = modelDesignList +) + + +# Create the analysis specifications ------------------------------------------ +analysisSpecifications <- Strategus::createEmptyAnalysisSpecificiations() |> + Strategus::addSharedResources(cohortDefinitionShared) |> + Strategus::addSharedResources(negativeControlsShared) |> + Strategus::addModuleSpecifications(cohortGeneratorModuleSpecifications) |> + Strategus::addModuleSpecifications(cohortDiagnosticsModuleSpecifications) |> + Strategus::addModuleSpecifications(characterizationModuleSpecifications) |> + Strategus::addModuleSpecifications(cohortIncidenceModuleSpecifications) |> + Strategus::addModuleSpecifications(cohortMethodModuleSpecifications) |> + Strategus::addModuleSpecifications(selfControlledModuleSpecifications) |> + Strategus::addModuleSpecifications(plpModuleSpecifications) + +ParallelLogger::saveSettingsToJson( + analysisSpecifications, + file.path("inst", "sampleStudy", "sampleStudyAnalysisSpecification.json") + +) + diff --git a/DownloadCohorts.R b/DownloadCohorts.R index 26f3458..08c0c9c 100644 --- a/DownloadCohorts.R +++ b/DownloadCohorts.R @@ -1,74 +1,67 @@ -################################################################################ -# INSTRUCTIONS: This script assumes you have cohorts you would like to use in an -# ATLAS instance. Please note you will need to update the baseUrl to match -# the settings for your enviroment. You will also want to change the -# CohortGenerator::saveCohortDefinitionSet() function call arguments to identify -# a folder to store your cohorts. This code will store the cohorts in -# "inst/sampleStudy" as part of the template for reference. You should store -# your settings in the root of the "inst" folder and consider removing the -# "inst/sampleStudy" resources when you are ready to release your study. -# -# See the Download cohorts section -# of the UsingThisTemplate.md for more details. -# ############################################################################## - -library(dplyr) -baseUrl <- "https://atlas-demo.ohdsi.org/WebAPI" -# Use this if your WebAPI instance has security enables -# ROhdsiWebApi::authorizeWebApi( -# baseUrl = baseUrl, -# authMethod = "windows" -# ) -cohortDefinitionSet <- ROhdsiWebApi::exportCohortDefinitionSet( - baseUrl = baseUrl, - cohortIds = c( - 1778211, # All exposures - celecoxib - 1790989, # All exposures - diclofenac - 1780946 # GI Bleed - ), - generateStats = TRUE -) - -# Rename cohorts -cohortDefinitionSet[cohortDefinitionSet$cohortId == 1778211,]$cohortName <- "celecoxib" -cohortDefinitionSet[cohortDefinitionSet$cohortId == 1790989,]$cohortName <- "diclofenac" -cohortDefinitionSet[cohortDefinitionSet$cohortId == 1780946,]$cohortName <- "GI Bleed" - -# Re-number cohorts -cohortDefinitionSet[cohortDefinitionSet$cohortId == 1778211,]$cohortId <- 1 -cohortDefinitionSet[cohortDefinitionSet$cohortId == 1790989,]$cohortId <- 2 -cohortDefinitionSet[cohortDefinitionSet$cohortId == 1780946,]$cohortId <- 3 - -# Save the cohort definition set -# NOTE: Update settingsFileName, jsonFolder and sqlFolder -# for your study. -CohortGenerator::saveCohortDefinitionSet( - cohortDefinitionSet = cohortDefinitionSet, - settingsFileName = "inst/sampleStudy/Cohorts.csv", - jsonFolder = "inst/sampleStudy/cohorts", - sqlFolder = "inst/sampleStudy/sql/sql_server", -) - - -# Download and save the negative control outcomes -negativeControlOutcomeCohortSet <- ROhdsiWebApi::getConceptSetDefinition( - conceptSetId = 1885090, - baseUrl = baseUrl -) %>% - ROhdsiWebApi::resolveConceptSet( - baseUrl = baseUrl - ) %>% - ROhdsiWebApi::getConcepts( - baseUrl = baseUrl - ) %>% - rename(outcomeConceptId = "conceptId", - cohortName = "conceptName") %>% - mutate(cohortId = row_number() + 100) %>% - select(cohortId, cohortName, outcomeConceptId) - -# NOTE: Update file location for your study. -CohortGenerator::writeCsv( - x = negativeControlOutcomeCohortSet, - file = "inst/sampleStudy/negativeControlOutcomes.csv", - warnOnFileNameCaseMismatch = F -) +# # # +# +# Libraries +# +# # # + +library(dplyr) +source("./_StartHere/01-create-study/config/01-AuthorStudyConfiguration.R") + +# # # +# +# Implementation +# +# # # + +# get the cohortIds as a list of integers +cohortIds <- sapply(cohortList, function(x) as.numeric(x[1])) + +# create the cohortDefinitionSet +cohortDefinitionSet <- ROhdsiWebApi::exportCohortDefinitionSet( + baseUrl = baseUrl, + cohortIds = cohortIds, + generateStats = TRUE +) + +# get the id and name as a tibble to use to update cohortDefinitionSet +cohortTibble <- tibble( + ID = sapply(cohortList, `[[`, 1), + Name = sapply(cohortList, `[[`, 2) +) + +# rename and renumber cohorts +for (i in seq_len(nrow(cohortTibble))) { + cohortDefinitionSet[cohortDefinitionSet$cohortId == cohortTibble$ID[i], "cohortName"] <- cohortTibble$Name[i] + cohortDefinitionSet[cohortDefinitionSet$cohortId == cohortTibble$ID[i], "cohortId"] <- i +} + +# Save the cohort definition set +CohortGenerator::saveCohortDefinitionSet( + cohortDefinitionSet = cohortDefinitionSet, + settingsFileName = settingsFileName, + jsonFolder = jsonFolder, + sqlFolder = sqlFolder, +) + +# Download and save the negative control outcomes +negativeControlOutcomeCohortSet <- ROhdsiWebApi::getConceptSetDefinition( + conceptSetId = negativeControlConceptSetId, + baseUrl = baseUrl +) %>% + ROhdsiWebApi::resolveConceptSet( + baseUrl = baseUrl + ) %>% + ROhdsiWebApi::getConcepts( + baseUrl = baseUrl + ) %>% + rename(outcomeConceptId = "conceptId", + cohortName = "conceptName") %>% + mutate(cohortId = row_number() + 100) %>% + select(cohortId, cohortName, outcomeConceptId) + +# write the negativeControlOutcomeCohortSet to csv +CohortGenerator::writeCsv( + x = negativeControlOutcomeCohortSet, + file = negativeControlOutcomesFile, + warnOnFileNameCaseMismatch = F +) diff --git a/StrategusCodeToRun.R b/StrategusCodeToRun.R index bc8c67d..f3f6e21 100644 --- a/StrategusCodeToRun.R +++ b/StrategusCodeToRun.R @@ -1,74 +1,54 @@ -# ------------------------------------------------------- -# PLEASE READ -# ------------------------------------------------------- -# -# You must call "renv::restore()" and follow the prompts -# to install all of the necessary R libraries to run this -# project. This is a one-time operation that you must do -# before running any code. -# -# !!! PLEASE RESTART R AFTER RUNNING renv::restore() !!! -# -# ------------------------------------------------------- -#renv::restore() - -# ENVIRONMENT SETTINGS NEEDED FOR RUNNING Strategus ------------ -Sys.setenv("_JAVA_OPTIONS"="-Xmx4g") # Sets the Java maximum heap space to 4GB -Sys.setenv("VROOM_THREADS"=1) # Sets the number of threads to 1 to avoid deadlocks on file system - -##=========== START OF INPUTS ========== -cdmDatabaseSchema <- "main" -workDatabaseSchema <- "main" -outputLocation <- file.path(getwd(), "results") -databaseName <- "Eunomia" # Only used as a folder name for results from the study -minCellCount <- 5 -cohortTableName <- "sample_study" - -# Create the connection details for your CDM -# More details on how to do this are found here: -# https://ohdsi.github.io/DatabaseConnector/reference/createConnectionDetails.html -# connectionDetails <- DatabaseConnector::createConnectionDetails( -# dbms = Sys.getenv("DBMS_TYPE"), -# connectionString = Sys.getenv("CONNECTION_STRING"), -# user = Sys.getenv("DBMS_USERNAME"), -# password = Sys.getenv("DBMS_PASSWORD") -# ) - -# For this example we will use the Eunomia sample data -# set. This library is not installed by default so you -# can install this by running: -# -# install.packages("Eunomia") -connectionDetails <- Eunomia::getEunomiaConnectionDetails() - -# You can use this snippet to test your connection -#conn <- DatabaseConnector::connect(connectionDetails) -#DatabaseConnector::disconnect(conn) - -##=========== END OF INPUTS ========== -analysisSpecifications <- ParallelLogger::loadSettingsFromJson( - fileName = "inst/sampleStudy/sampleStudyAnalysisSpecification.json" -) - -executionSettings <- Strategus::createCdmExecutionSettings( - workDatabaseSchema = workDatabaseSchema, - cdmDatabaseSchema = cdmDatabaseSchema, - cohortTableNames = CohortGenerator::getCohortTableNames(cohortTable = cohortTableName), - workFolder = file.path(outputLocation, databaseName, "strategusWork"), - resultsFolder = file.path(outputLocation, databaseName, "strategusOutput"), - minCellCount = minCellCount -) - -if (!dir.exists(file.path(outputLocation, databaseName))) { - dir.create(file.path(outputLocation, databaseName), recursive = T) -} -ParallelLogger::saveSettingsToJson( - object = executionSettings, - fileName = file.path(outputLocation, databaseName, "executionSettings.json") -) - -Strategus::execute( - analysisSpecifications = analysisSpecifications, - executionSettings = executionSettings, - connectionDetails = connectionDetails +# ------------------------------------------------------- +# PLEASE READ +# ------------------------------------------------------- +# +# You must call "renv::restore()" and follow the prompts +# to install all of the necessary R libraries to run this +# project. This is a one-time operation that you must do +# before running any code. +# +# !!! PLEASE RESTART R AFTER RUNNING renv::restore() !!! +# +# ------------------------------------------------------- +#renv::restore() + +# libraries -------------------------------------------------------------------- + +source("./_StartHere/02-run-study/config/01-RunStudyConfiguration.R") + +# implementation --------------------------------------------------------------- + +# ENVIRONMENT SETTINGS NEEDED FOR RUNNING Strategus ------------ +Sys.setenv("_JAVA_OPTIONS"="-Xmx4g") # Sets the Java maximum heap space to 4GB +Sys.setenv("VROOM_THREADS"=1) # Sets the number of threads to 1 to avoid deadlocks on file system + +# You can use this snippet to test your connection +#conn <- DatabaseConnector::connect(connectionDetails) +#DatabaseConnector::disconnect(conn) + +analysisSpecifications <- ParallelLogger::loadSettingsFromJson( + fileName = analysisSpecificationFilePath +) + +executionSettings <- Strategus::createCdmExecutionSettings( + workDatabaseSchema = workDatabaseSchema, + cdmDatabaseSchema = cdmDatabaseSchema, + cohortTableNames = CohortGenerator::getCohortTableNames(cohortTable = cohortTableName), + workFolder = file.path(outputLocation, databaseName, "strategusWork"), + resultsFolder = file.path(outputLocation, databaseName, "strategusOutput"), + minCellCount = minCellCount +) + +if (!dir.exists(file.path(outputLocation, databaseName))) { + dir.create(file.path(outputLocation, databaseName), recursive = T) +} +ParallelLogger::saveSettingsToJson( + object = executionSettings, + fileName = file.path(outputLocation, databaseName, "executionSettings.json") +) + +Strategus::execute( + analysisSpecifications = analysisSpecifications, + executionSettings = executionSettings, + connectionDetails = connectionDetails ) \ No newline at end of file diff --git a/StrategusStudyRepoTemplate.Rproj b/StrategusStudyRepoTemplate.Rproj index 8e3c2eb..f638990 100644 --- a/StrategusStudyRepoTemplate.Rproj +++ b/StrategusStudyRepoTemplate.Rproj @@ -1,13 +1,14 @@ -Version: 1.0 - -RestoreWorkspace: Default -SaveWorkspace: Default -AlwaysSaveHistory: Default - -EnableCodeIndexing: Yes -UseSpacesForTab: Yes -NumSpacesForTab: 2 -Encoding: UTF-8 - -RnwWeave: Sweave -LaTeX: pdfLaTeX +Version: 1.0 +ProjectId: 2b0c346e-c7de-444b-9a10-fab3ccb34317 + +RestoreWorkspace: Default +SaveWorkspace: Default +AlwaysSaveHistory: Default + +EnableCodeIndexing: Yes +UseSpacesForTab: Yes +NumSpacesForTab: 2 +Encoding: UTF-8 + +RnwWeave: Sweave +LaTeX: pdfLaTeX diff --git a/UploadResults.R b/UploadResults.R index 94bcc03..f5337d1 100644 --- a/UploadResults.R +++ b/UploadResults.R @@ -1,104 +1,115 @@ -################################################################################ -# INSTRUCTIONS: The code below assumes you have access to a PostgreSQL database -# and permissions to insert data into tables created by running the -# CreateResultsDataModel.R script. This script will loop over all of the -# directories found under the "results" folder and upload the results. -# -# This script also contains some commented out code for -# setting read-only permissions for a user account on the results schema. -# This is used when setting up a read-only user for use with a Shiny results -# viewer. Additionally, there is commented out code that will allow you to run -# ANALYZE on each results table to ensure the database is performant. -# -# See the Working with results section -# of the UsingThisTemplate.md for more details. -# -# More information about working with results produced by running Strategus -# is found at: -# https://ohdsi.github.io/Strategus/articles/WorkingWithResults.html -# ############################################################################## - -# Code for uploading results to a Postgres database -resultsDatabaseSchema <- "results" -analysisSpecifications <- ParallelLogger::loadSettingsFromJson( - fileName = "inst/sampleStudy/sampleStudyAnalysisSpecification.json" -) -resultsDatabaseConnectionDetails <- DatabaseConnector::createConnectionDetails( - dbms = "postgresql", - server = Sys.getenv("OHDSI_RESULTS_DATABASE_SERVER"), - user = Sys.getenv("OHDSI_RESULTS_DATABASE_USER"), - password = Sys.getenv("OHDSI_RESULTS_DATABASE_PASSWORD") -) - -# Setup logging ---------------------------------------------------------------- -ParallelLogger::clearLoggers() -ParallelLogger::addDefaultFileLogger( - fileName = "upload-log.txt", - name = "RESULTS_FILE_LOGGER" -) -ParallelLogger::addDefaultErrorReportLogger( - fileName = "upload-errorReport.txt", - name = "RESULTS_ERROR_LOGGER" -) - -# Upload Results --------------------------------------------------------------- -for (resultFolder in list.dirs(path = "results", full.names = T, recursive = F)) { - resultsDataModelSettings <- Strategus::createResultsDataModelSettings( - resultsDatabaseSchema = resultsDatabaseSchema, - resultsFolder = file.path(resultFolder, "strategusOutput"), - ) - - Strategus::uploadResults( - analysisSpecifications = analysisSpecifications, - resultsDataModelSettings = resultsDataModelSettings, - resultsConnectionDetails = resultsDatabaseConnectionDetails - ) -} - -connection <- DatabaseConnector::connect( - connectionDetails = resultsDatabaseConnectionDetails -) - - -# Optional scripts to set permissions and to analyze tables ------------------ -# # Grant read only permissions to all tables -# sql <- "GRANT USAGE ON SCHEMA @schema TO @results_user; -# GRANT SELECT ON ALL TABLES IN SCHEMA @schema TO @results_user; -# GRANT EXECUTE ON ALL FUNCTIONS IN SCHEMA @schema TO @results_user;" -# -# message("Setting permissions for results schema") -# sql <- SqlRender::render( -# sql = sql, -# schema = resultsDatabaseSchema, -# results_user = 'shinyproxy' -# ) -# DatabaseConnector::executeSql( -# connection = connection, -# sql = sql, -# progressBar = FALSE, -# reportOverallTime = FALSE -# ) -# -# # Analyze all tables in the results schema -# message("Analyzing all tables in results schema") -# sql <- "ANALYZE @schema.@table_name;" -# tableList <- DatabaseConnector::getTableNames( -# connection = connection, -# databaseSchema = resultsDatabaseSchema -# ) -# for (i in 1:length(tableList)) { -# DatabaseConnector::renderTranslateExecuteSql( -# connection = connection, -# sql = sql, -# schema = resultsDatabaseSchema, -# table_name = tableList[i], -# progressBar = FALSE, -# reportOverallTime = FALSE -# ) -# } -# -# DatabaseConnector::disconnect(connection) - -# Unregister loggers ----------------------------------------------------------- -ParallelLogger::unregisterLogger("RESULTS_FILE_LOGGER") -ParallelLogger::unregisterLogger("RESULTS_ERROR_LOGGER") \ No newline at end of file +################################################################################ +# INSTRUCTIONS: The code below assumes you have access to a PostgreSQL database +# and permissions to insert data into tables created by running the +# CreateResultsDataModel.R script. This script will loop over all of the +# directories found under the "results" folder and upload the results. +# +# This script also contains some commented out code for +# setting read-only permissions for a user account on the results schema. +# This is used when setting up a read-only user for use with a Shiny results +# viewer. Additionally, there is commented out code that will allow you to run +# ANALYZE on each results table to ensure the database is performant. +# +# See the Working with results section +# of the UsingThisTemplate.md for more details. +# +# More information about working with results produced by running Strategus +# is found at: +# https://ohdsi.github.io/Strategus/articles/WorkingWithResults.html +# ############################################################################## + +# libraries -------------------------------------------------------------------- + +source("./_StartHere/03-upload-results/config/01-UploadResultsConfig.R") + +# implementation --------------------------------------------------------------- + +# analysisSpecifications ---- +analysisSpecifications <- ParallelLogger::loadSettingsFromJson( + fileName = analysisSpecificationFilePath +) + +# resultsDatabaseSchema ---- +resultsDatabaseSchema <- schemaName + +# resultsDatabaseConnectionDetails ---- +resultsDatabaseConnectionDetails <- StrategusDatabaseUtil$getConnectionDetails ( + dbms = dbms, + connectionString = connectionString +) + +# Setup logging ---- + +ParallelLogger::clearLoggers() +ParallelLogger::addDefaultFileLogger( + fileName = "upload-log.txt", + name = "RESULTS_FILE_LOGGER" +) +ParallelLogger::addDefaultErrorReportLogger( + fileName = "upload-errorReport.txt", + name = "RESULTS_ERROR_LOGGER" +) + +# Upload Results ---- + +for (resultFolder in list.dirs(path = resultsPath, full.names = T, recursive = F)) { + resultsDataModelSettings <- Strategus::createResultsDataModelSettings( + resultsDatabaseSchema = resultsDatabaseSchema, + resultsFolder = file.path(resultFolder, "strategusOutput"), + ) + + Strategus::uploadResults( + analysisSpecifications = analysisSpecifications, + resultsDataModelSettings = resultsDataModelSettings, + resultsConnectionDetails = resultsDatabaseConnectionDetails + ) +} + +connection <- DatabaseConnector::connect( + connectionDetails = resultsDatabaseConnectionDetails +) + + +# Optional scripts to set permissions and to analyze tables ------------------ +# # Grant read only permissions to all tables +# sql <- "GRANT USAGE ON SCHEMA @schema TO @results_user; +# GRANT SELECT ON ALL TABLES IN SCHEMA @schema TO @results_user; +# GRANT EXECUTE ON ALL FUNCTIONS IN SCHEMA @schema TO @results_user;" +# +# message("Setting permissions for results schema") +# sql <- SqlRender::render( +# sql = sql, +# schema = resultsDatabaseSchema, +# results_user = 'shinyproxy' +# ) +# DatabaseConnector::executeSql( +# connection = connection, +# sql = sql, +# progressBar = FALSE, +# reportOverallTime = FALSE +# ) +# +# # Analyze all tables in the results schema +# message("Analyzing all tables in results schema") +# sql <- "ANALYZE @schema.@table_name;" +# tableList <- DatabaseConnector::getTableNames( +# connection = connection, +# databaseSchema = resultsDatabaseSchema +# ) +# for (i in 1:length(tableList)) { +# DatabaseConnector::renderTranslateExecuteSql( +# connection = connection, +# sql = sql, +# schema = resultsDatabaseSchema, +# table_name = tableList[i], +# progressBar = FALSE, +# reportOverallTime = FALSE +# ) +# } +# +# DatabaseConnector::disconnect(connection) + +# Unregister loggers ---- +ParallelLogger::unregisterLogger("RESULTS_FILE_LOGGER") +ParallelLogger::unregisterLogger("RESULTS_ERROR_LOGGER") + diff --git a/_StartHere/00-init/00-EditRenvironmentFile.R b/_StartHere/00-init/00-EditRenvironmentFile.R new file mode 100644 index 0000000..5c9f82b --- /dev/null +++ b/_StartHere/00-init/00-EditRenvironmentFile.R @@ -0,0 +1,51 @@ +# # # +# +# Use https://github.com/settings/tokens to generate your token. +# +# Script to edit the .Renviron file +# Add the following lines to the .Renviron file (where MY_GITHUB_PAT) is the +# token you generated as above: +# +# _JAVA_OPTIONS='-Xmx4g' +# GITHUB_PAT='MY_GITHUB_PAT' +# +# # # + +# # # +# +# clear the existing environment variables +# +# # # + +rm(list = ls()) + +# # # +# +# details of r version +# +# # # + +R.version +R.version.string + +# # # +# +# bootstrap installing tools +# +# # # + +if (!requireNamespace("usethis", quietly = TRUE) || packageVersion("usethis") != "3.1.0") { + options(replace.readline = function(prompt) "Y") + install.packages("usethis", ask = FALSE) + options(replace.readline = function(prompt) NULL) +} + +# # # +# +# edit the Renviron file +# +# # # + +library(usethis) +edit_r_environ() + diff --git a/_StartHere/00-init/01-Init.R b/_StartHere/00-init/01-Init.R new file mode 100644 index 0000000..8244902 --- /dev/null +++ b/_StartHere/00-init/01-Init.R @@ -0,0 +1,26 @@ +# ---- +# set up environment +# ---- + +renv::restore(confirm = FALSE) + +# ---- +# Add libraries not included in the lock file +# ---- + +remotes::install_github("https://github.com/OHDSI/ROhdsiWebApi","v1.3.3", upgrade="never") +if (!requireNamespace("Eunomia", quietly = TRUE) || packageVersion("Eunomia") != "2.0.0") { + options(replace.readline = function(prompt) "Y") + remotes::install_version("Eunomia", version = '2.0.0', upgrade = "never") + options(replace.readline = function(prompt) NULL) +} + +# ---- +# show installed versions of packages +# ---- + +installed.packages()[, c("Package", "Version")] + + + + diff --git a/_StartHere/00-init/02-InstallReteculite.R b/_StartHere/00-init/02-InstallReteculite.R new file mode 100644 index 0000000..7fd0f1f --- /dev/null +++ b/_StartHere/00-init/02-InstallReteculite.R @@ -0,0 +1,11 @@ +# # # +# +# From https://ohdsi.github.io/PatientLevelPrediction/articles/InstallationGuide.html#creating-python-reticulate-environment +# +# # # + +library(PatientLevelPrediction) +reticulate::install_miniconda() +configurePython(envname='r-reticulate', envtype='conda') + + diff --git a/_StartHere/01-create-study/01-CreateStudy.R b/_StartHere/01-create-study/01-CreateStudy.R new file mode 100644 index 0000000..b0c1605 --- /dev/null +++ b/_StartHere/01-create-study/01-CreateStudy.R @@ -0,0 +1,20 @@ +# This script will create the study. ---- + +# # # +# See the referenced source files for details. +# # # + +# libraries -------------------------------------------------------------------- + +source("./_StartHere/01-create-study/config/01-AuthorStudyConfiguration.R", echo=TRUE) + +# implementation --------------------------------------------------------------- + +# Delete the existing version of the study ---- +unlink(studyDefRootDir, recursive = TRUE, force = TRUE) + +# Create the study ---- +source("./DownloadCohorts.R", echo=TRUE) +source("./CreateStrategusAnalysisSpecification.R", echo=TRUE) + + diff --git a/_StartHere/01-create-study/config/01-AuthorStudyConfiguration.R b/_StartHere/01-create-study/config/01-AuthorStudyConfiguration.R new file mode 100644 index 0000000..199c2fd --- /dev/null +++ b/_StartHere/01-create-study/config/01-AuthorStudyConfiguration.R @@ -0,0 +1,139 @@ +# # # +# +# This implementation assumes you have cohorts you would like to use in an +# ATLAS instance. +# +# Update the parameters below to match your study. +# +# # # + +# Libraries -------------------------------------------------------------------- + +source("./util/database/StrategusDatabaseUtil.R") + +# Implementation --------------------------------------------------------------- + +# Files ---- + +# # # +# The following parameters define where files for your study should be located. +# # # + +studyDefRootDir <- "./inst/sampleStudy" +settingsFileName <- paste0(studyDefRootDir, "/Cohorts.csv") +jsonFolder <- paste0(studyDefRootDir, "/cohorts") +sqlFolder <- paste0(studyDefRootDir, "/sql/sql_server") +negativeControlOutcomesFile <- paste0(studyDefRootDir, "/negativeControlOutcomes.csv") +studyDefinitionFile <- paste0(studyDefRootDir, "/sampleStudyAnalysisSpecification.json") + +# Base URL ---- + +# # # +# This is the URL of the WebAPI/Atlas instance you are sourcing data from. +# # # + +baseUrl <- "https://atlas-demo.ohdsi.org/WebAPI" +useWebApiAuthorization <- FALSE + +# ------------------------------------------------------------------------------ +# Study Design Variables +# ------------------------------------------------------------------------------ + +# Dates ---- +# If your study is not restricted to a specific time window, make these strings empty (i.e. ''). + +studyStartDate <- '20171201' #YYYYMMDD +studyEndDate <- '20231231' #YYYYMMDD + +# Cohorts ---- +# - Update the following to use the cohort ids and negative control concept set id +# for your study. +# - Each study in the cohort list will be assigned a sequence id that will be +# used across the network studies. Sequence IDs will be assigned in the order +# of the list supplied here (e.g. in the example below 1778211 will be assigned 1) + +cohortList <- + list( + list(1778211, "celecoxib"), + list(1790989, "diclofenac"), + list(1780946, "GI Bleed") + ) + +outcomeCohortId <- 3 +cleanWindow <- 365 + +# Negative Control ---- +negativeControlConceptSetId <- 1885090 + +# Create New Users Subset ---- +createNewUsersSubset <- TRUE +newUsersDefinitionId <- 1 +newUsersPriorTime <- 365 +newUsersLimitTo <- "firstEver" + +# For the CohortMethod analysis we'll use the subsetted cohorts +targetCohortId <- 1001 +targetCohortName <- "celecoxib new users" +comparatorCohortId <- 2001 +comparatorCohortName <- "diclofenac new users" + +# Time at risk (TARs) variables ---- + +# # # +# +# Time at risk as used by the following modules (and potentially others) +# - CharacterizationModule +# - CohortIncidenceModule +# - CohortMethodModule +# - SelfControlledCaseSeriesmodule +# +# # # + +tarLabel <- "On treatment" +tarRiskWindowStart <- 1 +tarStartAnchor <- "cohort start" +tarRiskWindowEnd <- 0 +tarEndAnchor <- "cohort end" + +# Settings for specific modules ------------------------------------------------ + +# # # +# +# The following section contains settings for specific modules. Most of these +# modules have additional settings that are generally not modified. See +# CreateStrategusAnalysisSpecification.R to see the other variables that are used. +# +# # # + +# CohortMethodModule ----------------------------------------------------------- + +excludeConceptIdList <- c(1118084, 1124300) +excludeConceptNameList <- c("celecoxib", "diclofenac") + +# PatientLevelPredictionModule ------------------------------------------------- + +plpTarRiskWindowStart = 1 +plpTarStartAnchor = "cohort start" +plpTarRiskWindowEnd = 365 +plpTarEndAnchor = "cohort start" + +# # # +# Estimation settings: +# - # If useCleanWindowForPriorOutcomeLookback is set to FALSE, lookback window is all time prior, +# (i.e. including only first events). +# - If psMatchMaxRatio is bigger than 1, the outcome model will be conditioned on the matched set +# # # + +useCleanWindowForPriorOutcomeLookback <- FALSE +psMatchMaxRatio <- 1 + +# CharacterizationModule ------------------------------------------------------ +charMinPriorObservation <- 365 +charDechallengeStopInterval <- 30 +charDechallengeEvaluationWindow <- 30 + +# SelfControlledCaseSeriesmodule --------------------------------------------------- +sccsTargetCohortId <- c(1,2) +sscsTargetCohortName <- c("celecoxib", "diclofenac") + + diff --git a/_StartHere/02-run-study/01-RunStudy.R b/_StartHere/02-run-study/01-RunStudy.R new file mode 100644 index 0000000..0f7fac7 --- /dev/null +++ b/_StartHere/02-run-study/01-RunStudy.R @@ -0,0 +1,3 @@ +# This script runs the study. See the source files for details. ---------------- + +source("./StrategusCodeToRun.R", echo=TRUE) diff --git a/_StartHere/02-run-study/config/01-RunStudyConfiguration.R b/_StartHere/02-run-study/config/01-RunStudyConfiguration.R new file mode 100644 index 0000000..735fce9 --- /dev/null +++ b/_StartHere/02-run-study/config/01-RunStudyConfiguration.R @@ -0,0 +1,24 @@ + +# ---- +# +# Run Configuration: +# This file contains the parameters used for running a study. +# +# ---- + +# Files ---- + +analysisSpecificationFilePath <- "inst/sampleStudy/sampleStudyAnalysisSpecification.json" + +# Other parameters for running the study ---- + +cdmDatabaseSchema <- "main" +workDatabaseSchema <- "main" +outputLocation <- "results" +databaseName <- "Eunomia" +minCellCount <- 5 +cohortTableName <- "sample_study" + +# Connection details ---- + +connectionDetails <- Eunomia::getEunomiaConnectionDetails() diff --git a/_StartHere/03-upload-results/00-CreateDatabaseObjects.R b/_StartHere/03-upload-results/00-CreateDatabaseObjects.R new file mode 100644 index 0000000..6ee1d4c --- /dev/null +++ b/_StartHere/03-upload-results/00-CreateDatabaseObjects.R @@ -0,0 +1,17 @@ +# 00-CreateDatabaseObjects ----------------------------------------------------- + +# ---- +# +# This script creates all of the database objects in PostgreSql required to upload +# study results. This script assumes you have access to a PostgreSql database +# that can be used to store the results. +# +# More information about working with results produced by running Strategus +# is found at: +# https://ohdsi.github.io/Strategus/articles/WorkingWithResults.html +# +# ---- + +source("./CreateResultsDataModel.R") + + diff --git a/_StartHere/03-upload-results/01-UploadResults.R b/_StartHere/03-upload-results/01-UploadResults.R new file mode 100644 index 0000000..747bde1 --- /dev/null +++ b/_StartHere/03-upload-results/01-UploadResults.R @@ -0,0 +1,4 @@ +# upload results -------------------------------------------------------------- + +source("./UploadResults.R") + diff --git a/_StartHere/03-upload-results/config/01-UploadResultsConfig.R b/_StartHere/03-upload-results/config/01-UploadResultsConfig.R new file mode 100644 index 0000000..9b6a796 --- /dev/null +++ b/_StartHere/03-upload-results/config/01-UploadResultsConfig.R @@ -0,0 +1,26 @@ +# Configuration file for data upload ------------------------------------------- + +# ---- +# +# This file contains the configuration details for uploading data for a study that has been run. +# +# ---- + +# Files ---- + +analysisSpecificationFilePath <- "inst/sampleStudy/sampleStudyAnalysisSpecification.json" +resultsPath <- "./results" + +# Results Connection Details ---- + +# # # +# Connection details and schema for the database that will hold the results. +# # # + +resultsDbPassword <- Sys.getenv("RESULTS_DB_PASSWORD") +dbName <- "strategus" +schemaName <- "study_results" +dbms <- "postgresql" +bootStrapConnectionString <- paste0("jdbc:postgresql://localhost:5432/postgres?user=postgres&password=", resultsDbPassword) +connectionString <- paste0("jdbc:postgresql://localhost:5432/", dbName, "?user=postgres&password=", resultsDbPassword) + diff --git a/_StartHere/04-view-results/01-ViewResults.R b/_StartHere/04-view-results/01-ViewResults.R new file mode 100644 index 0000000..9286b78 --- /dev/null +++ b/_StartHere/04-view-results/01-ViewResults.R @@ -0,0 +1,35 @@ +# ------------------------------------------------------------------------------ +# INSTRUCTIONS: The code below assumes you uploaded results to a PostgreSQL +# database per the UploadResults.R script.This script will launch a Shiny +# results viewer to analyze results from the study. +# +# See the Working with results section +# of the UsingThisTemplate.md for more details. +# +# More information about working with results produced by running Strategus +# is found at: +# https://ohdsi.github.io/Strategus/articles/WorkingWithResults.html +# ------------------------------------------------------------------------------ + +# libraries -------------------------------------------------------------------- + +library(ShinyAppBuilder) +library(OhdsiShinyModules) +source("./_StartHere/04-view-results/config/01-ViewResultsConfig.R") + +# implementation --------------------------------------------------------------- + +resultsDatabaseSchema <- schemaName + +# Specify the connection to the results database +resultsConnectionDetails <- DatabaseConnector::createConnectionDetails( + dbms = dbms, + connectionString = connectionString +) + +# create the shiny app based on the config file and view the results ---- +ShinyAppBuilder::createShinyApp( + config = shinyConfig, + connectionDetails = resultsConnectionDetails, + resultDatabaseSettings = createDefaultResultDatabaseSettings(schema = resultsDatabaseSchema) +) diff --git a/_StartHere/04-view-results/config/01-ViewResultsConfig.R b/_StartHere/04-view-results/config/01-ViewResultsConfig.R new file mode 100644 index 0000000..7eea526 --- /dev/null +++ b/_StartHere/04-view-results/config/01-ViewResultsConfig.R @@ -0,0 +1,30 @@ +# View Results Configuration --------------------------------------------------- + +resultsDbPassword <- Sys.getenv("RESULTS_DB_PASSWORD") +schemaName <- "study_results" +connectionString <- paste0("jdbc:postgresql://localhost:5432/", dbName, "?user=postgres&password=", resultsDbPassword) + +# ADD OR REMOVE MODULES TAILORED TO YOUR STUDY ---- +shinyConfig <- initializeModuleConfig() |> + addModuleConfig( + createDefaultAboutConfig() + ) |> + addModuleConfig( + createDefaultDatasourcesConfig() + ) |> + addModuleConfig( + createDefaultCohortGeneratorConfig() + ) |> + addModuleConfig( + createDefaultCohortDiagnosticsConfig() + ) |> + addModuleConfig( + createDefaultCharacterizationConfig() + ) |> + addModuleConfig( + createDefaultPredictionConfig() + ) |> + addModuleConfig( + createDefaultEstimationConfig() + ) + diff --git a/_StartHere/99-testing/TestResultsDatabaseConnection.R b/_StartHere/99-testing/TestResultsDatabaseConnection.R new file mode 100644 index 0000000..4ce3980 --- /dev/null +++ b/_StartHere/99-testing/TestResultsDatabaseConnection.R @@ -0,0 +1,14 @@ +# libraries -------------------------------------------------------------------- + +source("./_StartHere/03-upload-results/config/01-UploadResultsConfig.R") +source("./util/database/StrategusDatabaseUtil.R") + +# implementation --------------------------------------------------------------- + +# test the results connection details ---- +print("Getting connection...") +conn <- DatabaseConnector::connect(resultsConnectionDetails) +print("Closing connection") +DatabaseConnector::disconnect(conn) +print("Done.") + diff --git a/template_docs/execute_study_steps/ExecuteStudyStepsQuickStartGuide.md b/template_docs/execute_study_steps/ExecuteStudyStepsQuickStartGuide.md new file mode 100644 index 0000000..c0f4a93 --- /dev/null +++ b/template_docs/execute_study_steps/ExecuteStudyStepsQuickStartGuide.md @@ -0,0 +1,178 @@ +Executing Study Steps +================= +## Introduction + +This guide gives a quick start guide to executing all of the steps of a study. +These steps include the following: + + +Everything needed to complete all of these steps can be found in the _StartHere folder. +The structure of the _StartHere folder is shown below.
+
+ +

+ +The initialization scripts are a special case. These scripts are run once to configure and initialize your R environment. Each of these scripts must be run before executing any of the other steps. + +Each of the other steps is defined in two files, a configuration file and an implementation file that is used to exeute the step. For example, the files used to create a study are found in 01-create-study. This folder contains a configuration file (01-create-study/config/01-AuthorStudyConfiguration.R) and an implementation file (01-create-study/01-CreateStudy.R). In most cases the configuration file is the only file that will need to be edited to implement your study. + +It should be noted that in many cases a user will run one or a subset of the steps below. For example, data providers will not run the Create Study step. Note that in all cases the initialization step must be executed before running any other step. + +## Notes on Strategus, HADES, and HADES Modules +This template executes Strategus code. More information on Strategus is available at https://ohdsi.github.io/Strategus/index.html. Strategus builds and executes a number of HADES Modules and other packages. More information on HADES is available at https://ohdsi.github.io/Hades/. The HADES modules all have their own documentation that details what each module does, the input and output of the module, the meanings of each of the variables used by the module, etc. A list of the available modules and links to the documentation is available at https://ohdsi.github.io/Strategus/reference/index.html#omop-cdm-hades-modules. + +## 00 - Initialization: Run the Setup Scripts +Note: this step must be run before any of the other steps shown below. This step only needs to be run once. +
+ +Important: Open R as Admin. The following process will require the installation of many R packages. Some of these installs will fail if you do not run as Admin.

+These scripts run renv::restore() and all of the other initialization steps described in the Using this Template document. + +To run these scripts, start RStudio as Admin. Select File->Open Project and navigate to the StrategusStudyRepoTemplate.proj file in the StrategusStudyRepoTemplate project. Then run the scripts in the \_StartHere/init folder in order: + + +## 01 - Create the Study Definition +Important: Before executing this step, run the Initialization scripts if you have not already. +

+This step will download the cohorts for this study and create the analysis specification.
+
+For more details see the Using This Template document.
+
+To create a study: + + +## 02 - Run the Study +Important: Before executing this step, run the Initialization scripts if you have not already. +

+This step will run the study using the database (CDM) specified in the configuration file.
+
+For more details see the Using This Template document.
+
+To run a study: + + +## 03 - Upload the Study Results +Important: Before executing this step, run the Initialization scripts if you have not already. +

+This step will upload the study results to the Postgres dataabase specified in the configuration file.
+
+For more details see the Using This Template document.
+
+To upload study results: + + +## 04 - View Study Results +Important: Before executing this step, run the Initialization scripts if you have not already. +

+This step will launch a Shiny application that will display the study results.
+
+For more details see the Using This Template document.
+
+To view the study results: + diff --git a/template_docs/execute_study_steps/img/file-structure.png b/template_docs/execute_study_steps/img/file-structure.png new file mode 100644 index 0000000..7bb759c Binary files /dev/null and b/template_docs/execute_study_steps/img/file-structure.png differ diff --git a/template_docs/install_using_polites/InstallUsingPolites.md b/template_docs/install_using_polites/InstallUsingPolites.md new file mode 100644 index 0000000..7cb3c3f --- /dev/null +++ b/template_docs/install_using_polites/InstallUsingPolites.md @@ -0,0 +1,101 @@ +Setup Environment Using Polites +================= + +This guide will walk through how to setup your Windows environment using Polites. +More information on using the Polites tools to setup your environment can be found at https://greshje.github.io/polites/quick-start.html. + +## Download and Install PostgreSql and pgAdmin +PostgreSql is reqired for storing the data generated by Strategus. Download and install PostgresSql and pgAdmin from https://www.enterprisedb.com/downloads/postgres-postgresql-downloads (both applications are bundled in a single download in the downloads provided on this page). This documentation was tested using the Windows x86-64 version 17.2 installer. + +## Download the Polites YesInstaller +Download and run the YesPolitesInstaller executable file. +Click here to download. + +Navigate to C:\_YES_POLITES\tools\r and run the RTools installer and the RStudio installer (R has already been installed by the YesPolites installer).
+ + +## Configure RStudio +Open RStudio. When prompted to choose an R installation, use the browse option and then use:
+C:\\_YES_POLITES\\tools\\r\\R\\R-4.4.1\\bin\\R.exe
+If not propted, select tools->Global Options->General->R version
+ + +## Fork and Clone the StrategusStudyRepoTemplate project +Fork the StrategusStudyRepoTemplate and create a new branch in your forked version. +Clone your forked version and checkout the branch you created. + +## Generate your Github Personal Access Token (PAT) +In order to install the R packages required for this project, you will need a Github Personal Access Token (PAT).
+A token can be created at the following Github URL (I'm not sure what privileges are required, for now, I simply select them all): +https://github.com/settings/tokens
+ + +## Open RStudio as Admin and then Open the StrategusStudyRepoTemplate Project +Important: Open R as Admin. The following process will require the installation of many R packages. Some of these installs will fail if you do not run as Admin.
+Start RStudio as Admin. Select File->Open Project and navigate to the StrategusStudyRepoTemplate.proj file in the StrategusStudyRepoTemplate project you just cloned and checked out. + +## Run the Setup Scripts +Run the scripts in the \_StartHere/init folder in order: + diff --git a/template_docs/install_using_polites/img/github-pat.png b/template_docs/install_using_polites/img/github-pat.png new file mode 100644 index 0000000..d420823 Binary files /dev/null and b/template_docs/install_using_polites/img/github-pat.png differ diff --git a/template_docs/install_using_polites/img/r-installs.png b/template_docs/install_using_polites/img/r-installs.png new file mode 100644 index 0000000..f7169bc Binary files /dev/null and b/template_docs/install_using_polites/img/r-installs.png differ diff --git a/template_docs/install_using_polites/img/run-scripts.png b/template_docs/install_using_polites/img/run-scripts.png new file mode 100644 index 0000000..63e78b4 Binary files /dev/null and b/template_docs/install_using_polites/img/run-scripts.png differ diff --git a/template_docs/install_using_polites/img/select-r-installation.png b/template_docs/install_using_polites/img/select-r-installation.png new file mode 100644 index 0000000..efa6ee6 Binary files /dev/null and b/template_docs/install_using_polites/img/select-r-installation.png differ diff --git a/util/database/StrategusDatabaseUtil.R b/util/database/StrategusDatabaseUtil.R new file mode 100644 index 0000000..e66d961 --- /dev/null +++ b/util/database/StrategusDatabaseUtil.R @@ -0,0 +1,76 @@ +# StrategusDatabaseUtil ------------------------------------------------------- + +# ---- +# StrategusDatabaseUtil: +# A utility class for common database interactions. +# ---- + +StrategusDatabaseUtil <- {} + +# getConnectionDetails -------------------------------------------------------- + +# ---- +# Gets the connection details. Downloads the driver if needed. +# ---- + +StrategusDatabaseUtil$getConnectionDetails <- function(dbms, connectionString) { + # get the jdbc driver dir + jdbcDriverDir <- Sys.getenv("DATABASECONNECTOR_JAR_FOLDER") + # create the dir if it does not exist + if(dir.exists(jdbcDriverDir) == FALSE) { + dir.create(jdbcDriverDir, recursive = TRUE) + } + # download the driver if it does not exist + searchString <- paste0("^", dbms) + driverExists <- any(grepl(searchString, list.files(jdbcDriverDir))) + if (driverExists == FALSE) { + print("Driver not found, downloading it now...") + DatabaseConnector::downloadJdbcDrivers(dbms) + print("Done downloading driver.") + } + # create the connection details + resultsConnectionDetails <- DatabaseConnector::createConnectionDetails( + dbms = dbms, + connectionString = connectionString + ) + # return + return(resultsConnectionDetails) +} + +# createDatabaseIfItDoesNotExist ------------------------------------------------ + +# ---- +# Creates the specified database if it does not exist. +# ---- + +StrategusDatabaseUtil$createDatabaseIfItDoesNotExist <- function(dbName, conn) { + # Check if the database exists + checkDbQuery <- sprintf("SELECT 1 FROM pg_database WHERE datname = '%s';", dbName) + dbExists <- nrow(DatabaseConnector::querySql(conn, checkDbQuery)) > 0 + # Create the database if it doesn't exist + if (dbExists == FALSE) { + createDbQuery <- sprintf("CREATE DATABASE %s;", dbName) + DatabaseConnector::executeSql(conn, createDbQuery) + } +} + + +# createSchemaIfItDoesNotExist ------------------------------------------------ + +# ---- +# Creates the specified schema if it does not exist. +# ---- + +StrategusDatabaseUtil$createSchemaIfItDoesNotExist <- function(schemaName, conn) { + # Check if the schema exists + checkSchemaQuery <- sprintf("SELECT 1 FROM information_schema.schemata WHERE schema_name = '%s';", schemaName) + schemaExists <- nrow(DatabaseConnector::querySql(conn, checkSchemaQuery)) > 0 + # Create the schema if it doesn't exist + if (!schemaExists) { + createSchemaQuery <- sprintf("CREATE SCHEMA %s;", schemaName) + DatabaseConnector::executeSql(conn, createSchemaQuery) + } +} + + +