inst/doc/MultipleAnalyses.R

In SelfControlledCaseSeries: Self-Controlled Case Series

## ----echo = FALSE, message = FALSE, warning = FALSE---------------------------
library(SelfControlledCaseSeries)
library(EmpiricalCalibration)
outputFolder <- "e:/temp/vignetteSccs2"
diclofenac <- 1124300
giBleed <- 77

## ----eval=TRUE,eval=FALSE-----------------------------------------------------
# connectionDetails <- createConnectionDetails(
#   dbms = "postgresql",
#   server = "localhost/ohdsi",
#   user = "joe",
#   password = "supersecret"
# )
# 
# outputFolder <- "s:/temp/sccsVignette2"
# 
# cdmDatabaseSchema <- "my_cdm_data"
# cohortDatabaseSchema <- "my_cohorts"
# options(sqlRenderTempEmulationSchema = NULL)

## ----eval=FALSE---------------------------------------------------------------
# giBleed <- 77
# cohortDefinitionSet <- PhenotypeLibrary::getPlCohortDefinitionSet(giBleed)

## ----eval=FALSE---------------------------------------------------------------
# connection <- DatabaseConnector::connect(connectionDetails)
# cohortTableNames <- CohortGenerator::getCohortTableNames(cohortTable)
# CohortGenerator::createCohortTables(connection = connection,
#                                     cohortDatabaseSchema = cohortDatabaseSchema,
#                                     cohortTableNames = cohortTableNames)
# counts <- CohortGenerator::generateCohortSet(connection = connection,
#                                              cdmDatabaseSchema = cdmDatabaseSchema,
#                                              cohortDatabaseSchema = cohortDatabaseSchema,
#                                              cohortTableNames = cohortTableNames,
#                                              cohortDefinitionSet = cohortDefinitionSet)
# DatabaseConnector::disconnect(connection)

## ----eval=TRUE----------------------------------------------------------------
diclofenac <- 1124300
negativeControls <- c(
  705178, 705944, 710650, 714785, 719174, 719311, 735340, 742185,
  780369, 781182, 924724, 990760, 1110942, 1111706, 1136601,
  1317967, 1501309, 1505346, 1551673, 1560278, 1584910, 19010309,
  40163731
)
giBleed <- 77

exposuresOutcomeList <- list()
exposuresOutcomeList[[1]] <- createExposuresOutcome(
  outcomeId = giBleed,
  exposures = list(createExposure(exposureId = diclofenac))
)
for (exposureId in c(negativeControls)) {
  exposuresOutcome <- createExposuresOutcome(
    outcomeId = giBleed,
    exposures = list(createExposure(exposureId = exposureId, trueEffectSize = 1))
  )
  exposuresOutcomeList[[length(exposuresOutcomeList) + 1]] <- exposuresOutcome
}

## ----eval=TRUE----------------------------------------------------------------
getDbSccsDataArgs <- createGetDbSccsDataArgs(
  deleteCovariatesSmallCount = 100,
  exposureIds = c(),
  maxCasesPerOutcome = 100000
)

createStudyPopulationArgs <- createCreateStudyPopulationArgs(
  naivePeriod = 180,
  firstOutcomeOnly = FALSE
)

covarExposureOfInt <- createEraCovariateSettings(
  label = "Exposure of interest",
  includeEraIds = "exposureId",
  start = 1,
  end = 0,
  endAnchor = "era end",
  profileLikelihood = TRUE,
  exposureOfInterest = TRUE
)

createSccsIntervalDataArgs1 <- createCreateSccsIntervalDataArgs(
  eraCovariateSettings = covarExposureOfInt
)

fitSccsModelArgs <- createFitSccsModelArgs()

## ----eval=TRUE----------------------------------------------------------------
sccsAnalysis1 <- createSccsAnalysis(
  analysisId = 1,
  description = "Simplest model",
  getDbSccsDataArgs = getDbSccsDataArgs,
  createStudyPopulationArgs = createStudyPopulationArgs,
  createIntervalDataArgs = createSccsIntervalDataArgs1,
  fitSccsModelArgs = fitSccsModelArgs
)

## ----eval=TRUE----------------------------------------------------------------
ppis <- c(911735, 929887, 923645, 904453, 948078, 19039926)

covarPreExp <- createEraCovariateSettings(
  label = "Pre-exposure",
  includeEraIds = "exposureId",
  start = -30,
  end = -1,
  endAnchor = "era start",
  preExposure = TRUE
)

covarProphylactics <- createEraCovariateSettings(
  label = "Prophylactics",
  includeEraIds = ppis,
  start = 1,
  end = 0,
  endAnchor = "era end"
)

createSccsIntervalDataArgs2 <- createCreateSccsIntervalDataArgs(
  eraCovariateSettings = list(
    covarExposureOfInt,
    covarPreExp,
    covarProphylactics
  )
)

sccsAnalysis2 <- createSccsAnalysis(
  analysisId = 2,
  description = "Including prophylactics and pre-exposure",
  getDbSccsDataArgs = getDbSccsDataArgs,
  createStudyPopulationArgs = createStudyPopulationArgs,
  createIntervalDataArgs = createSccsIntervalDataArgs2,
  fitSccsModelArgs = fitSccsModelArgs
)

seasonalitySettings <- createSeasonalityCovariateSettings(seasonKnots = 5)

calendarTimeSettings <- createCalendarTimeCovariateSettings(calendarTimeKnots = 5)

createSccsIntervalDataArgs3 <- createCreateSccsIntervalDataArgs(
  eraCovariateSettings = list(
    covarExposureOfInt,
    covarPreExp,
    covarProphylactics
  ),
  seasonalityCovariateSettings = seasonalitySettings,
  calendarTimeCovariateSettings = calendarTimeSettings
)

sccsAnalysis3 <- createSccsAnalysis(
  analysisId = 3,
  description = "Including prophylactics, season, calendar time, and pre-exposure",
  getDbSccsDataArgs = getDbSccsDataArgs,
  createStudyPopulationArgs = createStudyPopulationArgs,
  createIntervalDataArgs = createSccsIntervalDataArgs3,
  fitSccsModelArgs = fitSccsModelArgs
)

covarAllDrugs <- createEraCovariateSettings(
  label = "Other exposures",
  includeEraIds = c(),
  excludeEraIds = "exposureId",
  stratifyById = TRUE,
  start = 1,
  end = 0,
  endAnchor = "era end",
  allowRegularization = TRUE
)

createSccsIntervalDataArgs4 <- createCreateSccsIntervalDataArgs(
  eraCovariateSettings = list(
    covarExposureOfInt,
    covarPreExp,
    covarAllDrugs
  ),
  seasonalityCovariateSettings = seasonalitySettings,
  calendarTimeCovariateSettings = calendarTimeSettings
)

sccsAnalysis4 <- createSccsAnalysis(
  analysisId = 4,
  description = "Including all other drugs",
  getDbSccsDataArgs = getDbSccsDataArgs,
  createStudyPopulationArgs = createStudyPopulationArgs,
  createIntervalDataArgs = createSccsIntervalDataArgs4,
  fitSccsModelArgs = fitSccsModelArgs
)

createSccsIntervalDataArgs5 <- createCreateSccsIntervalDataArgs(
  eraCovariateSettings = list(
    covarExposureOfInt,
    covarPreExp,
    covarProphylactics
  ),
  eventDependentObservation = TRUE
)

sccsAnalysis5 <- createSccsAnalysis(
  analysisId = 5,
  description = "Adjusting for event-dependent obs. end",
  getDbSccsDataArgs = getDbSccsDataArgs,
  createStudyPopulationArgs = createStudyPopulationArgs,
  createIntervalDataArgs = createSccsIntervalDataArgs5,
  fitSccsModelArgs = fitSccsModelArgs
)

## ----eval=TRUE----------------------------------------------------------------
sccsAnalysisList <- list(
  sccsAnalysis1,
  sccsAnalysis2,
  sccsAnalysis3,
  sccsAnalysis4,
  sccsAnalysis5
)

## ----eval=TRUE----------------------------------------------------------------
sccsAnalysesSpecifications <- createSccsAnalysesSpecifications(
  sccsAnalysisList = sccsAnalysisList,
  exposuresOutcomeList = exposuresOutcomeList,
  controlType = "exposure"
)

## ----eval=FALSE---------------------------------------------------------------
# multiThreadingSettings <- createDefaultSccsMultiThreadingSettings(
#   parallel::detectCores() - 1
# )
# 
# referenceTable <- runSccsAnalyses(
#   connectionDetails = connectionDetails,
#   cdmDatabaseSchema = cdmDatabaseSchema,
#   exposureDatabaseSchema = cdmDatabaseSchema,
#   exposureTable = "drug_era",
#   outcomeDatabaseSchema = cohortDatabaseSchema,
#   outcomeTable = cohortTable,
#   outputFolder = outputFolder,
#   sccsMultiThreadingSettings = multiThreadingSettings,
#   sccsAnalysesSpecifications = sccsAnalysesSpecifications
# )

## ----eval=FALSE---------------------------------------------------------------
# sccsModelFile <- referenceTable$sccsModelFile[result$exposureId == diclofenac &
#                                                 referenceTable$outcomeId == giBleed &
#                                                 referenceTable$analysisId == 1]
# sccsModel <- readRDS(file.path(outputFolder, sccsModelFile))
# sccsModel

## ----echo=FALSE,message=FALSE-------------------------------------------------
if (file.exists(file.path(outputFolder, "outcomeModelReference.rds"))) {
  referenceTable <- getFileReference(outputFolder)
  sccsModelFile <- referenceTable$sccsModelFile[referenceTable$exposureId == diclofenac &
                                                  referenceTable$outcomeId == giBleed &
                                                  referenceTable$analysisId == 1]
  sccsModel <- readRDS(file.path(outputFolder, sccsModelFile))
  sccsModel
}

## ----eval=FALSE---------------------------------------------------------------
# referenceTable <- getFileReference(outputFolder)

## ----eval=FALSE---------------------------------------------------------------
# resultsSum <- getResultsSummary(outputFolder)
# head(resultsSum)

## ----echo=FALSE,message=FALSE-------------------------------------------------
if (file.exists(file.path(outputFolder, "outcomeModelReference.rds"))) {
  resultsSum <- getResultsSummary(outputFolder)
  head(resultsSum)
}

## ----eval=FALSE---------------------------------------------------------------
# diagnosticsSum <- getDiagnosticsSummary(outputFolder)
# head(diagnosticsSum)

## ----echo=FALSE,message=FALSE-------------------------------------------------
if (file.exists(file.path(outputFolder, "diagnosticsSummary.rds"))) {
  diagnosticsSum <- getDiagnosticsSummary(outputFolder)
  head(diagnosticsSum)
}

## ----eval=FALSE---------------------------------------------------------------
# install.packages("EmpiricalCalibration")
# library(EmpiricalCalibration)
# 
# # Analysis 1: Simplest model
# analysis1Estimates <-  resultsSum |>
#   inner_join(diagnosticsSum) |>
#   filter(analysisId == 1 & unblind == 1)
# 
# nrow(analysis1Estimates)

## ----echo=FALSE,message=FALSE,warning=FALSE,eval=TRUE-------------------------
if (file.exists(file.path(outputFolder, "outcomeModelReference.rds"))) {
  analysis1Estimates <-  resultsSum |>
    inner_join(diagnosticsSum) |>
    filter(analysisId == 1 & unblind == 1)
  
  nrow(analysis1Estimates)
}

## ----eval=FALSE---------------------------------------------------------------
# # Analysis 2: Including prophylactics and pre-exposure
#   analysis2Estimates <-  resultsSum |>
#     inner_join(diagnosticsSum) |>
#     filter(analysisId == 2 & unblind == 1)
# 
#   nrow(analysis2Estimates)
# )

## ----echo=FALSE,message=FALSE,warning=FALSE,eval=TRUE-------------------------
if (file.exists(file.path(outputFolder, "outcomeModelReference.rds"))) {
  analysis2Estimates <-  resultsSum |>
    inner_join(diagnosticsSum) |>
    filter(analysisId == 2 & unblind == 1)
  
  nrow(analysis2Estimates)
}

## ----eval=FALSE---------------------------------------------------------------
# # Analysis 3: Including prophylactics, season, calendar time, and pre-exposure
#   analysis3Estimates <-  resultsSum |>
#     inner_join(diagnosticsSum) |>
#     filter(analysisId == 3 & unblind == 1)
# 
#   negCons <- analysis3Estimates |>
#     filter(eraId != diclofenac)
#   ei <- negCons <- analysis3Estimates |>
#     filter(eraId == diclofenac)
#   plotCalibrationEffect(
#     logRrNegatives = negCons$logRr,
#     seLogRrNegatives = negCons$seLogRr,
#     logRrPositives = ei$logRr,
#     seLogRrPositives = ei$seLogRr
#   )

## ----echo=FALSE,message=FALSE,warning=FALSE,eval=TRUE-------------------------
if (file.exists(file.path(outputFolder, "outcomeModelReference.rds"))) {
  analysis3Estimates <-  resultsSum |>
    inner_join(diagnosticsSum) |>
    filter(analysisId == 3 & unblind == 1)
  
  negCons <- analysis3Estimates |>
    filter(eraId != diclofenac)
  ei <- analysis3Estimates |>
    filter(eraId == diclofenac)
  plotCalibrationEffect(
    logRrNegatives = negCons$logRr,
    seLogRrNegatives = negCons$seLogRr,
    logRrPositives = ei$logRr,
    seLogRrPositives = ei$seLogRr
  )
}

## ----eval=FALSE---------------------------------------------------------------
# # Analysis 4: Including all other drugs
# negCons <- resultsSum[resultsSum$analysisId == 4 & resultsSum$eraId != diclofenac, ]
# ei <- resultsSum[resultsSum$analysisId == 4 & resultsSum$eraId == diclofenac, ]
# null <- fitNull(
#   negCons$logRr,
#   negCons$seLogRr
# )
# plotCalibrationEffect(
#   logRrNegatives = negCons$logRr,
#   seLogRrNegatives = negCons$seLogRr,
#   logRrPositives = ei$logRr,
#   seLogRrPositives = ei$seLogRr,
#   null
# )

## ----echo=FALSE,message=FALSE,warning=FALSE,eval=TRUE-------------------------
if (file.exists(file.path(outputFolder, "outcomeModelReference.rds"))) {
  analysis4Estimates <-  resultsSum |>
    inner_join(diagnosticsSum) |>
    filter(analysisId == 4 & unblind == 1)
  
  negCons <- analysis4Estimates |>
    filter(eraId != diclofenac)
  ei <- analysis4Estimates |>
    filter(eraId == diclofenac)
  plotCalibrationEffect(
    logRrNegatives = negCons$logRr,
    seLogRrNegatives = negCons$seLogRr,
    logRrPositives = ei$logRr,
    seLogRrPositives = ei$seLogRr
  )
}

## ----eval=FALSE---------------------------------------------------------------
# # Analysis 5: Adjusting for event-dependent obs. end
# nrow(analysis5Estimates)

## ----echo=FALSE,message=FALSE,warning=FALSE,eval=TRUE-------------------------
if (file.exists(file.path(outputFolder, "outcomeModelReference.rds"))) {
   analysis5Estimates <-  resultsSum |>
    inner_join(diagnosticsSum) |>
    filter(analysisId == 5 & unblind == 1)
  
  nrow(analysis5Estimates)
}

## ----eval=TRUE----------------------------------------------------------------
citation("SelfControlledCaseSeries")

## ----eval=TRUE----------------------------------------------------------------
citation("Cyclops")