From 0aa555cddbb4939dc23b3009c3a838a63b8d55c8 Mon Sep 17 00:00:00 2001 From: schuemie Date: Fri, 5 Oct 2018 10:50:49 -0400 Subject: [PATCH] Test deploy LegendMed Central --- LegendMedCentral/DataPulls.R | 496 +++++ LegendMedCentral/LegendMedCentral.Rproj | 13 + LegendMedCentral/MyArticle.Rmd | 722 +++++++ .../MyArticle_cache/latex/__packages | 7 + ...lot_bb844da3fadeafe9509ca9d614b0f16a.RData | Bin 0 -> 2945 bytes ..._plot_bb844da3fadeafe9509ca9d614b0f16a.rdb | 0 ..._plot_bb844da3fadeafe9509ca9d614b0f16a.rdx | Bin 0 -> 113 bytes ...res_6d986e09d41579c8f9ee29fca5436df7.RData | Bin 0 -> 4720 bytes ...tures_6d986e09d41579c8f9ee29fca5436df7.rdb | Bin 0 -> 2244 bytes ...tures_6d986e09d41579c8f9ee29fca5436df7.rdx | Bin 0 -> 131 bytes ...mes_d4ffa24859cd40dfadb04e06d5ea9412.RData | Bin 0 -> 2959 bytes ...comes_d4ffa24859cd40dfadb04e06d5ea9412.rdb | Bin 0 -> 327 bytes ...comes_d4ffa24859cd40dfadb04e06d5ea9412.rdx | Bin 0 -> 131 bytes LegendMedCentral/PlotsAndTables.R | 973 ++++++++++ LegendMedCentral/Sweave.sty | 39 + LegendMedCentral/Table1Specs.csv | 9 + LegendMedCentral/bibliography.bib | 419 +++++ LegendMedCentral/blank_template.tex | 131 ++ LegendMedCentral/dbPaper.rmd | 276 +++ LegendMedCentral/dbPaperPinp.Rmd | 387 ++++ LegendMedCentral/global.R | 25 + .../figure-latex/attrition_plot-1.pdf | Bin 0 -> 5186 bytes .../ijrexoda_files/figure-latex/error.pdf | Bin 0 -> 40444 bytes .../ijrexoda_files/figure-latex/km-1.pdf | Bin 0 -> 24354 bytes .../figure-latex/make_balance-1.pdf | Bin 0 -> 275745 bytes .../ijrexoda_files/figure-latex/make_ps-1.pdf | Bin 0 -> 6445 bytes LegendMedCentral/jss.bst | 1654 +++++++++++++++++ LegendMedCentral/missing.pdf | Bin 0 -> 107067 bytes LegendMedCentral/ohdsi.bib | 167 ++ LegendMedCentral/pnas-markdown.cls | 662 +++++++ LegendMedCentral/pnas-new.cls | 445 +++++ LegendMedCentral/pnas-ohdsi.cls | 445 +++++ LegendMedCentral/pnas.csl | 165 ++ LegendMedCentral/pnasresearcharticle.sty | 50 + LegendMedCentral/server.R | 200 ++ LegendMedCentral/template.Rnw | 787 ++++++++ LegendMedCentral/ui.R | 19 + LegendMedCentral/widetext.sty | 86 + LegendMedCentral/widgets.R | 12 + LegendMedCentral/www/favicon.ico | Bin 0 -> 1150 bytes LegendMedCentral/www/logo.png | Bin 0 -> 52680 bytes 41 files changed, 8189 insertions(+) create mode 100644 LegendMedCentral/DataPulls.R create mode 100644 LegendMedCentral/LegendMedCentral.Rproj create mode 100644 LegendMedCentral/MyArticle.Rmd create mode 100644 LegendMedCentral/MyArticle_cache/latex/__packages create mode 100644 LegendMedCentral/MyArticle_cache/latex/attrition_plot_bb844da3fadeafe9509ca9d614b0f16a.RData create mode 100644 LegendMedCentral/MyArticle_cache/latex/attrition_plot_bb844da3fadeafe9509ca9d614b0f16a.rdb create mode 100644 LegendMedCentral/MyArticle_cache/latex/attrition_plot_bb844da3fadeafe9509ca9d614b0f16a.rdx create mode 100644 LegendMedCentral/MyArticle_cache/latex/features_6d986e09d41579c8f9ee29fca5436df7.RData create mode 100644 LegendMedCentral/MyArticle_cache/latex/features_6d986e09d41579c8f9ee29fca5436df7.rdb create mode 100644 LegendMedCentral/MyArticle_cache/latex/features_6d986e09d41579c8f9ee29fca5436df7.rdx create mode 100644 LegendMedCentral/MyArticle_cache/latex/outcomes_d4ffa24859cd40dfadb04e06d5ea9412.RData create mode 100644 LegendMedCentral/MyArticle_cache/latex/outcomes_d4ffa24859cd40dfadb04e06d5ea9412.rdb create mode 100644 LegendMedCentral/MyArticle_cache/latex/outcomes_d4ffa24859cd40dfadb04e06d5ea9412.rdx create mode 100644 LegendMedCentral/PlotsAndTables.R create mode 100644 LegendMedCentral/Sweave.sty create mode 100644 LegendMedCentral/Table1Specs.csv create mode 100644 LegendMedCentral/bibliography.bib create mode 100644 LegendMedCentral/blank_template.tex create mode 100644 LegendMedCentral/dbPaper.rmd create mode 100644 LegendMedCentral/dbPaperPinp.Rmd create mode 100644 LegendMedCentral/global.R create mode 100644 LegendMedCentral/ijrexoda_files/figure-latex/attrition_plot-1.pdf create mode 100644 LegendMedCentral/ijrexoda_files/figure-latex/error.pdf create mode 100644 LegendMedCentral/ijrexoda_files/figure-latex/km-1.pdf create mode 100644 LegendMedCentral/ijrexoda_files/figure-latex/make_balance-1.pdf create mode 100644 LegendMedCentral/ijrexoda_files/figure-latex/make_ps-1.pdf create mode 100644 LegendMedCentral/jss.bst create mode 100644 LegendMedCentral/missing.pdf create mode 100644 LegendMedCentral/ohdsi.bib create mode 100644 LegendMedCentral/pnas-markdown.cls create mode 100644 LegendMedCentral/pnas-new.cls create mode 100644 LegendMedCentral/pnas-ohdsi.cls create mode 100644 LegendMedCentral/pnas.csl create mode 100644 LegendMedCentral/pnasresearcharticle.sty create mode 100644 LegendMedCentral/server.R create mode 100644 LegendMedCentral/template.Rnw create mode 100644 LegendMedCentral/ui.R create mode 100644 LegendMedCentral/widetext.sty create mode 100644 LegendMedCentral/widgets.R create mode 100644 LegendMedCentral/www/favicon.ico create mode 100644 LegendMedCentral/www/logo.png diff --git a/LegendMedCentral/DataPulls.R b/LegendMedCentral/DataPulls.R new file mode 100644 index 00000000..cbb68181 --- /dev/null +++ b/LegendMedCentral/DataPulls.R @@ -0,0 +1,496 @@ +getExposureName <- function(connection, exposureId) { + sql <- "SELECT exposure_name FROM single_exposure_of_interest WHERE exposure_id = @exposure_id + UNION ALL SELECT exposure_name FROM combi_exposure_of_interest WHERE exposure_id = @exposure_id" + sql <- SqlRender::renderSql(sql, exposure_id = exposureId)$sql + sql <- SqlRender::translateSql(sql, targetDialect = connection@dbms)$sql + exposureName <- querySql(connection, sql) + return(exposureName[1, 1]) +} + +getExposureDescription <- function(connection, exposureId) { + sql <- "SELECT description FROM single_exposure_of_interest WHERE exposure_id = @exposure_id + UNION ALL SELECT exposure_name FROM combi_exposure_of_interest WHERE exposure_id = @exposure_id" + sql <- SqlRender::renderSql(sql, exposure_id = exposureId)$sql + sql <- SqlRender::translateSql(sql, targetDialect = connection@dbms)$sql + exposureDescription <- querySql(connection, sql) + return(exposureDescription[1, 1]) +} + +getOutcomeName <- function(connection, outcomeId) { + sql <- "SELECT outcome_name FROM outcome_of_interest WHERE outcome_id = @outcome_id" + sql <- SqlRender::renderSql(sql, outcome_id = outcomeId)$sql + sql <- SqlRender::translateSql(sql, targetDialect = connection@dbms)$sql + outcomeName <- querySql(connection, sql) + return(outcomeName[1, 1]) +} + +getIndications <- function(connection) { + sql <- "SELECT indication_id, indication_name FROM indication" + sql <- SqlRender::translateSql(sql, targetDialect = connection@dbms)$sql + indications <- querySql(connection, sql) + colnames(indications) <- SqlRender::snakeCaseToCamelCase(colnames(indications)) + return(indications) +} + +getSubgroups <- function(connection) { + sql <- "SELECT DISTINCT interaction_covariate_id AS subgroup_id, covariate_name AS subgroup_name + FROM ( + SELECT DISTINCT interaction_covariate_id + FROM cm_interaction_result + ) ids + INNER JOIN covariate + ON interaction_covariate_id = covariate_id" + sql <- SqlRender::translateSql(sql, targetDialect = connection@dbms)$sql + subgroups <- querySql(connection, sql) + colnames(subgroups) <- SqlRender::snakeCaseToCamelCase(colnames(subgroups)) + subgroups$subgroupName <- gsub("Subgroup: ", "", subgroups$subgroupName) + return(subgroups) +} + + +getExposures <- function(connection, filterByCmResults = TRUE) { + sql <- "SELECT * FROM ( + SELECT exposure_id, exposure_name, indication_id FROM single_exposure_of_interest + UNION ALL SELECT exposure_id, exposure_name, indication_id FROM combi_exposure_of_interest + ) exposure + INNER JOIN exposure_group + ON exposure.exposure_id = exposure_group.exposure_id + {@filter_by_cm_results} ? { + INNER JOIN exposure_ids + ON exposure_ids.exposure_id = exposure.exposure_id + } + ;" + sql <- SqlRender::renderSql(sql, filter_by_cm_results = filterByCmResults)$sql + sql <- SqlRender::translateSql(sql, targetDialect = connection@dbms)$sql + exposures <- querySql(connection, sql) + colnames(exposures) <- SqlRender::snakeCaseToCamelCase(colnames(exposures)) + return(exposures) +} + +getOutcomes <- function(connection) { + sql <- "SELECT outcome_id, outcome_name, indication_id FROM outcome_of_interest" + sql <- SqlRender::translateSql(sql, targetDialect = connection@dbms)$sql + outcomes <- querySql(connection, sql) + colnames(outcomes) <- SqlRender::snakeCaseToCamelCase(colnames(outcomes)) + return(outcomes) +} + +getAnalyses <- function(connection) { + sql <- "SELECT analysis_id, description FROM cohort_method_analysis" + sql <- SqlRender::translateSql(sql, targetDialect = connection@dbms)$sql + analyses <- querySql(connection, sql) + colnames(analyses) <- SqlRender::snakeCaseToCamelCase(colnames(analyses)) + return(analyses) +} + +getDatabases <- function(connection) { + sql <- "SELECT * FROM database" + sql <- SqlRender::translateSql(sql, targetDialect = connection@dbms)$sql + databases <- querySql(connection, sql) + colnames(databases) <- SqlRender::snakeCaseToCamelCase(colnames(databases)) + return(databases) +} + +getDatabaseDetails <- function(connection, databaseId) { + sql <- "SELECT * FROM database WHERE database_id = '@database_id'" + sql <- SqlRender::renderSql(sql, database_id = databaseId)$sql + sql <- SqlRender::translateSql(sql, targetDialect = connection@dbms)$sql + databaseDetails <- querySql(connection, sql) + colnames(databaseDetails) <- SqlRender::snakeCaseToCamelCase(colnames(databaseDetails)) + databaseDetails$description <- sub("\\n", " ", databaseDetails$description) + databaseDetails$description <- sub("JDMC", "JMDC", databaseDetails$description) # TODO Fix in schema + return(databaseDetails) +} + +getIndicationForExposure <- function(connection, + exposureIds = c()) { + sql <- "SELECT exposure_id, indication_id FROM single_exposure_of_interest WHERE" + sql <- paste(sql, paste0("exposure_id IN (", paste(exposureIds, collapse = ", "), ")")) + + sql <- SqlRender::translateSql(sql, targetDialect = connection@dbms)$sql + indications <- querySql(connection, sql) + colnames(indications) <- SqlRender::snakeCaseToCamelCase(colnames(indications)) + return(indications) +} + +getTcoDbs <- function(connection, + targetIds = c(), + comparatorIds = c(), + outcomeIds = c(), + databaseIds = c(), + operator = "AND") { + sql <- "SELECT target_id, comparator_id, outcome_id, database_id FROM cohort_method_result WHERE analysis_id = 1" + parts <- c() + if (length(targetIds) != 0) { + parts <- c(parts, paste0("target_id IN (", paste(targetIds, collapse = ", "), ")")) + } + if (length(comparatorIds) != 0) { + parts <- c(parts, paste0("comparator_id IN (", paste(comparatorIds, collapse = ", "), ")")) + } + if (length(outcomeIds) != 0) { + parts <- c(parts, paste0("outcome_id IN (", paste(outcomeIds, collapse = ", "), ")")) + } + if (length(databaseIds) != 0) { + parts <- c(parts, paste0("database_id IN ('", paste(databaseIds, collapse = "', '"), "')")) + } + if (length(parts) != 0) { + if (operator == "AND") { + sql <- paste(sql, "AND", paste(parts, collapse = " AND ")) + } else { + sql <- paste(sql, "AND", paste(parts, collapse = " OR ")) + } + } + sql <- SqlRender::translateSql(sql, targetDialect = connection@dbms)$sql + tcoDbs <- querySql(connection, sql) + colnames(tcoDbs) <- SqlRender::snakeCaseToCamelCase(colnames(tcoDbs)) + return(tcoDbs) +} + +getTcoDbsStrict <- function(connection, exposureIds = c(), outcomeIds = c(), databaseIds = c()) { + sql <- "SELECT target_id, comparator_id, outcome_id, database_id FROM cohort_method_result WHERE analysis_id = 1" + parts <- c() + if (length(exposureIds) != 0) { + for (exposureId in exposureIds) { + parts <- c(parts, + paste0("(target_id = ", exposureId, " OR comparator_id = ", exposureId, ")")) + } + } + if (length(outcomeIds) != 0) { + parts <- c(parts, paste0("outcome_id IN (", paste(outcomeIds, collapse = ", "), ")")) + } + if (length(databaseIds) != 0) { + parts <- c(parts, paste0("database_id IN ('", paste(databaseIds, collapse = "', '"), "')")) + } + if (length(parts) != 0) { + sql <- paste(sql, "AND", paste(parts, collapse = " AND ")) + } + sql <- SqlRender::translateSql(sql, targetDialect = connection@dbms)$sql + tcoDbs <- querySql(connection, sql) + colnames(tcoDbs) <- SqlRender::snakeCaseToCamelCase(colnames(tcoDbs)) + return(tcoDbs) +} + +getMainResults <- function(connection, + targetIds = c(), + comparatorIds = c(), + outcomeIds = c(), + databaseIds = c(), + analysisIds = c(), + estimatesOnly = FALSE) { + if (estimatesOnly) { + sql <- "SELECT calibrated_log_rr, calibrated_se_log_rr, calibrated_ci_95_lb, calibrated_ci_95_ub FROM cohort_method_result" + } else { + sql <- "SELECT * FROM cohort_method_result" + } + parts <- c() + if (length(targetIds) != 0) { + parts <- c(parts, paste0("target_id IN (", paste(targetIds, collapse = ", "), ")")) + } + if (length(comparatorIds) != 0) { + parts <- c(parts, paste0("comparator_id IN (", paste(comparatorIds, collapse = ", "), ")")) + } + if (length(outcomeIds) != 0) { + parts <- c(parts, paste0("outcome_id IN (", paste(outcomeIds, collapse = ", "), ")")) + } + if (length(databaseIds) != 0) { + parts <- c(parts, paste0("database_id IN ('", paste(databaseIds, collapse = "', '"), "')")) + } + if (length(analysisIds) != 0) { + parts <- c(parts, paste0("analysis_id IN ('", paste(analysisIds, collapse = "', '"), "')")) + } + if (length(parts) != 0) { + sql <- paste(sql, "WHERE", paste(parts, collapse = " AND ")) + } + sql <- SqlRender::translateSql(sql, targetDialect = connection@dbms)$sql + results <- querySql(connection, sql) + colnames(results) <- SqlRender::snakeCaseToCamelCase(colnames(results)) + return(results) +} + +getSubgroupResults <- function(connection, + targetIds = c(), + comparatorIds = c(), + outcomeIds = c(), + databaseIds = c(), + analysisIds = c(), + subgroupIds = c(), + estimatesOnly = FALSE) { + if (estimatesOnly) { + sql <- " + SELECT ci_95_lb, + ci_95_ub, + log_rrr, + se_log_rrr + FROM cm_interaction_result + " + } else { + sql <- "SELECT target_id, + comparator_id, + outcome_id, + cm_interaction_result.analysis_id, + cohort_method_analysis.description AS analysis_description, + cm_interaction_result.database_id, + interaction_covariate_id, + covariate_name AS interaction_covariate_name, + rrr, + ci_95_lb, + ci_95_ub, + p, + calibrated_p, + i_2, + log_rrr, + se_log_rrr, + target_subjects, + comparator_subjects, + target_days, + comparator_days, + target_outcomes, + comparator_outcomes + FROM cm_interaction_result + INNER JOIN covariate + ON cm_interaction_result.interaction_covariate_id = covariate.covariate_id + AND cm_interaction_result.database_id = covariate.database_id + INNER JOIN cohort_method_analysis + ON cm_interaction_result.analysis_id = cohort_method_analysis.analysis_id" + } + parts <- c() + if (length(targetIds) != 0) { + parts <- c(parts, paste0("target_id IN (", paste(targetIds, collapse = ", "), ")")) + } + if (length(comparatorIds) != 0) { + parts <- c(parts, paste0("comparator_id IN (", paste(comparatorIds, collapse = ", "), ")")) + } + if (length(outcomeIds) != 0) { + parts <- c(parts, paste0("outcome_id IN (", paste(outcomeIds, collapse = ", "), ")")) + } + if (length(databaseIds) != 0) { + parts <- c(parts, paste0("cm_interaction_result.database_id IN ('", + paste(databaseIds, collapse = "', '"), + "')")) + } + if (length(analysisIds) != 0) { + parts <- c(parts, paste0("cm_interaction_result.analysis_id IN (", paste(analysisIds, collapse = ", "), ")")) + } + if (length(subgroupIds) != 0) { + parts <- c(parts, paste0("interaction_covariate_id IN (", paste(subgroupIds, collapse = ", "), ")")) + } + + if (length(parts) != 0) { + sql <- paste(sql, "WHERE", paste(parts, collapse = " AND ")) + } + sql <- SqlRender::translateSql(sql, targetDialect = connection@dbms)$sql + results <- querySql(connection, sql) + colnames(results) <- SqlRender::snakeCaseToCamelCase(colnames(results)) + return(results) +} + +getControlResults <- function(connection, targetId, comparatorId, analysisId, databaseId) { + sql <- "SELECT * + FROM cohort_method_result + INNER JOIN ( + SELECT outcome_id, + outcome_name, + CAST(1 AS FLOAT) AS effect_size + FROM negative_control_outcome + + UNION ALL + + SELECT outcome_id, + outcome_name, + effect_size + FROM positive_control_outcome + ) outcomes + ON cohort_method_result.outcome_id = outcomes.outcome_id + WHERE target_id = @target_id + AND comparator_id = @comparator_id + AND database_id = '@database_id' + AND analysis_id = @analysis_id" + sql <- SqlRender::renderSql(sql, + target_id = targetId, + comparator_id = comparatorId, + database_id = databaseId, + analysis_id = analysisId)$sql + results <- querySql(connection, sql) + colnames(results) <- SqlRender::snakeCaseToCamelCase(colnames(results)) + return(results) +} + +getCmFollowUpDist <- function(connection, + targetId, + comparatorId, + outcomeId, + databaseId, + analysisId) { + sql <- "SELECT target_min_days, + target_p10_days, + target_p25_days, + target_median_days, + target_p75_days, + target_p90_days, + target_max_days, + comparator_min_days, + comparator_p10_days, + comparator_p25_days, + comparator_median_days, + comparator_p75_days, + comparator_p90_days, + comparator_max_days + FROM cm_follow_up_dist + WHERE target_id = @target_id + AND comparator_id = @comparator_id + AND outcome_id = @outcome_id + AND database_id = '@database_id' + AND analysis_id = @analysis_id" + sql <- SqlRender::renderSql(sql, + target_id = targetId, + comparator_id = comparatorId, + outcome_id = outcomeId, + database_id = databaseId, + analysis_id = analysisId)$sql + sql <- SqlRender::translateSql(sql, targetDialect = connection@dbms)$sql + followUpDist <- querySql(connection, sql) + colnames(followUpDist) <- SqlRender::snakeCaseToCamelCase(colnames(followUpDist)) + return(followUpDist) +} + +getCovariateBalance <- function(connection, + targetId, + comparatorId, + databaseId, + analysisId, + outcomeId = NULL) { + sql <- "SELECT covariate.covariate_id, covariate_name, covariate_analysis_id, + target_mean_before, + comparator_mean_before, + std_diff_before, + target_mean_after, + comparator_mean_after, + std_diff_after + FROM covariate_balance + INNER JOIN covariate + ON covariate_balance.covariate_id = covariate.covariate_id + AND covariate_balance.database_id = covariate.database_id + WHERE target_id = @target_id + AND comparator_id = @comparator_id + AND covariate.database_id = '@database_id' + AND analysis_id = @analysis_id + AND interaction_covariate_id IS NULL + {@outcome_id == \"\"} ? {AND outcome_id IS NULL} : {AND outcome_id = @outcome_id}" + sql <- SqlRender::renderSql(sql, + target_id = targetId, + comparator_id = comparatorId, + database_id = databaseId, + analysis_id = analysisId, + outcome_id = outcomeId)$sql + sql <- SqlRender::translateSql(sql, targetDialect = connection@dbms)$sql + balance <- querySql(connection, sql) + colnames(balance) <- c("covariateId", + "covariateName", + "analysisId", + "beforeMatchingMeanTreated", + "beforeMatchingMeanComparator", + "beforeMatchingStdDiff", + "afterMatchingMeanTreated", + "afterMatchingMeanComparator", + "afterMatchingStdDiff") + balance$absBeforeMatchingStdDiff <- abs(balance$beforeMatchingStdDiff) + balance$absAfterMatchingStdDiff <- abs(balance$afterMatchingStdDiff) + return(balance) +} + +getPs <- function(connection, targetIds, comparatorIds, databaseId) { + sql <- "SELECT target_id, + comparator_id, + preference_score, + target_density, + comparator_density + FROM preference_score_dist + WHERE target_id IN (@target_ids) + AND comparator_id IN (@comparator_ids) + AND database_id = '@database_id'" + sql <- SqlRender::renderSql(sql, + target_ids = targetIds, + comparator_ids = comparatorIds, + database_id = databaseId)$sql + sql <- SqlRender::translateSql(sql, targetDialect = connection@dbms)$sql + ps <- querySql(connection, sql) + colnames(ps) <- SqlRender::snakeCaseToCamelCase(colnames(ps)) + return(ps) +} + +getKaplanMeier <- function(connection, targetId, comparatorId, outcomeId, databaseId, analysisId) { + sql <- "SELECT time, + target_at_risk, + comparator_at_risk, + target_survival, + target_survival_lb, + target_survival_ub, + comparator_survival, + comparator_survival_lb, + comparator_survival_ub + FROM kaplan_meier_dist + WHERE target_id = @target_id + AND comparator_id = @comparator_id + AND outcome_id = @outcome_id + AND database_id = '@database_id' + AND analysis_id = @analysis_id" + sql <- SqlRender::renderSql(sql, + target_id = targetId, + comparator_id = comparatorId, + outcome_id = outcomeId, + database_id = databaseId, + analysis_id = analysisId)$sql + sql <- SqlRender::translateSql(sql, targetDialect = connection@dbms)$sql + ps <- querySql(connection, sql) + colnames(ps) <- SqlRender::snakeCaseToCamelCase(colnames(ps)) + return(ps) +} + +getAttrition <- function(connection, targetId, comparatorId, outcomeId, analysisId, databaseId) { + sql <- "SELECT exposure_id, + sequence_number, + description, + subjects + FROM attrition + WHERE (target_id IS NULL OR target_id = @target_id) + AND (comparator_id IS NULL OR comparator_id = @comparator_id) + AND (outcome_id IS NULL OR outcome_id = @outcome_id) + AND (exposure_id = @target_id OR exposure_id = @comparator_id) + AND (analysis_id IS NULL OR analysis_id = @analysis_id) + AND database_id = '@database_id'" + sql <- SqlRender::renderSql(sql, + target_id = targetId, + comparator_id = comparatorId, + outcome_id = outcomeId, + analysis_id = analysisId, + database_id = databaseId)$sql + sql <- SqlRender::translateSql(sql, targetDialect = connection@dbms)$sql + attrition <- querySql(connection, sql) + colnames(attrition) <- SqlRender::snakeCaseToCamelCase(colnames(attrition)) + targetAttrition <- attrition[attrition$exposureId == targetId, ] + comparatorAttrition <- attrition[attrition$exposureId == comparatorId, ] + colnames(targetAttrition)[colnames(targetAttrition) == "subjects"] <- "targetPersons" + targetAttrition$exposureId <- NULL + colnames(comparatorAttrition)[colnames(comparatorAttrition) == "subjects"] <- "comparatorPersons" + comparatorAttrition$exposureId <- NULL + attrition <- merge(targetAttrition, comparatorAttrition) + attrition <- attrition[order(attrition$sequenceNumber), ] + return(attrition) +} + +getStudyPeriod <- function(connection, targetId, comparatorId, databaseId) { + sql <- "SELECT min_date, + max_date + FROM comparison_summary + WHERE target_id = @target_id + AND comparator_id = @comparator_id + AND database_id = '@database_id'" + sql <- SqlRender::renderSql(sql, + target_id = targetId, + comparator_id = comparatorId, + database_id = databaseId)$sql + sql <- SqlRender::translateSql(sql, targetDialect = connection@dbms)$sql + studyPeriod <- querySql(connection, sql) + colnames(studyPeriod) <- SqlRender::snakeCaseToCamelCase(colnames(studyPeriod)) + return(studyPeriod) +} diff --git a/LegendMedCentral/LegendMedCentral.Rproj b/LegendMedCentral/LegendMedCentral.Rproj new file mode 100644 index 00000000..8e3c2ebc --- /dev/null +++ b/LegendMedCentral/LegendMedCentral.Rproj @@ -0,0 +1,13 @@ +Version: 1.0 + +RestoreWorkspace: Default +SaveWorkspace: Default +AlwaysSaveHistory: Default + +EnableCodeIndexing: Yes +UseSpacesForTab: Yes +NumSpacesForTab: 2 +Encoding: UTF-8 + +RnwWeave: Sweave +LaTeX: pdfLaTeX diff --git a/LegendMedCentral/MyArticle.Rmd b/LegendMedCentral/MyArticle.Rmd new file mode 100644 index 00000000..49cf5aca --- /dev/null +++ b/LegendMedCentral/MyArticle.Rmd @@ -0,0 +1,722 @@ +--- +params: + databaseId: "CCAE" + targetId: 1308842 + comparatorId: 40226742 + outcomeId: 2 + indicationId: "Hypertension" + root: "." + primary: 1 + ot: 1 + itt: 2 + matchOt: 3 + matchItt: 4 + title: "Acute myocardial infarction risk in new-users of valsartan versus olmesartan for hypertension in the JMDC database" + abstract: "We conduct a large-scale study on the incidence of acute myocardial infarction among new users of valsartan and olmesartan from 2006 to 2017 in the JMDC database. Outcomes of interest are estimates of the hazard ratio (HR) for incident events between comparable new users under on-treatment and intent-to-treat risk window assumptions. Secondary analyses entertain possible clinically relevant subgroup interaction with the HR. We identify 7316 valsartan and 9744 olmesartan patients for the on-treatment design, totaling 9093 and 9673 patient-years of observation, and 11 and 16 events respectively. We control for measured confounding using propensity score trimming and stratification or matching based on an expansive propensity score model that includes all measured patient features before treatment initiation. We account for unmeasured confounding using negative and positive controls to estimate and adjust for residual systematic bias in the study design and data source, providing calibrated confidence intervals and p-values. In terms of acute myocardial infarction, valsartan has a similar risk as compared to olmesartan [HR: 0.88, 95% confidence interval (CI) 0.39 - 2.01]." + save: NULL + load: NULL + +title: "`r params$title`" + +# Corresponding author: Martijn J. Schuemie, Janssen R&D, 1125 Trenton Harbourton Road, Titusville, NJ, 08560, Phone: +31 631793897, schuemie@ohdsi.org +author: + + - name: Martijn J. Schuemie + affiliation: a,b,c + - name: Patrick B. Ryan + affiliation: a,b,d + - name: Seng Chan You + affiliation: a,e + - name: Nicole Pratt + affiliation: a,f + - name: David Madigan + affiliation: a,g + - name: George Hripcsak + affiliation: a,d + - name: Marc A. Suchard + affiliation: a,c,h,i +address: + - code: a + address: Observational Health Data Sciences and Informatics, New York, NY, USA + - code: b + address: Janssen Research & Development, Titusville, NJ, USA + - code: c + address: Department of Biostatistics, University of California, Los Angeles, CA + - code: d + address: Department of Biomedical Informatics, Columbia University, New York, NY + - code: e + address: Department of Biomedical Informatics, Ajou University, Suwon, South Korea + - code: f + address: Sansom Institute, University of South Australia, Adelaide SA, Australia + - code: g + address: Department of Statistics, Columbia University, New York, NY + - code: h + address: Department of Biomathematics, University of California, Los Angeles, CA + - code: i + address: Department of Human Genetics, University of California, Los Angeles, CA +lead_author_surname: Schuemie et al. + +# Place DOI URL or CRAN Package URL here +# doi: "https://cran.r-project.org/package=YourPackage" + +# Abstract +abstract: "`r params$abstract`" + +# Optional: Acknowledgements +# acknowledgements: | +# This template package builds upon, and extends, the work of the excellent +# [rticles](https://cran.r-project.org/package=rticles) package, and both packages rely on the +# [PNAS LaTeX](http://www.pnas.org/site/authors/latex.xhtml) macros. Both these sources are +# gratefully acknowledged as this work would not have been possible without them. Our extensions +# are under the same respective licensing term +# ([GPL-3](https://www.gnu.org/licenses/gpl-3.0.en.html) and +# [LPPL (>= 1.3)](https://www.latex-project.org/lppl/)). + +# Optional: One or more keywords +keywords: + - new-user cohort design + - comparative effectiveness + - drug safety + +# Paper size for the document, values of letterpaper and a4paper +papersize: letter + +# Font size of the document, values of 9pt (default), 10pt, 11pt and 12pt +fontsize: 9pt + +# Optional: Force one-column layout, default is two-column +#one_column: true + +# Optional: Enables lineno mode, but only if one_column mode is also true +#lineno: true + +# Optional: Enable one-sided layout, default is two-sided +#one_sided: true + +# Optional: Enable section numbering, default is unnumbered +#numbersections: true + +# Optional: Specify the depth of section number, default is 5 +#secnumdepth: 5 + +# Optional: Skip inserting final break between acknowledgements, default is false +skip_final_break: true + +# Optional: Bibliography +# bibliography: pinp + +# Optional: Enable a 'Draft' watermark on the document +watermark: true + +# Customize footer, eg by referencing the vignette +footer_contents: OHDSI version 1.0 + +# Produce a pinp document +output: + pdf_document: + template: blank_template.tex + citation_package: natbib +pnas_type: pnasresearcharticle +bibliography: ohdsi.bib +#csl: pnas.csl +#output: rticles::pnas_article + +author_declaration: MJS and PBR are employees and share-holders of Janssen Research. MAS receives contract support from Janssen Research. + +# Required: Vignette metadata for inclusion in a package. +vignette: > + %\VignetteIndexEntry{YourPackage-vignetteentry} + %\VignetteKeywords{YourPackage, r, anotherkeyword} + %\VignettePackage{YourPackage} + %\VignetteEngine{knitr::rmarkdown} + +--- + +```{r, setup, echo=FALSE, message=FALSE,comment=FALSE,warning=FALSE} +library(DatabaseConnector) +library(knitr) +library(xtable) +library(ggplot2) +# library(kableExtra) +source("DataPulls.R") +source("PlotsAndTables.R") +options(knitr.kable.NA = '') + +extraCriteria <- list( + depression = "Further, we exclude patients with diagnoses of bipolar disorder or schizophrenia on or prior to their index date." +) + +extraCovariates <- list( + depression = "Prior number of depression treatments (1, 2, 3, 4, 5 or higher)" +) + +negativeControls <- list( + hypertension = 76 +) + +totalOutcomes <- list( + hypertension = 57 +) + +totalExposures <- list( + hypertension = "56 different anti-hypertensive medications, representing 15 different drug-class levels and 7 major drug class levels", + stuff = "at least 2500 patients in both target and comparator cohors" +) + +# params <- list(databaseId = "CCAE", +# targetId = 1308842, +# comparatorId = 40226742, +# outcomeId = 2, +# indicationId = "Hypertension", +# root = ".", +# primary = 1, +# ot = 1, +# itt = 2, +# matchOt = 3, +# matchItt = 4, +# title = "Acute myocardial infarction risk in new-users of valsartan versus olmesartan for hypertension in the JMDC database", +# abstract = "We conduct a large-scale study on the incidence of acute myocardial infarction among new users of valsartan and olmesartan from 2006 to 2017 in the JMDC database. Outcomes of interest are estimates of the hazard ratio (HR) for incident events between comparable new users under on-treatment and intent-to-treat risk window assumptions. Secondary analyses entertain possible clinically relevant subgroup interaction with the HR. We identify 7316 valsartan and 9744 olmesartan patients for the on-treatment design, totaling 9093 and 9673 patient-years of observation, and 11 and 16 events respectively. We control for measured confounding using propensity score trimming and stratification or matching based on an expansive propensity score model that includes all measured patient features before treatment initiation. We account for unmeasured confounding using negative and positive controls to estimate and adjust for residual systematic bias in the study design and data source, providing calibrated confidence intervals and p-values. In terms of acute myocardial infarction, valsartan has a similar risk as compared to olmesartan [HR: 0.88, 95% confidence interval (CI) 0.39 - 2.01].") + +``` + +```{r, loadData, echo=FALSE, message=FALSE, comment=FALSE, warning=FALSE, results='hide'} + +if (is.null(params$load)) { + connectionDetails <- createConnectionDetails(dbms = "postgresql", + server = paste(Sys.getenv("legendServer"), + Sys.getenv("legendDatabase"), sep = "/"), + port = Sys.getenv("legendPort"), + user = Sys.getenv("legendUser"), + password = Sys.getenv("legendPw"), + schema = Sys.getenv("legendSchema")) + connection <- connect(connectionDetails) + + targetName <- getExposureName(connection = connection, exposureId = params$targetId) + comparatorName <- getExposureName(connection = connection, exposureId = params$comparatorId) + outcomeName <- getOutcomeName(connection = connection, outcomeId = params$outcomeId) + analyses <- getAnalyses(connection = connection) + databaseDetails <- getDatabaseDetails(connection = connection, + databaseId = params$databaseId) + studyPeriod <- getStudyPeriod(connection = connection, + targetId = params$targetId, + comparatorId = params$comparatorId, + databaseId = params$databaseId) + + mainResults <- getMainResults(connection = connection, + targetIds = params$targetId, + comparatorIds = params$comparatorId, + outcomeIds = params$outcomeId, + databaseIds = params$databaseId, + analysisIds = c(1, 2, 3, 4)) + + subgroupResults <- getSubgroupResults(connection = connection, + targetIds = params$targetId, + comparatorIds = params$comparatorId, + outcomeIds = params$outcomeId, + databaseIds = params$databaseId) + + controlResults <- getControlResults(connection = connection, + targetId = params$targetId, + comparatorId = params$comparatorId, + analysisId = 1, + databaseId = params$databaseId) + + attrition <- getAttrition(connection = connection, + targetId = params$targetId, + comparatorId = params$comparatorId, + outcomeId = params$outcomeId, + analysisId = 1, + databaseId = params$databaseId) + + followUpDist <- getCmFollowUpDist(connection = connection, + targetId = params$targetId, + comparatorId = params$comparatorId, + outcomeId = params$outcomeId, + databaseId = params$databaseId, + analysisId = 1) + + balance <- getCovariateBalance(connection = connection, + targetId = params$targetId, + comparatorId = params$comparatorId, + databaseId = params$databaseId, + analysisId = 2) + + popCharacteristics <- getCovariateBalance(connection = connection, + targetId = params$targetId, + comparatorId = params$comparatorId, + databaseId = params$databaseId, + analysisId = 1, + outcomeId = params$outcomeId) + + ps <- getPs(connection = connection, + targetIds = params$targetId, + comparatorIds = params$comparatorId, + databaseId = params$databaseId) + + kaplanMeier <- getKaplanMeier(connection = connection, + targetId = params$targetId, + comparatorId = params$comparatorId, + outcomeId = params$outcomeId, + databaseId = params$databaseId, + analysisId = 2) + + DatabaseConnector::disconnect(connection) + + if (!is.null(params$save)) { + save(targetName, comparatorName, outcomeName, analyses, databaseDetails, + studyPeriod, mainResults, subgroupResults, controlResults, + attrition, followUpDist, balance, popCharacteristics, ps, kaplanMeier, + file = params$save) + } +} else { + load(params$load) +} + +targetName <- uncapitalize(targetName) +comparatorName <- uncapitalize(comparatorName) +outcomeName <- uncapitalize(outcomeName) +indicationName <- uncapitalize(params$indicationId) + +databaseName <- databaseDetails$databaseName + +minYear <- substr(studyPeriod$minDate, 1, 4) +maxYear <- substr(studyPeriod$maxDate, 1, 4) + +coverage <- getCoverage(controlResults) +``` + +\dropcap{T}he Large-scale Evidence Generation and Evaluation in a Network of Databases (LEGEND) project aims to generate reliable evidence on the effects of medical interventions using observational healthcare data to support clinical decision making. +LEGEND follows ten guiding principles (see [Supporting Information](#suppinfo)); chief among these stand that we generate evidence at large-scale to achieve completeness and faciliate analysis of the overall distribution of effect size estimates across treatments and outcomes. +We also generate evidence consistently by applying a systematic approach across all research questions and disseminate evidence regardless on the estimates effects to avoid publication bias. These aims help overcome the questionable reliable of observational research \citep{schuemie2018improving}. +This LEGEND document reports the risk of `r outcomeName` between new users of `r targetName` and `r comparatorName` treated for `r params$indicationId`. + +\begin{itemize} + \item Add short introduction to indication. +\end{itemize} + + + + + + + + + + + + + + + + + + + + +# Methods + +## Data source + +We conduct a new-user cohort study comparing new users of `r targetName` with new users of `r comparatorName` in the `r databaseName` (`r params$databaseId`) database encoded in the Observational Medical Outcomes Partnership (OMOP) common data model (CDM) version 5 +\citep{hripcsak2015observational,overhage2012validation,ryan2013empirical}. +`r sub(paste0(".*\\(",databaseDetails$databaseId,"\\)"), paste0("The ", databaseDetails$databaseId), databaseDetails$description)` +The study period spans from `r studyPeriod$minDate` to `r studyPeriod$maxDate`. + +## Study design + +This study follows a retrospective, observational, comparative cohort design \citep{ryan2013empirical} +. +We include patients who are first time users of `r targetName` or `r comparatorName`, and who have a diagnosis of `r indicationName` on or prior to treatment initation. +We require that patients have continuous observation in the database for at least 365 days prior to treatment initiation. +We exclude patients with prior `r outcomeName` events and less than 1 day at risk. `r if (indicationName %in% names(extraCriteria)) { extraCriteria[indicationName] }` Links to full cohort details, include concept codes, are provided in the [Supporting Information](#suppinfo). +The outcome of interest is `r outcomeName`. +We begin the outcome risk window 1 day after treatment initation and consider two design choices to define the window end. +First, we end the outcome time-at-risk window at first cessation of continuous drug exposure, analogous to an on-treatment design and, second, we end the outcome time-at-risk window when the patient is no longer observable in the database, analogous to an intent-to-treat design. +Continuous drug exposures are constructed from the available longitudinal data by considering sequential prescriptions that have fewer than 30 days gap between prescriptions. + +## Statistical analysis + +We conduct our cohort study using the open-source OHDSI CohortMethod R package \citep{schuemie2018cohortmethod} +, with large-scale analytics achieved through the Cyclops R package \citep{suchard2013massive} +. +We use propensity scores (PSs) -- estimates of treatment exposure probability conditional on pre-treatment baseline features in the one year prior to treatment initiation -- to control for potential measured confoudning and improve balance between the target (`r targetName`) and comparator (`r comparatorName`) cohorts \citep{rosenbaum1983central} +. +We use an expansive PS model that includes all available patient demographics, drug, condition and procedure covariates generated through the FeatureExtraction R package \citep{schuemie2018featureextration} + instead of a prespecified set of investigator-selected confounders. + We perform PS stratification or variable-ratio matching and then estimate comparative `r targetName`-vs-`r comparatorName` hazard ratios (HRs) using a Cox proportional hazards model. + Detailed covariate and methods informations are provided in the + [Supporting Information](#suppinfo). + We present PS and covariate balance metrics to assess successful confounding control, and provide HR estimates and Kaplan-Meier survival plots for the outcome of `r outcomeName`. + We additionally estimate HRs for pre-specified subgroups to evaluate interactions with the treatment effect. +For efficiency reasons, we fit subgroup Cox models using PS stratification only. + +Residual study bias from unmeasured and systematic sources can exist in observational studies after controlling for measured confounding \citep{schuemie2014interpreting,schuemie2016robust} +. +To estimate such residual bias, we conduct negative control outcome experiments with `r length(unique(controlResults$outcomeName))` negative control outcomes +identified through a data-rich algorithm \citep{voss2017accuracy}. +We fit the negative control estimates to an empirical null distribution that characterizes the study residual bias and is an important artifact from which to assess the study design \citep{schuemie2018improving} +. +Using the empirical null distribution and synthetic positive controls \citep{schuemie2018empirical} +, we additionally calibrate all HR estimates, their 95\% confidence intervals (CIs) and the $p$-value to reject the null hypothesis of no differential effect (HR = 1). +Empirical calibration serves as an important diagnostic tool to evaluate if residual systematic error is sufficient to cast doubt on the accuracy of the unknown effect estimate. + +# Results + +## Population characteristics + +```{r, attrition_plot, echo=FALSE, cache=TRUE, warning=FALSE, fig.align="center", fig.width=6, fig.height=10, out.width = '90%', fig.cap=paste("\\textbf{Attrition diagram for selecting new-users of", targetName, "and", comparatorName, "from the", params$databaseId, "database.\\label{fig:attrition}}")} +drawAttritionDiagram(attrition, targetName, comparatorName) +``` + +Figure \ref{fig:attrition} diagrams the inclusion of study subjects from the `r params$databaseId` database under the on-treatment with stratification design. +We augment these counts with cohort sizes we identify for the remaining designs in Table \ref{tab:power}. +This table also reports total patient follow-up time, numbers of `r outcomeName` events these patients experience and unadjusted incidence rates. +Table \ref{tab:demographics} compares base-line characteristics between patient cohorts. +\begin{table*} +\caption{\textbf{Patient cohorts.} +Target (T) cohort is `r targetName` new-users. Comparative (C) cohort is `r comparatorName` new-users. +We report total number of patients, follow-up time (in years), number of `r outcomeName` events, and event incidence rate (IR) per 1,000 patient years (PY) in patient cohorts, as well as the their minimum detectable relative risk (MDRR). +Note that the IR does not account for any stratification or matching. +}\label{tab:power} +\vspace*{-0.5em} +\centering{ +\rowcolors{2}{gray!6}{white} +\begin{tabular}{lrrrrrrrrr} +\hiderowcolors +\toprule + & +\multicolumn{2}{c}{Patients} & +\multicolumn{2}{c}{PYs} & +\multicolumn{2}{c}{Events} & +\multicolumn{2}{c}{IR} & +\\ +\cmidrule(lr){2-3} \cmidrule(lr){4-5} \cmidrule(lr){6-7} \cmidrule(lr){8-9} +\multicolumn{1}{c}{Design} & +\multicolumn{1}{c}{T} & \multicolumn{1}{c}{C} & +\multicolumn{1}{c}{T} & \multicolumn{1}{c}{C} & +\multicolumn{1}{c}{T} & \multicolumn{1}{c}{C} & +\multicolumn{1}{c}{T} & \multicolumn{1}{c}{C} & +\multicolumn{1}{c}{MDRR} \\ +\midrule +\showrowcolors +```{r, outcomes, echo=FALSE, results="asis", cache=TRUE, warning=FALSE} +table <- preparePowerTable(mainResults, analyses) + +print(xtable(table, format = "latex"), + include.rownames = FALSE, + include.colnames = FALSE, + hline.after = NULL, + only.contents = TRUE, + add.to.row = list(pos = list(nrow(table)), command = c("\\bottomrule")), + sanitize.text.function = identity) +``` +\end{tabular} +} +\end{table*} + +\begin{table} +\caption{\textbf{Patient demographics.} We report the standardized difference of population means (StdDiff) before and after stratification for selected base-line patient characteristics.}\label{tab:demographics} +\vspace*{-0.5em} +\centerline{ +\resizebox{0.5\textwidth}{!}{ +\rowcolors{2}{gray!6}{white} +\begin{tabular}{lrrrrrr} +\hiderowcolors +\toprule +& \multicolumn{3}{c}{Before stratification} +& \multicolumn{3}{c}{After stratification} \\ +\cmidrule(lr){2-4} \cmidrule(lr){5-7} +\multicolumn{1}{c}{Characteristic} + & \multicolumn{1}{c}{T (\%)} + & \multicolumn{1}{c}{C (\%)} + & \multicolumn{1}{c}{StdDiff} + & \multicolumn{1}{c}{T (\%)} + & \multicolumn{1}{c}{C (\%)} + & \multicolumn{1}{c}{StdDiff} \\ +\midrule +\showrowcolors +```{r, features, echo=FALSE, results="asis", cache=TRUE, warning=FALSE} +table <- prepareTable1(balance, pathToCsv = file.path(params$root, "Table1Specs.csv")) +table <- table[3:nrow(table),] + +print(xtable(table, format = "latex", align = c("l","l","r","r","r","r","r","r")), + include.rownames = FALSE, + include.colnames = FALSE, + hline.after = NULL, + only.contents = TRUE, + add.to.row = list(pos = list(nrow(table)), command = c("\\bottomrule")), + sanitize.text.function = identity) +``` +\end{tabular} +} +} +\end{table} + +## Patient characteristics balance + +```{r, make_ps, echo=FALSE, warning=FALSE, fig.align='center', fig.width=5, fig.height=5, out.width='70%', fig.cap=paste("\\textbf{Preference score distribution for", targetName, "and", comparatorName, "new-users.}", "The preference score is a transformation of the propensity score that adjusts for prevalence differences between populations. A higher overlap indicates that subjects in the two populations are more similar in terms of their predicted probability of receiving one treatment over the other.\\label{fig:ps}")} +plotPs(ps, targetName, comparatorName) +``` + +Figure \ref{fig:ps} plots the preference score distributions, re-scalings of PS estimates to adjust for differential treatment prevalences, for patients treated with `r targetName` and `r comparatorName`. +We assess characteristics balance achieved through PS adjustment by comparing all characteristics' standardized difference (StdDiff) between treatment group means before and after PS trimming and stratification (Table \ref{tab:demographics}). +Figure \ref{fig:balance} plots StdDiff for all `r nrow(balance)` base-line patient features that serve as input for the PS model. +Before stratification, `r sum(na.omit(balance$beforeMatchingStdDiff) > 0.1)` features have a StdDiff $> 0.1$. After stratification, the count is `r sum(na.omit(balance$afterMatchingStdDiff) > 0.1)`. + + +```{r, make_balance, echo=FALSE, warning=FALSE, warning=FALSE, fig.align='center', fig.width=5, fig.height=5, out.width='70%', fig.cap="\\textbf{Patient characteristics balance before and after stratification.} As a rule-of-thum, all values $<0.1$ is generall considered well-balance \\citep{austin2009balance}."} +plotCovariateBalanceScatterPlot(balance, + beforeLabel = "Before stratification", + afterLabel = "After stratification") +``` + +## Outcome assessment + +\begin{table*} +\caption{Time-at-risk distributions as percentiles in the target and comparator cohorts after stratification.} +\label{tab:fu} +\centering{ +\rowcolors{2}{gray!6}{white} +\begin{tabular}{crrrrrrr} +\hiderowcolors +\toprule +& +\multicolumn{1}{c}{min} & +\multicolumn{1}{c}{10\%} & +\multicolumn{1}{c}{25\%} & +\multicolumn{1}{c}{50\%} & +\multicolumn{1}{c}{75\%} & +\multicolumn{1}{c}{90\%} & +\multicolumn{1}{c}{max} \\ +\midrule +\showrowcolors +```{r, fu, echo=FALSE, results='asis', warning=FALSE} +table <- prepareFollowUpDistTable(followUpDist) +table$Cohort <- c(targetName, comparatorName) + +print(xtable(table, format = "latex"), + include.rownames = FALSE, + include.colnames = FALSE, + hline.after = NULL, + only.contents = TRUE, + add.to.row = list(pos = list(nrow(table)), command = c("\\bottomrule")), + sanitize.text.function = identity) +``` +\end{tabular} +} +\end{table*} + +Table \ref{tab:fu} details the time to first `r outcomeName` or censoring distributions for patients in the `r targetName` and `r comparatorName` cohorts. +We report in Table \ref{tab:hr} estimated HRs comparing `r targetName` to `r comparatorName` for the on-treatment and intent-to-treat designs with stratification or matching. +Figure \ref{fig:km} plots Kaplan-Meier survival curves for patients under the intent-to-treat design. +To examine possible subgroup differences in treatment-effect, we include Table{tab:subgroups} that reports HR estimates separately for children (age $<$ 18), the elderly (age $\ge$ 65), female patients, pregnant women, patients with hepatic impairment and patients with renal impairment, using PS stratification. + +```{r, km, echo=FALSE, results='hide', fig.width=6, fig.height=6, fig.align='center', out.width='80%', fig.cap=paste0("\\textbf{Kaplan Meier plot of ", outcomeName, "-free survival.} This plot is adjusted for the propensity score stratification; the ", targetName, " curve shows the actual observed survival. The ", comparatorName, " curve applies reweighting to approximate the counterfactual of what ", targetName, " survival would look like had the ", targetName, " cohort been exposed to ", comparatorName, " instead. The shaded area denotes the 95\\% CI.")} +plotKm <- plotKaplanMeier(kaplanMeier, targetName, comparatorName) +``` + +\begin{table*} +\caption{ +Hazard ratio (HR) estimates and their confidence intervals (CIs) and $p$-value to reject the null hypothesis of no difference (HR = 1) under various designs. +} +\label{tab:hr} +\centering{ +\rowcolors{2}{gray!6}{white} +\begin{tabular}{lrrrr} +\hiderowcolors +\toprule +& \multicolumn{2}{c}{Uncalibrated} & \multicolumn{2}{c}{Calibrated} \\ +\cmidrule(lr){2-3} \cmidrule(lr){4-5} +\multicolumn{1}{c}{Design} +& \multicolumn{1}{c}{HR (95\% CI)} & \multicolumn{1}{c}{$p$} +& \multicolumn{1}{c}{HR (95\% CI)} & \multicolumn{1}{c}{$p$} \\ +\midrule +\showrowcolors +```{r, result_table, echo=FALSE, results='asis'} +table <- mainResults +table$hr <- sprintf("%.2f (%.2f - %.2f)", mainResults$rr, mainResults$ci95Lb, mainResults$ci95Ub) +table$p <- sprintf("%.2f", table$p) +table$calHr <- sprintf("%.2f (%.2f - %.2f)", mainResults$calibratedRr, mainResults$calibratedCi95Lb, mainResults$calibratedCi95Ub) +table$calibratedP <- sprintf("%.2f", table$calibratedP) +table <- merge(table, analyses) +table <- table[, c("description", "hr", "p", "calHr", "calibratedP")] + +print(xtable(table), + include.rownames = FALSE, + include.colnames = FALSE, + hline.after = NULL, + only.contents = TRUE, + add.to.row = list(pos = list(nrow(table)), command = c("\\bottomrule")), + sanitize.text.function = identity) +``` +\end{tabular} +} +\end{table*} + +\begin{table*} +\caption{ +Subgroup analyses. We report HR estimates, their 95\% CIs and uncalibrated and calibrated (cal) $p$-values to reject the null hypothesis of no difference in five pre-specified patient subgroups. +} +\label{tab:subgroups} +\centering{ +\rowcolors{2}{gray!6}{white} +\begin{tabular}{lrrrrrrrr} +\hiderowcolors +\toprule +& +\multicolumn{2}{c}{Subjects} & +\multicolumn{3}{c}{On-treatment} & +\multicolumn{3}{c}{Intent-to-treat} \\ +\cmidrule(lr){2-3} \cmidrule(lr){4-6} \cmidrule(lr){7-9} +\multicolumn{1}{c}{Subgroup} & +\multicolumn{1}{c}{T} & +\multicolumn{1}{c}{C} & +\multicolumn{1}{c}{HR (95\% CI)} & +\multicolumn{1}{c}{$p$} & +\multicolumn{1}{c}{cal-$p$} & +\multicolumn{1}{c}{HR (95\% CI)} & +\multicolumn{1}{c}{$p$} & +\multicolumn{1}{c}{cal-$p$} \\ +\midrule +\showrowcolors +```{r, subgroups, echo=FALSE, results='asis', warning=FALSE} +if (nrow(subgroupResults) > 0) { + table <- prepareSubgroupTable(subgroupResults) + print(xtable(table), + include.rownames = FALSE, + include.colnames = FALSE, + hline.after = NULL, + only.contents = TRUE, + add.to.row = list(pos = list(nrow(table)), command = c("\\bottomrule")), + sanitize.text.function = identity) +} +``` +\end{tabular} +} +\end{table*} + +## Residual systematic error + +In the absense of bias, we expect 95\% of negative and positive control estimate 95\% confidence intervals to include their presumed HR. In the case of negative controls, the presumed HR = 1. Figure \ref{fig:negatives} describes the negative and positive control estimates under the on-treatment with PS stratification design. +Before calibration, negative and positive controls demonstrate `r judgeCoverage(coverage[coverage$group == "Uncalibrated", "coverage"])` coverage. After calibration, controls demonstrate `r judgeCoverage(coverage[coverage$group == "Calibrated", "coverage"])` coverage. + +```{r, make_error, echo=FALSE, warning=FALSE} +plot <- plotScatter(controlResults) +suppressMessages(ggsave(paste0(opts_chunk$get("fig.path"), "error.pdf"), plot, + width = 14, height = 4, units = "in")) +``` +\begin{figure*} +\centerline{ +\includegraphics[width=1.0\textwidth]{`r opts_chunk$get("fig.path")`error} +} +\caption{ +\textbf{Evaluation of effect estimation between `r targetName` and `r comparatorName` new-users}. The top plots HRs and their corresponding standard errors before calibration for each negative and synthetic positive control. The bottom plots the same estimates after calibration. +} +\label{fig:negatives} +\end{figure*} + +# Conclusions + +We find that `r targetName` has a `r judgeHazardRatio(mainResults[params$primary,"calibratedCi95Lb"], mainResults[params$primary,"calibratedCi95Ub"])` risk of `r outcomeName` as compared to `r comparatorName` within the population that the `r params$databaseId` represents. + + + +# Supporting Information {#suppinfo} + +Here we enumerate the guiding principles of LEGEND and provide linking details on study cohorts and design. + +## LEGEND principles + +\begin{enumerate}[noitemsep] + \item Evidence will be generated at large-scale. + \item Dissemination of the evidence will not depend on the estimated effects. + \item Evidence will be generated by consistently applying a systematic approach across all research questions. + \item Evidence will be generated using a pre-specified analysis design. + \item Evidence will be generated using open source software that is freely available to all. + \item Evidence generation process will be empirically evaluated by including control research questions where the true effect size is known. + \item Evidence will be generated using best-practices. + \item LEGEND will not be used to evaluate methods. + \item Evidence will be updated on a regular basis. + \item No patient-level data will be shared between sites in the network, only aggregated data. +\end{enumerate} + +## Study cohorts + +Please see the LEGEND `r indicationName` Study protocol (https://github.com/OHDSI/Legend/tree/master/Documents) for complete specification of the `r targetName`, `r comparatorName` and `r outcomeName` cohorts using ATLAS (http://www.ohdsi.org/web/atlas). + +## Negative controls + +We selected negative controls using a process similar to that outlined by \cite{voss2017accuracy}. +We first construct a list of all conditions that satisfy the following criteria with respect to all drug exposures in the LEGEND `r indicationName` study: +\begin{itemize}[noitemsep] + \item No Medline abstract where the MeSH terms suggests a drug-condition association \citep{winnenburg2015leveraging}, + \item No mention of the drug-condition pair on a US product label in the ``Adverse Drug Reactions'' or ``Postmarketing'' section \citep{duke2013consistency}, + \item No US spontaneous reports suggesting that the pair is in an adverse event relationship \citep{evans2001use,banda2016curated}, + \item OMOP vocabulary does not suggest that the drug is indicated for the condition, + \item Vocabulary conditional concepts are usable (i.e., not too broad, not suggestive of an adverse event relationship, no pregnancy related), and + \item Exact condition concept itself is used in patient level data. +\end{itemize} + +```{r, echo=FALSE} +negatives <- controlResults[controlResults$effectSize == 1.0 & !is.na(controlResults$rr), ] +``` + + +We optimize remaining condition concepts, such that parent concepts remove children as defined by the OMOP vocabulary and perform manual review to exclude any pairs that may still be in a causal relationship or too similar to the study outcome. +For `r indicationName`, this process led to a candidate list of `r negativeControls[indicationName]` negative controls for which table can be found in study protocol [TODO URL]. +In the comparison of `r targetName` and `r comparatorName` in the `r params$databaseId` database, `r nrow(negatives)` negative controls had sufficient outcomes to return estimable HRs. We list these conditions in Table \ref{tab:negatives} + +\begin{table} +\caption{Negative controls employed in the comparison of `r targetName` and `r comparatorName` in the `r params$databaseId` database.} +\label{tab:negatives} +\centering{ +\rowcolors{2}{gray!6}{white} +\begin{tabular}{l} +\hiderowcolors +\toprule +\multicolumn{1}{c}{Condition} \\ +\midrule +\showrowcolors +```{r, echo=FALSE, results='asis'} +table <- data.frame(outcomeName = sort(negatives[,"outcomeName"])) +print(xtable(table), + include.rownames = FALSE, + include.colnames = FALSE, + hline.after = NULL, + only.contents = TRUE, + add.to.row = list(pos = list(nrow(table)), command = c("\\bottomrule")), + sanitize.text.function = identity) +``` +\end{tabular} +} +\end{table} + +## Covariate sets + +\begin{itemize}[noitemsep] +\item Demographics (age in 5-year bands, gender, index year, index month) +\item Conditions (condition occurrence in lookback window) + \begin{itemize}[noitemsep] + \item in 365 days prior to index date + \item in 30 days prior to index date + \end{itemize} +\item Condition aggregation + \begin{itemize}[noitemsep] + \item SMOMED + \end{itemize} +\item Drugs (drug occurrence in lookback window) + \begin{itemize}[noitemsep] + \item in 365 days prior to index date + \item in 30 days prior to index date + \end{itemize} +\item Drug aggregation + \begin{itemize}[noitemsep] + \item Ingredient + \item ATC class + \end{itemize} +\item Risk Scores (Charlson comorbidity index) +`r if (indicationName %in% names(extraCovariates)) { paste("\\item", extraCovariates[indicationName]) }` +\end{itemize} + +We exclude all covariates that occur in fewer than 0.1\% of patients within the target and comparator cohorts prior to model fitting for computational efficiency. + diff --git a/LegendMedCentral/MyArticle_cache/latex/__packages b/LegendMedCentral/MyArticle_cache/latex/__packages new file mode 100644 index 00000000..3e24bd12 --- /dev/null +++ b/LegendMedCentral/MyArticle_cache/latex/__packages @@ -0,0 +1,7 @@ +base +shiny +DatabaseConnector +DT +ggplot2 +knitr +xtable diff --git a/LegendMedCentral/MyArticle_cache/latex/attrition_plot_bb844da3fadeafe9509ca9d614b0f16a.RData b/LegendMedCentral/MyArticle_cache/latex/attrition_plot_bb844da3fadeafe9509ca9d614b0f16a.RData new file mode 100644 index 0000000000000000000000000000000000000000..f44abf48a8e7d33455d7206f06b3c083b60fac7f GIT binary patch literal 2945 zcmV-{3x4z;iwFP!0000025nY*IMaO}o@2}?IpkE9M<|(LiJ3yAw46y%#L6f|QI4fh8zORe^}N^fKG*eL&mZ5z=kvL*`@X;TUtd>S zFJrJ57z6@|g2W_5K%!zBS8>seO#~zklHNEWFjp*@Kna4;0D!Pj%Wgoa8{>?PrE^?z z*DZ?(!zVKi;pai+wb0CvVA#F zI#V?|2pKih!{~P@_JNm*e~LSs6HIDW$uQikWF(O!HoTV2I%JD>8C%NSsQ&uPXk`zDgQo%fyI{efi zxTshCk;&oQTgBPt9+@V!oNX_&DrJRVzi5*t7~o8&(vTs8&E3w8&Tn?C3u1%v$*l}; zGi;_>2R}U_9>!lt7(l{grds&yQ}u578ml?wnt0vEA)HfY5aq_AQ5~83#&x{X{#P2; zK6uKCMxy01Rlx&^WiMcBo<95E^=!L$Dxp1~dg~x>zElFP?VlKJ(8xSth)6et z=CA0A^ETv3BF7XRNbn!q300U)?7cJ2J}aNDG-Cs+Qn!cHPQ}y@H}?4baj4^qHFlj2 z*BSZdct$tk@$BG@E(C5=2(zSR);}FWm=APe2Ue@)1&X$CvG$p9l&1R z8Qv4A=1rD0cnlKqrCQD#*M4%57KSZY{V`9BrFMd}o{EpUUo_$AomR5F>z*Tlj#!e< zY18PtrYUu(|CX905^m%VdS#_0C&XHlp<-XXnp}!d&p|P@k&R&phkM^ODi^MHRc-xf z2uN5;Xry||Qdw$tGffveb!S;@M|3~A%;~ds#k>mRIa4aBe{28n1*fnetSxzXZpGmW z&VBcn*B$!#Z)0-Kyci%W6MBO)9RQ1+4=<<~Y?h4$EAuqOTYPeC60GY|i?kbJS|ee>kJ$S@ z7k-^8$Eg_9bni!|+LVoaES$fl!I56A=KpFo!tH;oJ8AQ_fmb~RTj|}CFv}1iVk;I4 z=l7PxUh>*pjV#uFZNCbKD~jAw_ag@f?-eH~#qo_U1*~&cGEf#=sjS=$Jqdadm;? zg`QPx=dW;+L)g9=ui~N@&w2bbg$^wWucj<-0n3c=tL6kaR~n-f!mK!?*&1|;s&41Xl97t1IsY<1+oxhirU`k)WAl;;0;3wzEn>VsXFz{v&5r zZa|vhI|e0AgIuqkFN|H%@pgZiJ2rV8F1oypQQ(}uJ$5gxTAp6eW1L>OBI?^-AkLgh z+2@;eeR6cJq@@f%)kTZzS&JdVS$=N9)}` zXU%XY$PLgDLIr29iLEo{fY0c+)I$O8-kZ>Il@TlKcc*6Oh1Hb+C9ts#YXo^${+DPoH&A(d#DS=_6NqZP7x#TO}4zii6Vn<*ds_) zWLUm3%4(~c?jNzGzA=i&Wsd5p2z`;fqi^|T>tK@CGallrK~1`sNuw{#)CD~#zI(W3 z%%|8MPANO8fM9+K&*12Aeo{fr3IbhUkZn*i-HRNs1!*Yj8(d+Njw<@vpm-ze1NVaK zj^Vr{#V9Tb#7C#P6}MmAswZ6pKs?nNI0Cqxal9X|CEs-oaSs~WaiGexeqb5II?z@> zeQ<7%yF&&!efd%zG;6qmN7dpC;}h82_EBHG@>!Y6@6Poc)ziRiob`Fw+=p?L5>5Wj zQYY>Ndart6^=r^t*wR>6r0BjEZnojeb$Z9lLMeJ9shu(z)C9vC&B7Y4xPSOtOdn%s z?d!x(NhJC4z=jkhp&a9&mYqsJgnMbB__m2y)3CN((=Z2TFY%sVM;9zj4k7hpp6tpu zFTLJ5ulcgsq=Y3M^00cxr{f4-Cu8{f!gCMZ?HGG!GX?2y-#&lH6Itc2W-v~C%`tPn z1hl0ZeSbMwf=U}KWrCtz2a!K-ckikco{Q5kEecnBEvi@tkVLd7s|rzNpj*q5j)@i~ zgqxJCg(nrW=QjCT{aCavFF(&x_gJ=^M&?{!er@Mq7^^2~UioH=iDN3p7|w%9nM>d|2l^*9yF zqzgw1yPmfHH2tAZ7W1*+@uF^bmwR?6fn5@w3jv;FtHukwZ~|CQ=rzRCQ^~0Y7Ewsk zRrbWqzK<96N{B%+t>?e4MUq-hUTKtTL|udmSi#RayycE2)>-WAT-=T=_vp+GyE~cF zRMZoJrnQF2qn~z%W>9axb+lhblI0mD2eSv7xbsC{#u+@^wQk%xq$59m)lc3{GsD~7 z>W8VykzTWhVNiPCBkANrg%$?al$bYc&}vE;=#?**7YCZ!RLCifps= zS?i;o(?^4>Q$9o#3^Bhc>^|*PD&p^^Z^PoBz}&rRk>b7nTxbdN$YbxHXW9SXU+*yN z_&IAToros^K6orX05BwB=|H$4mQJS<=|l?ICzwQ```~b92m}FZ;)f*wSU!~ZfF{F^xgqi84?ydi?Y zV}pNpBQYBwI?gZB`fnVRK*Vmy1ws8NR45G~0eJdvCmUi0AvAzWgHrsUSh7EnLI=n+ zA{j~r@IWwq1B)Y3@PGaW=vlkk&~|Tt2v8hA$Nn?$qf&yP^Z)>Q=#aG?lz^pUaabAv r!;r8zfb=^6#htgE0V^@ONMvQLg<5Il#^2s0#o93W2*e literal 0 HcmV?d00001 diff --git a/LegendMedCentral/MyArticle_cache/latex/attrition_plot_bb844da3fadeafe9509ca9d614b0f16a.rdb b/LegendMedCentral/MyArticle_cache/latex/attrition_plot_bb844da3fadeafe9509ca9d614b0f16a.rdb new file mode 100644 index 00000000..e69de29b diff --git a/LegendMedCentral/MyArticle_cache/latex/attrition_plot_bb844da3fadeafe9509ca9d614b0f16a.rdx b/LegendMedCentral/MyArticle_cache/latex/attrition_plot_bb844da3fadeafe9509ca9d614b0f16a.rdx new file mode 100644 index 0000000000000000000000000000000000000000..1c0ec057e322d0ef2688b4eb5e5df17526fbc398 GIT binary patch literal 113 zcmb2|=3oE=wosqbTnz?1r{(0fO@45`a&DAkL9p3}&sXz=Q(Dy&GmWDdgjNYp&^q1d zSbJu%YI8$d;=88LQzE{Y9=R*mwftEfGe;qeQ1#@xBHr8v_xXUSBh)}Q6i4$q$$ Rv`BUOzE=}HUv2=}1OOWWGamo| literal 0 HcmV?d00001 diff --git a/LegendMedCentral/MyArticle_cache/latex/features_6d986e09d41579c8f9ee29fca5436df7.RData b/LegendMedCentral/MyArticle_cache/latex/features_6d986e09d41579c8f9ee29fca5436df7.RData new file mode 100644 index 0000000000000000000000000000000000000000..d28a9cf0a79b7798260bc305fa942f5d762f6a80 GIT binary patch literal 4720 zcmV-$5|8a4iwFP!000002Ax<7Tuf=$pD33K8zBit8)cbk&Y4@2>{iNkkQ6PgIx};s zW9R0~OgFbgim=7g8w6@bsMpFY@+9>SM5h;Eo%CsOY*x?wvEl$!DXNhlnv(WaNZ$L8jxlQ)9?YVfr}k*_oZ>r%JWUOC zvp+7eoe^E0KCWtrC!3imNbdD1b9zZ(=^%&g6YkA@LN z<+qOBW!4Ydo=hAylr^MnLC=gqOQhb5?_Eo&o|zND%(Z^Dd|{?SQs%VLvrm86W=+?+ zPn*-1j_!A<=cb}*W0MzT+eU{rHXK^eeiMCgl&6sHuFO>SjRL2uWUNdtLepaH_6i! z+l(2x>U;D)SA$A|ZV&BfOp<2FDpKZop&8ESt2V4iW>mGVsPSgly*yc!H@9e3mdnS? z{li4=C)Ap`UiJe@vLB7KD=O&__2=Di*?NDr!!oDhirI?c)~wujnel0M1n=&( zfrsa=I2%*Yx3;n+*M{j9y>bb?Bz2A_dxNL_w(jZ3)4)OY%X0bMx@{KCOrJ4Sz_L&6 zdhOer7m@;>Mb$+f62$De=hhjyr#BOkt=KHoj@M04%VOKf5H zL_3(VIQr;UWl1!UPQWc z;H%PA7u}oF^QH@`W&39Q>6YK(lyV`p$C~QC)pbA2h?AlLvbwkJQ+^VLjCy|a{OGJZ z%QEL*u8|E8Usq&I!Nv|h`hyd_Pp>4~0hKP+CnGZbSNIjCWxEw8r7!tnv@C7P(LuT0 zZSvg~cHMSj!S-70-*iw;lSH z=AK%=@A9nyqhrsm4_>o&e5CVhLDIpihBUE-iq!mqfIr(;Rk!`1N*wdYHs%hZ zwNZExYzsNDXuJd$!Nd+)r#hnMs`yEyWK5g z_9U$i>r>#J<8~t`>bE+HdyY%StW$x(^=F#v3Wudu&U#V1o4c?idA>$a-!xp%aI4Qg zAE)0^iM**UiVpa?TjZ+QUXkB7JC9isQpNN=>(g2eWn^dAC*S&I?a94UntXPjkfqz7 zdE(jAKFJ!V=G)O(jd^|E1zcRv9+pyb+nYAE zu`zK=t0qj)?0B}Sy?m`YFVf}4^2I3^Dy!D_JMSv5JhE?lE1H@ZRiKFpI)M1}i}Te; znvV$9jhhsBc|g(d_Z44A)rAfBQ!7JK?Oyg(v8U}GR>rHes(l+dFm!SGq0KoSzb_hh z;A-wAANp_0hy|^?n9XQ_TiFqRucn#L?y}CTNMD<jnTZ`!M=);^g5 zc|lIQR_0WX=1rR4zSF*pIkeX1J6iCTrMr{fkDM2BW!vNW9n3Cm15#H)sez{#&Zr67 zAAB_N!EKwv+rpk}${!Vl{JH5>`BPaj^iZ6y8N&()3jaFd(d)GFF(LE13zi>9Y|pzp zx4EUMfHua#QT3BLu}9PXHATu_PgK1;H?`s0z;hWN@&wnrIZTS2u=1gx_fdBUtzM9v zJ{PZF?bWY=A^qgzzr>jk4U14{E-iH1HdN;2-a2I4wOO31l;!I+Gvkso0t0R*7tgqM zvRmsepPcEj>2tG`t_`dA_V9Ro-2Tv_xU2y_zI~nDzf8)FT;@21t0rr(lA4lX&WXktV?#E7j7Qaz5Qu8-KE9=+j9!U$3 zmZ`#IF<*Fl_KH;G`)}~ceo^eWbJP9uAA*P0ZC~TKxLiW35~R(_IlHB=N6&1`eztS5 zrjZ$lBu7=A%nJU*J`Ba4|N7AEqM9~Z`qyWQ8oqh^RmhZ$vJGvkw?mui@+%2fO`T{( zUisNakskY-?GC&ND$)%44r^ZSx0Lbr{u7`6N{3(HUlh&}j2XPU;3n-;-22Cu7IooV zo)r+^R_HO+D^~9DFzuq2x z=(B0;%8My=J6bPY zr7a1r_5S;pt0N9HB`kO0X2(0;?BZC6NvvGuANwudN88)hZTiZwEb-6sO|7T$n-jW6 z`u_FKZ~y+K>4QVt#x;0n?r6IiIK?x`qZ|Lg?JuTJdlR30l!}Ysw5)5y#G#i9M_mfpd{LaYCw`kfc53sWzBjZ}^R`%(+Yt!gs7khI*<~{xS z)`L|ZdvK{;#nKm_7D-Ni`%_8p5}#F2W4hwp`FXu3uPhup{NlSI=>E`)+u{z^XO?DP zOB5(8;v590uf}d9ez`M!Vw<4x{B@Xg5M`g>wPN* zo*gZ$n?-|4l^?FGJyNr&SO0r8-X&M@c$%%<@a203-#~tLZHdpYOWx6tIPk;du!m1s z$3`BvlDiEK-*v0{gZr}eD}$X*RnFw926R-6no?@x^Y&Fv(0VvMVE+aF*v54)Z(Wzw z&YLpW_TAJ?9gk)=OqTksyPvr0Uh3<9qrMBvwThlK+CRN&PWZtsW7o~=xX?6?5xPB( z*OET5Q?KXCn3mv2sBn=4ix8or7|c_Gs<3#^C=6Ap2}~Km74yBg7?Uq%!yF!8*nC%E?0)ay_L@J2MfncULo9hjJAWYcH7V?V*V1!()fJQ>#pYhLU^YC!U zmiz(196HR`t}+=cYS7N;Oa_xjO*z!S)2$*VvIvuou#G|x!r)SG!6Xz+$s!DtLK^v}#EQ?8Jk^8b47USUYg_+L+67=qx@ZM83>7 zyyc~xdNB}c@Un1THj~cQZV1EVhG5W{jEPWF4mEIft4vc_4xLR3aY>zFHg#;Bona0o z%O>}QI_=A0(mA9MpWF~Yz`D1zZ^K>`BF~@=%T$&_=kU#BS?01#N|tS5UoMl*Wm7_( zwBt~#UX<#3SyTUVIdm?ciUPLDKw8BZ8>Xw2>_ki^#t3gH3X`HB_(uYxlNxi_q-TIj z5bdsP%I9ppe${a3X_y!np%N$tSE}Shg0~hCq?hDBIX*a{rvB>;iMxDrE^ zT6GXEX)%PdHnp)~3Lffmi3ywHsZ^Luh0A4-7>mM1xC)9%Pyn4oDm)ffk?3*)oSL!- zY&47>-e^RY1^DqXgj|M;APF7|FpR1ijjRuG9W>9l`cGJLp;AStwF+X8L@kRph1F%O zA={a3YRaPqOOZ65kjKc}m8K{LzR@2PF;0zxnQ{S`RBK0+dZfz%#MDmI)Hrk!R{)udJw5ppP0gj!`=(2hdIWk5j{F4Lw0CY2L}b_+B2 zu}lq*Q1(O&mNO-qvNtDOhiU^X9pNU?z2@>BTUlf zf&^FKVoXZY;2*$J#gG&`CPH3}@dJ{3{5w;n- za4f;ZfMWpe#Kn-QMf9q`hMoX6BR!^t6U`FE;E5nZ2u#)~^jv1=YUi@`Srr|R5@K8)iz-EG z32Ihl{;x$<1>#ZyMd3mMmw@)yKp46Z*EL)uYw99iPgR|Z2}WQ-!lEvQgwdN!hsHDK zHdD47F9#J*>rxP>7=g=`pvx!Zx&)$tfGc%)2#@k1oARio1fGNeAQPQnDtiz^gUix7 z0%4JHiWsAe_ZdbMic7%t!o*6jUJqE8!EBTC>|~|MN^nt;f>IvSNg?fpf;yB=A*v78 zl|hbyUQLY@1T3S7A=@ZRW@l5fTtjSo8K)+Qrs@T$B~r@nm{bT-QYkg#Y`y}rON*h;FB;d;YsAtz~(ZYyqWg;D}~PEJhQ=! zWu~DLJX(eV_LU?^6)|!tYGxd>!fl8kOLS!fGH3)!Br1~=fVb3AGs67mirv|FpP_=Q zv3WRnQI1DU73Ju|!BW{WLISnqgjP!-0q|7+&!S-g4-kK+9)$({Z?tdu#0EIBD>k*C z9*u3$ewMvrKvV1Lico@z#rpo`vx4?-WiE)orCJoJMYk&et*KCzj!?K}vDvA%bS~*s zf{>i8{%@=g`gI{Fm6(?Nl~5EoEmfRA#85~a>L?th_DS~V8CniLRU62GYq2BK?qHHew~CP_*E>tZ zqQz2>9islo7P$4_7*`9Tqg!)@5Pf&7yQ?5%jPdlv!IBUBF%=4eUM~6`2kB&l`X{w` z=Bs9xGD00qMHngqZ6|?A$Zu-;CWwp@sx^aoCZCnak07uyggU3b5!Uoh47%eu)bL$^ z#HKz)=)R~JIxOl-lI|PLXE#z38{`4`=})Y`RT{62hIWl=i+BuOE6KH>=w$MGrc^6T z^TJX%kW;?-s;O22?OhC#%Efq8f|*wk>WYgP?-M*K$+Su$u))D*mm&oYE&=43sIq{- zX00AD8;2S!UC4rz38EOeF+*XhsYVQ)25g!?ECX+GKf?gIBL!^>ILH|Nfk?ZP@gj~9 ylX)wX%fZcAp-T;2II|5`K;2aL>G88N77p@3C6^Lv2}YyQKK&0m%A|xuAOHZsi&F#u literal 0 HcmV?d00001 diff --git a/LegendMedCentral/MyArticle_cache/latex/features_6d986e09d41579c8f9ee29fca5436df7.rdb b/LegendMedCentral/MyArticle_cache/latex/features_6d986e09d41579c8f9ee29fca5436df7.rdb new file mode 100644 index 0000000000000000000000000000000000000000..31e48887dc1dc5c63f6edd7e058083ae769e05ca GIT binary patch literal 2244 zcmV;#2s`%x03Zc;ob6frchtreUTlmp5W5)j3^XE1LzA)_jb6J;AE_}7&_LtUob>cp zd3V;UQ$6;KB&Y5l-}W16B;8q$0`%u{&WA>G@7%esxpP#BlQ# z{@cd$BRs#86ToF)3%F9#23LU{K(4(G+yEs1F0cpu0=Nn615(}ra2vP-+y(9d_kjn% z$G}725%5dk6Tku<1D^t)0iOfE0=@vA0KW#l1ik`(13U$WzzFynumJ`*fD3ql4+Ov% zm;h7Y8Sq=+cfjv~KLFnVe*_MJ=fDy00{9c~E$|X}1-u6StbFtacndde;CTt&lD@eT z^D`dj${TOh>_9ztkCvebX9X8gUPLoByK{KTty7Vet7gK&KjshFlukJI(DAehf9Pl& zu03=$4%Z*L8i!{OJ&nWjhn~ja+e2UD@cp5$aRl}-&^Q8r7&IKaFL^rW;+eJJNf>iA zd+#luN3$@tmasb$=g%y#aS_If{z!^BoRtN)1kYEI2ql*_k8&R7jgY4mQ&I4=h_ck0 z^F=g^3Tt`3;?k$lSyWU@G64nDn)`Ci(Nbh-G_&I9jEgm)pHqhHBrilMMR6-G)6+HH zTNSU!mg$pxjdVkjUhqWf7OJ_s_1p>;2 zc%H46;VFmr1YgAEKi9VYq+^Xzh$^B~I+`b$5OSSj`%1FCDw8m^q9iHPto9#IXXn;g zB+A^1(gmMM*Qyo!)e7m|I9f$>p0t)#j(Ed!8HQ|8`&E&yOValzpcUs-&i8r2vrrUE z5fxEm9m}{0h<_#yV2O z2Q@J-LCw$Mhh#k!o?JK{N1>QU*;$y+$~aul*}L^YfP-Rd5uJ!Ajzbc+kE=B0f}e;! z3DtQ!%8>QaI5-RiDa&Uu7g?_R?G*=gZ8ae*!YD2Ur|BEWs2pC9+pxi`biwlyTq)D#<7SJNlJ`HuaGiDSTwfm*6yz=blF;1IqeX& z@ua@|!Z^1U*tk9pa7d{aS;;!DD<}4A0=M6g_$rF|3XW_jUpEw-&^Szz`uYe{6a!3( zx;9`NC_6`eZ5C zk^=PRYHNldHN92aaV?NjnZW4Zit?SJY*>~WUAF9zOUBc7?2PPo?2Wv3JRbSYn6ZwZ z1sxBYb~3eb(5c8M{*=hs?tZ zomCE*XPSjnXUFJeTa(}EtlnhKH*?vBE|2dJ1+4a)3l_%nVRMq@jP<3mCtB&*l0}lYAs~MS~elN$-RE= z1kzI%5R1B;921@?(U6fm^g4dz2_s|Iq#-?lzSn9?PvBUy*(2k?s4>Y@Ey7cxJw0_( z&2rbY)^)T@35c9F2F%e;vbmlyEhp${XGZ-e=JSI5@Gg1^yH3d1CsNw6<7@Sd@^tfo zroC^_Ue6qQx{Urq7CAk3yFFuO(14ym5^;w{pHzBe4$YQHkB6tGc}8-bQQ!EQ%ct`-*;By&otUca;2_ir&b%tDg7N9`}_l z&9@*)f2igT)cQu3X0PVi=q2}ir1%b$e$BU}eMPg>^N!m4mRfgB>F~Jbmu<$S|0vmy zl|KjSx${FYAEAL-EY!rN)#l08&>q=i^1@vD63`c)u4w|eg`}_@`ZA_38k zP|;Kao6#4KzR*pXCV=k4v^APNHdRM6n@V%2cU&r<{diRgpo%hwZaSrFG!3S8)Jn#*TG@>!GZ``t)mqUD%a(sv_uw+E?y%+_vg zWAEn%T1P=UfJXIy$z_h>5b%Ty};OL(^!jammw3Gx{)t88lQ2?NcKG?FyqX(Y{2CH))XG$CV; z$Z*w+(wHjcH7rXDoZDlKl*67oyg(SKFYGcqxbZDXuH`~;f) z(Z~NjCvZw^qQ9}*m21D}%{4kO+e&}w(VIj&1GEZ|K9Ehdiq}QlgKqsj;T82xdqerW zrsl4zH8%*ZlJO2%x29uv za;Y52vsaI`o^Vh3bD*B@>(4{Y$0F9#ccZ^cBJ~9}*N2jEJY)iw0 zHy_)!*UZ2DoG&uLt-O$bJ6WhNzH3a)^Wbn%aPcl)efJ%a{WNMc`2QcJ|EE7nUkLWK Sd02#_g@9XS!2b*C>CFN5(sDEa literal 0 HcmV?d00001 diff --git a/LegendMedCentral/MyArticle_cache/latex/features_6d986e09d41579c8f9ee29fca5436df7.rdx b/LegendMedCentral/MyArticle_cache/latex/features_6d986e09d41579c8f9ee29fca5436df7.rdx new file mode 100644 index 0000000000000000000000000000000000000000..69a25be48f0d830058bb403f3174b038486b3dde GIT binary patch literal 131 zcmV-}0DS)+iwFP!0000023<|j3d0}_Jhg=>3{*ZzHr~QE^44esq_fKFGvgJtYDA1O1royC`*R$}s%6tpX~%OaWwCm+u0)eDKGGHl?w2VZ`N=t$iNERe7*D5;c$(28$q*10}hVm@&NR#r-lKS2Jd9%Ou;=0CJb2;2g~7>=JG< zL&Nh4iAt;aPA!eCS}K?J3?KYaMO)k3W_B)0HmRc){qOL2^mpmoYszi1qe~MGJGP>> zEQQMFXq^hfogD6C4Y-#2!OLaeCmhcYr?hEin{7}>fKz2gR`WQgO;mg2bDIuWC5DzL z1bd2RYLZrHqVxQ#30gc~*;_+MKIW&XzOKy&xz-kCft1@6zfyPF`e1*m+Pm$VzW3Je zd0-k|@=WJ0YEQwn(mYGg98?2u^V8gFCGn?^29!ybLXLBJo~|sdo4(Oxuu+3UVtmdc`E@0VaxO#dhwWPKT&?vCNHAW`X<+hz{?2j_Pzs= z^6GaUEp!6UQ0jOyWs_NxgRSYkWRFMM^5UCmuXNXI{1hrymzRGu^_OW>W)p(ckh4-h z!ByFcuc5ZM!sqiWzv0DZxYTTv>Rj@(8x!2)Dp~5Ywy+u<2S~$oeA7rvU(jE>yFS{G z));WZ(a%mtjbiW34PEI$`>%^tM8Hl4*Y9j&f)sPROslFh^KBB-ty7MSz2+Xg(p>U4 z>D;!MzBp|ks*>qFkXX3B{WP-Sy{o)9dcpdy`4A?(8>Ih0cFZFMB``jsZgMcL@?;NwZ5{LWJ3jHK6$sgmf#xqS21GzUWpjTd4n+ z$MgOkJ3hYXGAVo&pMUhpAXOvqS$K{k*=k$;8BNm-N=yX}fv#-3U%qXUO=CuhK{Jzc zYNH7?!?9kgd>y#T;J8e|z0ga(mPJi|$~(r)gF{0EH2A1~jzYjG`&H}cXmjwDG9=zR zx#MH=x}};!AS3ov#gl#wlc>&2x74)VMD5Q6rs18FmlxZRVzhrayQI(`I}KZYwlistB|=e%RDl!p**-HBh|134u*ki`D$Y3#rWcTR1W0f zg#Ntet@V#;8Ek&hgzk8WD2p^6$lOzmS0l788js~4!yz;qh5N-?|GY`Qjh zXJpbtMqpr08j&;X(ofZxGl7~Y(;~S<-RB7>S&s$6Ow}%ZnxL-Y(gKMc8&u0X=2DHst43S%D06j$^j&-H zpJ+5~`_Zv6EV6OtEnDEhR-E3%Kp!a9YqJnY4SgkU_B_e2$tyL!6Su3nx4Z{$dOMyT zx=;k4BiR|W)!AajuJ2!?9wu?pPFz@iJ(Q3WOxSJfSBeA8?w7^q+i_hqi;_zROf2>u zUA_WogKr%I9|5^tI9<&AVd&%Wv|xPdGF*CTGpooYYYP(^QLDlz>O*E#FG~|Ui)7i; z>E^`T%Tr@t%i1f*8RrCf9h1uq$MtU4ABz@Qv+W-ocOLYvbgPej_Y!=o!22VQKi1^& zA$OKPNo@v31FLvYl%0$3-+p7CGj<>I@L5MlsE%FczCJuRFRleaRn!>gBV*T#D^r^y zZrl@2KiWTY$o^5zPcGq^oXTF}p5#%2a=j5i8VF6~91fW}i&dS0g{|UkPifNw^!&nk zJ;x0SwoWb+Jp-|3(>Rgn=9WEa-P@TMNyh%-|nhF95U;Y&U>t6j-`%Rl3` zb>vd2+DSeIBqU_Gmv&y*WGr7ohInZ=^F(laWMYt@z0hqHeG7={`n$%fX>bX|`TJqh z%s*dudN^iNvzE?Y0&+*H1ay7gNI(*o-#JD!uAEb>{^HWa(>g+)ORzZ&`}%eQuO6Xt z<43puK>}2#xb_8THTuVRPn@**6L-6qrAFiZ*eIIuXhyeUHa*F#POrF*FB=^5%D11j zt>H!T`&5d`L}+umx>%X@kG{R;0EB;bq4YXRrgg-?zIBA>?*M)yY-EUjObz2q;_q)S zv@E~eJ+Jq)4OPaGkF2lV`u+e~(9IgTyzto5Xp66d3szPB^XCt5FG;NkSF%|LKjmXx z&XONyAig}ED#K?Em9s&o+=g)9ulH`R7N1Da#gxRTy^vOGBvYjHX)CHHD?rzlIHiuZ zhG>GH=Y(e$)1QmpMSgE751nsOZo#JjB2M_DE+6H6$&FUqx)-;QDm}XkqHj*+ zx0dw95+XXHRR|Ayqq6DOUpYA};ixJs)IWKHt^E0tj}t6`|HWSaHAq)s;!2Q;yI!`B zgY`Fz=H6%6`e=aBe^)+jcd?b}MRoQSTY|Q_FL3_jxy8ZOhnm#%j!VmgJNv?>tUES$ zn)r{ngMikEpHI{326L6vhX-*jy&*9m1;uR%WjfE1SM}#(augFU&%|#2xzBra64hXM zSBhq!<6G1}@Y5(hGuch^zQ7g3&{*r(;n)hsf1NFL$wYAMDj!=~iPES0pHYW=9CZ{H z_vfySdClw#vq^s&TQto6th(cfcezxsyNNAFc+mIe1*>$Qwa4OJFwaX|i+PU2|NQl= zVFymw&>0~C6tZ6cDc~5{j6!0NW6Wrgi~w2~Il?ax9TY@DqOs6_oUsqrl%&#g8VFCF10t&$Y1BOr;5|k-}_J{kMiG?E3f0!637KxH53>E>!V&K0S z2owT}MEv1dnE&FTpcYunZ>~A^Hy8DLPMBoKKU~1qpT=O&!sw9{vgBP?{{ys?gd(pC F002C4*OmYP literal 0 HcmV?d00001 diff --git a/LegendMedCentral/MyArticle_cache/latex/outcomes_d4ffa24859cd40dfadb04e06d5ea9412.rdb b/LegendMedCentral/MyArticle_cache/latex/outcomes_d4ffa24859cd40dfadb04e06d5ea9412.rdb new file mode 100644 index 0000000000000000000000000000000000000000..ca69a4849c03b6b2a3a90725c5e58f49f6f47c6f GIT binary patch literal 327 zcmV-N0l5AE00QxNoNbZMPQx$^#R3yZSbsZ z=0+=NYSkEvJ)FR*#sDxk?U4=|pHa$j&N43rrdbwJY>{D+=3W+9P!>{TAuvmYlZ7By z6zRW-Jj0wXtQ-?e7{Qc?fQvHbI*kbCIS=Y!rYU!VVJ?b*h-pHJ&+~9X%#xz;Im^R3 zNeK5jEQaDCHbW-4C8lb|~+=rfUEI literal 0 HcmV?d00001 diff --git a/LegendMedCentral/MyArticle_cache/latex/outcomes_d4ffa24859cd40dfadb04e06d5ea9412.rdx b/LegendMedCentral/MyArticle_cache/latex/outcomes_d4ffa24859cd40dfadb04e06d5ea9412.rdx new file mode 100644 index 0000000000000000000000000000000000000000..65d8d814c38a69cc67927e5fa463c361e85386a0 GIT binary patch literal 131 zcmV-}0DS)+iwFP!0000023<|<3WG2VytMkmf-vx*dY^aSL2hn>v;008HKJcR%N literal 0 HcmV?d00001 diff --git a/LegendMedCentral/PlotsAndTables.R b/LegendMedCentral/PlotsAndTables.R new file mode 100644 index 00000000..216360e6 --- /dev/null +++ b/LegendMedCentral/PlotsAndTables.R @@ -0,0 +1,973 @@ +createTitle <- function(tcoDbs) { + tcoDbs$targetName <- exposures$exposureName[match(tcoDbs$targetId, exposures$exposureId)] + tcoDbs$comparatorName <- exposures$exposureName[match(tcoDbs$comparatorId, exposures$exposureId)] + tcoDbs$outcomeName <- outcomes$outcomeName[match(tcoDbs$outcomeId, outcomes$outcomeId)] + tcoDbs$indicationId <- exposures$indicationId[match(tcoDbs$targetId, exposures$exposureId)] + + titles <- paste(tcoDbs$outcomeName, + "risk in new-users of", + tcoDbs$targetName, + "versus", + tcoDbs$comparatorName, + "for", + uncapitalize(tcoDbs$indicationId), + "in the", + tcoDbs$databaseId, + "database") + return(titles) +} + +createAuthors <- function() { + authors <- paste0( + "Martijn J. Schuemie", ", ", + "Patrick B. Ryan", ", ", + "Seng Chan You", ", ", + "Nicole Pratt", ", ", + "David Madigan", ", ", + "George Hripcsak", " and ", + "Marc A. Suchard" + ) +} + + + + +createAbstract <- function(connection, tcoDb) { + targetName <- uncapitalize(exposures$exposureName[match(tcoDb$targetId, exposures$exposureId)]) + comparatorName <- uncapitalize(exposures$exposureName[match(tcoDb$comparatorId, exposures$exposureId)]) + outcomeName <- uncapitalize(outcomes$outcomeName[match(tcoDb$outcomeId, outcomes$outcomeId)]) + indicationId <- uncapitalize(exposures$indicationId[match(tcoDb$targetId, exposures$exposureId)]) + + results <- getMainResults(connection, + targetIds = tcoDb$targetId, + comparatorIds = tcoDb$comparatorId, + outcomeIds = tcoDb$outcomeId, + databaseIds = tcoDb$databaseId) + + studyPeriod <- getStudyPeriod(connection = connection, + targetId = tcoDb$targetId, + comparatorId = tcoDb$comparatorId, + databaseId = tcoDb$databaseId) + + writeAbstract(outcomeName, targetName, comparatorName, tcoDb$databaseId, studyPeriod, results) +} + +writeAbstract <- function(outcomeName, + targetName, + comparatorName, + databaseId, + studyPeriod, + mainResults) { + + minYear <- substr(studyPeriod$minDate, 1, 4) + maxYear <- substr(studyPeriod$maxDate, 1, 4) + + abstract <- paste0( + "We conduct a large-scale study on the incidence of ", outcomeName, " among new users of ", targetName, " and ", comparatorName, " from ", minYear, " to ", maxYear, " in the ", databaseId, " database. ", + "Outcomes of interest are estimates of the hazard ratio (HR) for incident events between comparable new users under on-treatment and intent-to-treat risk window assumptions. ", + "Secondary analyses entertain possible clinically relevant subgroup interaction with the HR. ", + "We identify ", mainResults[1, "targetSubjects"], " ", targetName, " and ", mainResults[1, "comparatorSubjects"], " ", comparatorName, " patients for the on-treatment design, totaling ", round(mainResults[1, "targetDays"] / 365.24), " and ", round(mainResults[1, "comparatorDays"] / 365.24), " patient-years of observation, and ", mainResults[1, "targetOutcomes"], " and ", mainResults[1, "comparatorOutcomes"], " events respectively. ", + "We control for measured confounding using propensity score trimming and stratification or matching based on an expansive propensity score model that includes all measured patient features before treatment initiation. ", + "We account for unmeasured confounding using negative and positive controls to estimate and adjust for residual systematic bias in the study design and data source, providing calibrated confidence intervals and p-values. ", + "In terms of ", outcomeName, ", ", targetName, " has a ", judgeHazardRatio(mainResults[1, "calibratedCi95Lb"], mainResults[1, "calibratedCi95Ub"]), + " risk as compared to ", comparatorName, " [HR: ", prettyHr(mainResults[1, "calibratedRr"]), ", 95% confidence interval (CI) ", + prettyHr(mainResults[1, "calibratedCi95Lb"]), " - ", prettyHr(mainResults[1, "calibratedCi95Ub"]), "]." + ) + + abstract +} + +prepareFollowUpDistTable <- function(followUpDist) { + targetRow <- data.frame(Cohort = "Target", + Min = followUpDist$targetMinDays, + P10 = followUpDist$targetP10Days, + P25 = followUpDist$targetP25Days, + Median = followUpDist$targetMedianDays, + P75 = followUpDist$targetP75Days, + P90 = followUpDist$targetP90Days, + Max = followUpDist$targetMaxDays) + comparatorRow <- data.frame(Cohort = "Comparator", + Min = followUpDist$comparatorMinDays, + P10 = followUpDist$comparatorP10Days, + P25 = followUpDist$comparatorP25Days, + Median = followUpDist$comparatorMedianDays, + P75 = followUpDist$comparatorP75Days, + P90 = followUpDist$comparatorP90Days, + Max = followUpDist$comparatorMaxDays) + table <- rbind(targetRow, comparatorRow) + table$Min <- formatC(table$Min, big.mark = ",", format = "d") + table$P10 <- formatC(table$P10, big.mark = ",", format = "d") + table$P25 <- formatC(table$P25, big.mark = ",", format = "d") + table$Median <- formatC(table$Median, big.mark = ",", format = "d") + table$P75 <- formatC(table$P75, big.mark = ",", format = "d") + table$P90 <- formatC(table$P90, big.mark = ",", format = "d") + table$Max <- formatC(table$Max, big.mark = ",", format = "d") + return(table) +} + +prepareMainResultsTable <- function(mainResults, analyses) { + table <- mainResults + table$hr <- sprintf("%.2f (%.2f - %.2f)", mainResults$rr, mainResults$ci95Lb, mainResults$ci95Ub) + table$p <- sprintf("%.2f", table$p) + table$calHr <- sprintf("%.2f (%.2f - %.2f)", + mainResults$calibratedRr, + mainResults$calibratedCi95Lb, + mainResults$calibratedCi95Ub) + table$calibratedP <- sprintf("%.2f", table$calibratedP) + table <- merge(table, analyses) + table <- table[, c("description", "hr", "p", "calHr", "calibratedP")] + colnames(table) <- c("Analysis", "HR (95% CI)", "P", "Cal. HR (95% CI)", "Cal. p") + return(table) +} + +preparePowerTable <- function(mainResults, analyses) { + table <- merge(mainResults, analyses) + alpha <- 0.05 + power <- 0.8 + z1MinAlpha <- qnorm(1 - alpha/2) + zBeta <- -qnorm(1 - power) + pA <- table$targetSubjects/(table$targetSubjects + table$comparatorSubjects) + pB <- 1 - pA + totalEvents <- abs(table$targetOutcomes) + (table$comparatorOutcomes) + table$mdrr <- exp(sqrt((zBeta + z1MinAlpha)^2/(totalEvents * pA * pB))) + table$targetYears <- table$targetDays/365.25 + table$comparatorYears <- table$comparatorDays/365.25 + table$targetIr <- 1000 * table$targetOutcomes/table$targetYears + table$comparatorIr <- 1000 * table$comparatorOutcomes/table$comparatorYears + table <- table[, c("description", + "targetSubjects", + "comparatorSubjects", + "targetYears", + "comparatorYears", + "targetOutcomes", + "comparatorOutcomes", + "targetIr", + "comparatorIr", + "mdrr")] + table$targetSubjects <- formatC(table$targetSubjects, big.mark = ",", format = "d") + table$comparatorSubjects <- formatC(table$comparatorSubjects, big.mark = ",", format = "d") + table$targetYears <- formatC(table$targetYears, big.mark = ",", format = "d") + table$comparatorYears <- formatC(table$comparatorYears, big.mark = ",", format = "d") + table$targetOutcomes <- formatC(table$targetOutcomes, big.mark = ",", format = "d") + table$comparatorOutcomes <- formatC(table$comparatorOutcomes, big.mark = ",", format = "d") + table$targetIr <- sprintf("%.2f", table$targetIr) + table$comparatorIr <- sprintf("%.2f", table$comparatorIr) + table$mdrr <- sprintf("%.2f", table$mdrr) + table$targetSubjects <- gsub("^-", "<", table$targetSubjects) + table$comparatorSubjects <- gsub("^-", "<", table$comparatorSubjects) + table$targetOutcomes <- gsub("^-", "<", table$targetOutcomes) + table$comparatorOutcomes <- gsub("^-", "<", table$comparatorOutcomes) + table$targetIr <- gsub("^-", "<", table$targetIr) + table$comparatorIr <- gsub("^-", "<", table$comparatorIr) + idx <- (table$targetOutcomes < 0 | table$comparatorOutcomes < 0) + table$mdrr[idx] <- paste0(">", table$mdrr[idx]) + return(table) +} + + +prepareSubgroupTable <- function(subgroupResults, output = "latex") { + rnd <- function(x) { + ifelse(x > 10, sprintf("%.1f", x), sprintf("%.2f", x)) + } + + subgroupResults$hrr <- paste0(rnd(subgroupResults$rrr), + " (", + rnd(subgroupResults$ci95Lb), + " - ", + rnd(subgroupResults$ci95Ub), + ")") + + subgroupResults$hrr[is.na(subgroupResults$rrr)] <- "" + subgroupResults$p <- sprintf("%.2f", subgroupResults$p) + subgroupResults$p[subgroupResults$p == "NA"] <- "" + subgroupResults$calibratedP <- sprintf("%.2f", subgroupResults$calibratedP) + subgroupResults$calibratedP[subgroupResults$calibratedP == "NA"] <- "" + + if (any(grepl("on-treatment", subgroupResults$analysisDescription)) && + any(grepl("intent-to-treat", subgroupResults$analysisDescription))) { + idx <- grepl("on-treatment", subgroupResults$analysisDescription) + onTreatment <- subgroupResults[idx, c("interactionCovariateName", + "targetSubjects", + "comparatorSubjects", + "hrr", + "p", + "calibratedP")] + itt <- subgroupResults[!idx, c("interactionCovariateName", "hrr", "p", "calibratedP")] + colnames(onTreatment)[4:6] <- paste("onTreatment", colnames(onTreatment)[4:6], sep = "_") + colnames(itt)[2:4] <- paste("itt", colnames(itt)[2:4], sep = "_") + table <- merge(onTreatment, itt) + } else { + table <- subgroupResults[, c("interactionCovariateName", + "targetSubjects", + "comparatorSubjects", + "hrr", + "p", + "calibratedP")] + } + table$interactionCovariateName <- gsub("Subgroup: ", "", table$interactionCovariateName) + if (output == "latex") { + table$interactionCovariateName <- gsub(">=", "$\\\\ge$ ", table$interactionCovariateName) + } + table$targetSubjects <- formatC(table$targetSubjects, big.mark = ",", format = "d") + table$targetSubjects <- gsub("^-", "<", table$targetSubjects) + table$comparatorSubjects <- formatC(table$comparatorSubjects, big.mark = ",", format = "d") + table$comparatorSubjects <- gsub("^-", "<", table$comparatorSubjects) + table$comparatorSubjects <- gsub("^<", "$<$", table$comparatorSubjects) + return(table) +} + +prepareTable1 <- function(balance, + beforeLabel = "Before stratification", + afterLabel = "After stratification", + targetLabel = "Target", + comparatorLabel = "Comparator", + percentDigits = 1, + stdDiffDigits = 2, + output = "latex", + pathToCsv = "Table1Specs.csv") { + if (output == "latex") { + space <- " " + } else { + space <- " " + } + specifications <- read.csv(pathToCsv, stringsAsFactors = FALSE) + + fixCase <- function(label) { + idx <- (toupper(label) == label) + if (any(idx)) { + label[idx] <- paste0(substr(label[idx], 1, 1), + tolower(substr(label[idx], 2, nchar(label[idx])))) + } + return(label) + } + + formatPercent <- function(x) { + result <- format(round(100 * x, percentDigits), digits = percentDigits + 1, justify = "right") + result <- gsub("^-", "<", result) + result <- gsub("NA", "", result) + result <- gsub(" ", space, result) + return(result) + } + + formatStdDiff <- function(x) { + result <- format(round(x, stdDiffDigits), digits = stdDiffDigits + 1, justify = "right") + result <- gsub("NA", "", result) + result <- gsub(" ", space, result) + return(result) + } + + resultsTable <- data.frame() + for (i in 1:nrow(specifications)) { + if (specifications$analysisId[i] == "") { + resultsTable <- rbind(resultsTable, + data.frame(Characteristic = specifications$label[i], value = "")) + } else { + idx <- balance$analysisId == specifications$analysisId[i] + if (any(idx)) { + if (specifications$covariateIds[i] != "") { + covariateIds <- as.numeric(strsplit(specifications$covariateIds[i], ";")[[1]]) + idx <- balance$covariateId %in% covariateIds + } else { + covariateIds <- NULL + } + if (any(idx)) { + balanceSubset <- balance[idx, ] + if (is.null(covariateIds)) { + balanceSubset <- balanceSubset[order(balanceSubset$covariateId), ] + } else { + balanceSubset <- merge(balanceSubset, data.frame(covariateId = covariateIds, + rn = 1:length(covariateIds))) + balanceSubset <- balanceSubset[order(balanceSubset$rn, balanceSubset$covariateId), ] + } + balanceSubset$covariateName <- fixCase(gsub("^.*: ", "", balanceSubset$covariateName)) + if (specifications$covariateIds[i] == "" || length(covariateIds) > 1) { + resultsTable <- rbind(resultsTable, data.frame(Characteristic = specifications$label[i], + beforeMatchingMeanTreated = NA, + beforeMatchingMeanComparator = NA, + beforeMatchingStdDiff = NA, + afterMatchingMeanTreated = NA, + afterMatchingMeanComparator = NA, + afterMatchingStdDiff = NA, + stringsAsFactors = FALSE)) + resultsTable <- rbind(resultsTable, data.frame(Characteristic = paste0(space, + space, + space, + space, + balanceSubset$covariateName), + beforeMatchingMeanTreated = balanceSubset$beforeMatchingMeanTreated, + beforeMatchingMeanComparator = balanceSubset$beforeMatchingMeanComparator, + beforeMatchingStdDiff = balanceSubset$beforeMatchingStdDiff, + afterMatchingMeanTreated = balanceSubset$afterMatchingMeanTreated, + afterMatchingMeanComparator = balanceSubset$afterMatchingMeanComparator, + afterMatchingStdDiff = balanceSubset$afterMatchingStdDiff, + stringsAsFactors = FALSE)) + } else { + resultsTable <- rbind(resultsTable, data.frame(Characteristic = specifications$label[i], + beforeMatchingMeanTreated = balanceSubset$beforeMatchingMeanTreated, + beforeMatchingMeanComparator = balanceSubset$beforeMatchingMeanComparator, + beforeMatchingStdDiff = balanceSubset$beforeMatchingStdDiff, + afterMatchingMeanTreated = balanceSubset$afterMatchingMeanTreated, + afterMatchingMeanComparator = balanceSubset$afterMatchingMeanComparator, + afterMatchingStdDiff = balanceSubset$afterMatchingStdDiff, + stringsAsFactors = FALSE)) + } + } + } + } + } + resultsTable$beforeMatchingMeanTreated <- formatPercent(resultsTable$beforeMatchingMeanTreated) + resultsTable$beforeMatchingMeanComparator <- formatPercent(resultsTable$beforeMatchingMeanComparator) + resultsTable$beforeMatchingStdDiff <- formatStdDiff(resultsTable$beforeMatchingStdDiff) + resultsTable$afterMatchingMeanTreated <- formatPercent(resultsTable$afterMatchingMeanTreated) + resultsTable$afterMatchingMeanComparator <- formatPercent(resultsTable$afterMatchingMeanComparator) + resultsTable$afterMatchingStdDiff <- formatStdDiff(resultsTable$afterMatchingStdDiff) + + headerRow <- as.data.frame(t(rep("", ncol(resultsTable)))) + colnames(headerRow) <- colnames(resultsTable) + headerRow$beforeMatchingMeanTreated <- targetLabel + headerRow$beforeMatchingMeanComparator <- comparatorLabel + headerRow$afterMatchingMeanTreated <- targetLabel + headerRow$afterMatchingMeanComparator <- comparatorLabel + + subHeaderRow <- as.data.frame(t(rep("", ncol(resultsTable)))) + colnames(subHeaderRow) <- colnames(resultsTable) + subHeaderRow$Characteristic <- "Characteristic" + subHeaderRow$beforeMatchingMeanTreated <- "%" + subHeaderRow$beforeMatchingMeanComparator <- "%" + subHeaderRow$beforeMatchingStdDiff <- "Std. diff" + subHeaderRow$afterMatchingMeanTreated <- "%" + subHeaderRow$afterMatchingMeanComparator <- "%" + subHeaderRow$afterMatchingStdDiff <- "Std. diff" + + resultsTable <- rbind(headerRow, subHeaderRow, resultsTable) + + colnames(resultsTable) <- rep("", ncol(resultsTable)) + colnames(resultsTable)[2] <- beforeLabel + colnames(resultsTable)[5] <- afterLabel + return(resultsTable) +} + +plotPs <- function(ps, targetName, comparatorName) { + ps <- rbind(data.frame(x = ps$preferenceScore, y = ps$targetDensity, group = targetName), + data.frame(x = ps$preferenceScore, y = ps$comparatorDensity, group = comparatorName)) + ps$group <- factor(ps$group, levels = c(as.character(targetName), as.character(comparatorName))) + levels(ps$group) <- paste0(" " , levels(ps$group), " ") # Add space between legend labels + theme <- ggplot2::element_text(colour = "#000000", size = 12) + plot <- ggplot2::ggplot(ps, + ggplot2::aes(x = x, y = y, color = group, group = group, fill = group)) + + ggplot2::geom_density(stat = "identity") + + ggplot2::scale_fill_manual(values = c(rgb(0.8, 0, 0, alpha = 0.5), + rgb(0, 0, 0.8, alpha = 0.5))) + + ggplot2::scale_color_manual(values = c(rgb(0.8, 0, 0, alpha = 0.5), + rgb(0, 0, 0.8, alpha = 0.5))) + + ggplot2::scale_x_continuous("Preference score", limits = c(0, 1)) + + ggplot2::scale_y_continuous("Density") + + ggplot2::theme(legend.title = ggplot2::element_blank(), + panel.grid.major = ggplot2::element_blank(), + panel.grid.minor = ggplot2::element_blank(), + legend.position = "top", + legend.text = theme, + axis.text = theme, + axis.title = theme) + return(plot) +} + +plotAllPs <- function(ps) { + ps <- rbind(data.frame(targetName = ps$targetName, + comparatorName = ps$comparatorName, + x = ps$preferenceScore, + y = ps$targetDensity, + group = "Target"), + data.frame(targetName = ps$targetName, + comparatorName = ps$comparatorName, + x = ps$preferenceScore, + y = ps$comparatorDensity, + group = "Comparator")) + ps$group <- factor(ps$group, levels = c("Target", "Comparator")) + plot <- ggplot2::ggplot(ps, ggplot2::aes(x = x, y = y, color = group, group = group, fill = group)) + + ggplot2::geom_density(stat = "identity") + + ggplot2::scale_fill_manual(values = c(rgb(0.8, 0, 0, alpha = 0.5), rgb(0, 0, 0.8, alpha = 0.5))) + + ggplot2::scale_color_manual(values = c(rgb(0.8, 0, 0, alpha = 0.5), rgb(0, 0, 0.8, alpha = 0.5))) + + ggplot2::scale_x_continuous("Preference score", limits = c(0, 1)) + + ggplot2::scale_y_continuous("Density") + + ggplot2::facet_grid(targetName ~ comparatorName) + + ggplot2::theme(legend.title = ggplot2::element_blank(), + axis.title.x = ggplot2::element_blank(), + axis.text.x = ggplot2::element_blank(), + axis.ticks.x = ggplot2::element_blank(), + axis.title.y = ggplot2::element_blank(), + axis.text.y = ggplot2::element_blank(), + axis.ticks.y = ggplot2::element_blank(), + panel.grid.major = ggplot2::element_blank(), + panel.grid.minor = ggplot2::element_blank(), + strip.text.x = ggplot2::element_text(size = 12, angle = 90, vjust = 0), + strip.text.y = ggplot2::element_text(size = 12, angle = 0, hjust = 0), + panel.spacing = ggplot2::unit(0.1, "lines"), + legend.position = "none") + return(plot) +} + + +plotCovariateBalanceScatterPlot <- function(balance, beforeLabel = "Before stratification", afterLabel = "After stratification") { + limits <- c(min(c(balance$absBeforeMatchingStdDiff, balance$absAfterMatchingStdDiff), + na.rm = TRUE), + max(c(balance$absBeforeMatchingStdDiff, balance$absAfterMatchingStdDiff), + na.rm = TRUE)) + theme <- ggplot2::element_text(colour = "#000000", size = 12) + plot <- ggplot2::ggplot(balance, ggplot2::aes(x = absBeforeMatchingStdDiff, y = absAfterMatchingStdDiff)) + + ggplot2::geom_point(color = rgb(0, 0, 0.8, alpha = 0.3), shape = 16, size = 2) + + ggplot2::geom_abline(slope = 1, intercept = 0, linetype = "dashed") + + ggplot2::geom_hline(yintercept = 0) + + ggplot2::geom_vline(xintercept = 0) + + ggplot2::scale_x_continuous(beforeLabel, limits = limits) + + ggplot2::scale_y_continuous(afterLabel, limits = limits) + + ggplot2::theme(text = theme) + + return(plot) +} + +plotKaplanMeier <- function(kaplanMeier, targetName, comparatorName) { + data <- rbind(data.frame(time = kaplanMeier$time, + s = kaplanMeier$targetSurvival, + lower = kaplanMeier$targetSurvivalLb, + upper = kaplanMeier$targetSurvivalUb, + strata = paste0(" ", targetName, " ")), + data.frame(time = kaplanMeier$time, + s = kaplanMeier$comparatorSurvival, + lower = kaplanMeier$comparatorSurvivalLb, + upper = kaplanMeier$comparatorSurvivalUb, + strata = paste0(" ", comparatorName))) + + xlims <- c(-max(data$time)/40, max(data$time)) + ylims <- c(min(data$lower), 1) + xLabel <- "Time in days" + yLabel <- "Survival probability" + xBreaks <- kaplanMeier$time[!is.na(kaplanMeier$targetAtRisk)] + plot <- ggplot2::ggplot(data, ggplot2::aes(x = time, + y = s, + color = strata, + fill = strata, + ymin = lower, + ymax = upper)) + + ggplot2::geom_ribbon(color = rgb(0, 0, 0, alpha = 0)) + + ggplot2::geom_step(size = 1) + + ggplot2::scale_color_manual(values = c(rgb(0.8, 0, 0, alpha = 0.8), + rgb(0, 0, 0.8, alpha = 0.8))) + + ggplot2::scale_fill_manual(values = c(rgb(0.8, 0, 0, alpha = 0.3), + rgb(0, 0, 0.8, alpha = 0.3))) + + ggplot2::scale_x_continuous(xLabel, limits = xlims, breaks = xBreaks) + + ggplot2::scale_y_continuous(yLabel, limits = ylims) + + ggplot2::theme(legend.title = ggplot2::element_blank(), + legend.position = "top", + legend.key.size = ggplot2::unit(1, "lines"), + plot.title = ggplot2::element_text(hjust = 0.5)) + + ggplot2::theme(axis.title.y = ggplot2::element_text(vjust = -10)) + + targetAtRisk <- kaplanMeier$targetAtRisk[!is.na(kaplanMeier$targetAtRisk)] + comparatorAtRisk <- kaplanMeier$comparatorAtRisk[!is.na(kaplanMeier$comparatorAtRisk)] + labels <- data.frame(x = c(0, xBreaks, xBreaks), + y = as.factor(c("Number at risk", + rep(targetName, length(xBreaks)), + rep(comparatorName, length(xBreaks)))), + label = c("", + formatC(targetAtRisk, big.mark = ",", mode = "integer"), + formatC(comparatorAtRisk, big.mark = ",", mode = "integer"))) + labels$y <- factor(labels$y, levels = c(comparatorName, targetName, "Number at risk")) + dataTable <- ggplot2::ggplot(labels, ggplot2::aes(x = x, y = y, label = label)) + ggplot2::geom_text(size = 3.5, vjust = 0.5) + ggplot2::scale_x_continuous(xLabel, + limits = xlims, + breaks = xBreaks) + ggplot2::theme(panel.grid.major = ggplot2::element_blank(), + panel.grid.minor = ggplot2::element_blank(), + legend.position = "none", + panel.border = ggplot2::element_blank(), + panel.background = ggplot2::element_blank(), + axis.text.x = ggplot2::element_text(color = "white"), + axis.title.x = ggplot2::element_text(color = "white"), + axis.title.y = ggplot2::element_blank(), + axis.ticks = ggplot2::element_line(color = "white")) + plots <- list(plot, dataTable) + grobs <- widths <- list() + for (i in 1:length(plots)) { + grobs[[i]] <- ggplot2::ggplotGrob(plots[[i]]) + widths[[i]] <- grobs[[i]]$widths[2:5] + } + maxwidth <- do.call(grid::unit.pmax, widths) + for (i in 1:length(grobs)) { + grobs[[i]]$widths[2:5] <- as.list(maxwidth) + } + plot <- gridExtra::grid.arrange(grobs[[1]], grobs[[2]], heights = c(400, 100)) + return(plot) +} + +judgeCoverage <- function(values) { + ifelse(any(values < 0.9), "poor", "acceptable") +} + +getCoverage <- function(controlResults) { + d <- rbind(data.frame(yGroup = "Uncalibrated", + logRr = controlResults$logRr, + seLogRr = controlResults$seLogRr, + ci95Lb = controlResults$ci95Lb, + ci95Ub = controlResults$ci95Ub, + trueRr = controlResults$effectSize), + data.frame(yGroup = "Calibrated", + logRr = controlResults$calibratedLogRr, + seLogRr = controlResults$calibratedSeLogRr, + ci95Lb = controlResults$calibratedCi95Lb, + ci95Ub = controlResults$calibratedCi95Ub, + trueRr = controlResults$effectSize)) + d <- d[!is.na(d$logRr), ] + d <- d[!is.na(d$ci95Lb), ] + d <- d[!is.na(d$ci95Ub), ] + if (nrow(d) == 0) { + return(NULL) + } + + d$Group <- as.factor(d$trueRr) + d$Significant <- d$ci95Lb > d$trueRr | d$ci95Ub < d$trueRr + + temp2 <- aggregate(Significant ~ Group + yGroup, data = d, mean) + temp2$coverage <- (1 - temp2$Significant) + + data.frame(true = temp2$Group, group = temp2$yGroup, coverage = temp2$coverage) +} + +plotScatter <- function(controlResults) { + size <- 2 + labelY <- 0.7 + d <- rbind(data.frame(yGroup = "Uncalibrated", + logRr = controlResults$logRr, + seLogRr = controlResults$seLogRr, + ci95Lb = controlResults$ci95Lb, + ci95Ub = controlResults$ci95Ub, + trueRr = controlResults$effectSize), + data.frame(yGroup = "Calibrated", + logRr = controlResults$calibratedLogRr, + seLogRr = controlResults$calibratedSeLogRr, + ci95Lb = controlResults$calibratedCi95Lb, + ci95Ub = controlResults$calibratedCi95Ub, + trueRr = controlResults$effectSize)) + d <- d[!is.na(d$logRr), ] + d <- d[!is.na(d$ci95Lb), ] + d <- d[!is.na(d$ci95Ub), ] + if (nrow(d) == 0) { + return(NULL) + } + d$Group <- as.factor(d$trueRr) + d$Significant <- d$ci95Lb > d$trueRr | d$ci95Ub < d$trueRr + temp1 <- aggregate(Significant ~ Group + yGroup, data = d, length) + temp2 <- aggregate(Significant ~ Group + yGroup, data = d, mean) + temp1$nLabel <- paste0(formatC(temp1$Significant, big.mark = ","), " estimates") + temp1$Significant <- NULL + + temp2$meanLabel <- paste0(formatC(100 * (1 - temp2$Significant), digits = 1, format = "f"), + "% of CIs include ", + temp2$Group) + temp2$Significant <- NULL + dd <- merge(temp1, temp2) + dd$tes <- as.numeric(as.character(dd$Group)) + + breaks <- c(0.1, 0.25, 0.5, 1, 2, 4, 6, 8, 10) + theme <- ggplot2::element_text(colour = "#000000", size = 12) + themeRA <- ggplot2::element_text(colour = "#000000", size = 12, hjust = 1) + themeLA <- ggplot2::element_text(colour = "#000000", size = 12, hjust = 0) + + d$Group <- paste("True hazard ratio =", d$Group) + dd$Group <- paste("True hazard ratio =", dd$Group) + alpha <- 1 - min(0.95 * (nrow(d)/nrow(dd)/50000)^0.1, 0.95) + plot <- ggplot2::ggplot(d, ggplot2::aes(x = logRr, y = seLogRr), environment = environment()) + + ggplot2::geom_vline(xintercept = log(breaks), colour = "#AAAAAA", lty = 1, size = 0.5) + + ggplot2::geom_abline(ggplot2::aes(intercept = (-log(tes))/qnorm(0.025), slope = 1/qnorm(0.025)), + colour = rgb(0.8, 0, 0), + linetype = "dashed", + size = 1, + alpha = 0.5, + data = dd) + + ggplot2::geom_abline(ggplot2::aes(intercept = (-log(tes))/qnorm(0.975), slope = 1/qnorm(0.975)), + colour = rgb(0.8, 0, 0), + linetype = "dashed", + size = 1, + alpha = 0.5, + data = dd) + + ggplot2::geom_point(size = size, + color = rgb(0, 0, 0, alpha = 0.05), + alpha = alpha, + shape = 16) + + ggplot2::geom_hline(yintercept = 0) + + ggplot2::geom_label(x = log(0.15), + y = 0.9, + alpha = 1, + hjust = "left", + ggplot2::aes(label = nLabel), + size = 5, + data = dd) + + ggplot2::geom_label(x = log(0.15), + y = labelY, + alpha = 1, + hjust = "left", + ggplot2::aes(label = meanLabel), + size = 5, + data = dd) + + ggplot2::scale_x_continuous("Hazard ratio", + limits = log(c(0.1, 10)), + breaks = log(breaks), + labels = breaks) + + ggplot2::scale_y_continuous("Standard Error", limits = c(0, 1)) + + ggplot2::facet_grid(yGroup ~ Group) + + ggplot2::theme(panel.grid.minor = ggplot2::element_blank(), + panel.background = ggplot2::element_blank(), + panel.grid.major = ggplot2::element_blank(), + axis.ticks = ggplot2::element_blank(), + axis.text.y = themeRA, + axis.text.x = theme, + axis.title = theme, + legend.key = ggplot2::element_blank(), + strip.text.x = theme, + strip.text.y = theme, + strip.background = ggplot2::element_blank(), + legend.position = "none") + + return(plot) +} + +plotLargeScatter <- function(d, xLabel) { + d$Significant <- d$ci95Lb > 1 | d$ci95Ub < 1 + + oneRow <- data.frame(nLabel = paste0(formatC(nrow(d), big.mark = ","), " estimates"), + meanLabel = paste0(formatC(100 * + mean(!d$Significant, na.rm = TRUE), digits = 1, format = "f"), "% of CIs includes 1")) + + breaks <- c(0.1, 0.25, 0.5, 1, 2, 4, 6, 8, 10) + theme <- ggplot2::element_text(colour = "#000000", size = 12) + themeRA <- ggplot2::element_text(colour = "#000000", size = 12, hjust = 1) + themeLA <- ggplot2::element_text(colour = "#000000", size = 12, hjust = 0) + + alpha <- 1 - min(0.95 * (nrow(d)/50000)^0.1, 0.95) + plot <- ggplot2::ggplot(d, ggplot2::aes(x = logRr, y = seLogRr)) + + ggplot2::geom_vline(xintercept = log(breaks), colour = "#AAAAAA", lty = 1, size = 0.5) + + ggplot2::geom_abline(ggplot2::aes(intercept = 0, slope = 1/qnorm(0.025)), + colour = rgb(0.8, 0, 0), + linetype = "dashed", + size = 1, + alpha = 0.5) + + ggplot2::geom_abline(ggplot2::aes(intercept = 0, slope = 1/qnorm(0.975)), + colour = rgb(0.8, 0, 0), + linetype = "dashed", + size = 1, + alpha = 0.5) + + ggplot2::geom_point(size = 2, color = rgb(0, 0, 0, alpha = 0.05), alpha = alpha, shape = 16) + + ggplot2::geom_hline(yintercept = 0) + + ggplot2::geom_label(x = log(0.11), + y = 1, + alpha = 1, + hjust = "left", + ggplot2::aes(label = nLabel), + size = 5, + data = oneRow) + + ggplot2::geom_label(x = log(0.11), + y = 0.935, + alpha = 1, + hjust = "left", + ggplot2::aes(label = meanLabel), + size = 5, + data = oneRow) + + ggplot2::scale_x_continuous(xLabel, limits = log(c(0.1, + 10)), breaks = log(breaks), labels = breaks) + + ggplot2::scale_y_continuous("Standard Error", limits = c(0, 1)) + + ggplot2::theme(panel.grid.minor = ggplot2::element_blank(), + panel.background = ggplot2::element_blank(), + panel.grid.major = ggplot2::element_blank(), + axis.ticks = ggplot2::element_blank(), + axis.text.y = themeRA, + axis.text.x = theme, + axis.title = theme, + legend.key = ggplot2::element_blank(), + strip.text.x = theme, + strip.background = ggplot2::element_blank(), + legend.position = "none") + return(plot) +} + + + +drawAttritionDiagram <- function(attrition, + targetLabel = "Target", + comparatorLabel = "Comparator") { + addStep <- function(data, attrition, row) { + label <- paste(strwrap(as.character(attrition$description[row]), width = 30), collapse = "\n") + data$leftBoxText[length(data$leftBoxText) + 1] <- label + data$rightBoxText[length(data$rightBoxText) + 1] <- paste(targetLabel, + ": n = ", + data$currentTarget - attrition$targetPersons[row], + "\n", + comparatorLabel, + ": n = ", + data$currentComparator - attrition$comparatorPersons[row], + sep = "") + data$currentTarget <- attrition$targetPersons[row] + data$currentComparator <- attrition$comparatorPersons[row] + return(data) + } + data <- list(leftBoxText = c(paste("Exposed:\n", + targetLabel, + ": n = ", + attrition$targetPersons[1], + "\n", + comparatorLabel, + ": n = ", + attrition$comparatorPersons[1], + sep = "")), rightBoxText = c(""), currentTarget = attrition$targetPersons[1], currentComparator = attrition$comparatorPersons[1]) + for (i in 2:nrow(attrition)) { + data <- addStep(data, attrition, i) + } + + + data$leftBoxText[length(data$leftBoxText) + 1] <- paste("Study population:\n", + targetLabel, + ": n = ", + data$currentTarget, + "\n", + comparatorLabel, + ": n = ", + data$currentComparator, + sep = "") + leftBoxText <- data$leftBoxText + rightBoxText <- data$rightBoxText + nSteps <- length(leftBoxText) + + boxHeight <- (1/nSteps) - 0.03 + boxWidth <- 0.45 + shadowOffset <- 0.01 + arrowLength <- 0.01 + x <- function(x) { + return(0.25 + ((x - 1)/2)) + } + y <- function(y) { + return(1 - (y - 0.5) * (1/nSteps)) + } + + downArrow <- function(p, x1, y1, x2, y2) { + p <- p + ggplot2::geom_segment(ggplot2::aes_string(x = x1, y = y1, xend = x2, yend = y2)) + p <- p + ggplot2::geom_segment(ggplot2::aes_string(x = x2, + y = y2, + xend = x2 + arrowLength, + yend = y2 + arrowLength)) + p <- p + ggplot2::geom_segment(ggplot2::aes_string(x = x2, + y = y2, + xend = x2 - arrowLength, + yend = y2 + arrowLength)) + return(p) + } + rightArrow <- function(p, x1, y1, x2, y2) { + p <- p + ggplot2::geom_segment(ggplot2::aes_string(x = x1, y = y1, xend = x2, yend = y2)) + p <- p + ggplot2::geom_segment(ggplot2::aes_string(x = x2, + y = y2, + xend = x2 - arrowLength, + yend = y2 + arrowLength)) + p <- p + ggplot2::geom_segment(ggplot2::aes_string(x = x2, + y = y2, + xend = x2 - arrowLength, + yend = y2 - arrowLength)) + return(p) + } + box <- function(p, x, y) { + p <- p + ggplot2::geom_rect(ggplot2::aes_string(xmin = x - (boxWidth/2) + shadowOffset, + ymin = y - (boxHeight/2) - shadowOffset, + xmax = x + (boxWidth/2) + shadowOffset, + ymax = y + (boxHeight/2) - shadowOffset), fill = rgb(0, + 0, + 0, + alpha = 0.2)) + p <- p + ggplot2::geom_rect(ggplot2::aes_string(xmin = x - (boxWidth/2), + ymin = y - (boxHeight/2), + xmax = x + (boxWidth/2), + ymax = y + (boxHeight/2)), fill = rgb(0.94, + 0.94, + 0.94), color = "black") + return(p) + } + label <- function(p, x, y, text, hjust = 0) { + p <- p + ggplot2::geom_text(ggplot2::aes_string(x = x, y = y, label = paste("\"", text, "\"", + sep = "")), + hjust = hjust, + size = 3.7) + return(p) + } + + p <- ggplot2::ggplot() + for (i in 2:nSteps - 1) { + p <- downArrow(p, x(1), y(i) - (boxHeight/2), x(1), y(i + 1) + (boxHeight/2)) + p <- label(p, x(1) + 0.02, y(i + 0.5), "Y") + } + for (i in 2:(nSteps - 1)) { + p <- rightArrow(p, x(1) + boxWidth/2, y(i), x(2) - boxWidth/2, y(i)) + p <- label(p, x(1.5), y(i) - 0.02, "N", 0.5) + } + for (i in 1:nSteps) { + p <- box(p, x(1), y(i)) + } + for (i in 2:(nSteps - 1)) { + p <- box(p, x(2), y(i)) + } + for (i in 1:nSteps) { + p <- label(p, x(1) - boxWidth/2 + 0.02, y(i), text = leftBoxText[i]) + } + for (i in 2:(nSteps - 1)) { + p <- label(p, x(2) - boxWidth/2 + 0.02, y(i), text = rightBoxText[i]) + } + p <- p + ggplot2::theme(legend.position = "none", + plot.background = ggplot2::element_blank(), + panel.grid.major = ggplot2::element_blank(), + panel.grid.minor = ggplot2::element_blank(), + panel.border = ggplot2::element_blank(), + panel.background = ggplot2::element_blank(), + axis.text = ggplot2::element_blank(), + axis.title = ggplot2::element_blank(), + axis.ticks = ggplot2::element_blank()) + + return(p) +} + +judgeHazardRatio <- function(hrLower, hrUpper) { + nonZeroHazardRatio(hrLower, hrUpper, c("lower", "higher", "similar")) +} + +nonZeroHazardRatio <- function(hrLower, hrUpper, terms) { + if (hrUpper < 1) { + return(terms[1]) + } else if (hrLower > 1) { + return(terms[2]) + } else { + return(terms[3]) + } +} + +judgeEffectiveness <- function(hrLower, hrUpper) { + nonZeroHazardRatio(hrLower, hrUpper, c("less", "more", "as")) +} + +prettyHr <- function(x) { + result <- sprintf("%.2f", x) + result[is.na(x) | x > 100] <- "NA" + return(result) +} + +goodPropensityScore <- function(value) { + return(value > 1) +} + +goodSystematicBias <- function(value) { + return(value > 1) +} + +judgePropensityScore <- function(ps, bias) { + paste0(" ", + ifelse(goodPropensityScore(ps), "substantial", "inadequate"), + " control of measured confounding by propensity score adjustment, and ", + ifelse(goodSystematicBias(bias), "minimal", "non-negligible"), + " residual systematic bias through negative and positive control experiments", + ifelse(goodPropensityScore(ps) && goodSystematicBias(bias), + ", lending credibility to our effect estimates", + "")) +} + +uncapitalize <- function(x) { + if (length(x) > 1) { + x <- x[1] + } + terms <- strsplit(x, split = " & ") + terms <- sapply(terms, FUN = function(y) { + substr(y, 1, 1) <- tolower(substr(y, 1, 1)) + y <- gsub("aCE", "ACE", y) + y <- gsub("CCB)", "CCBs)", y) + y + }) + result <- paste(terms, collapse = " and ") + names(result) <- NULL + result +} + +capitalize <- function(x) { + substr(x, 1, 1) <- toupper(substr(x, 1, 1)) + x +} + +createDocument <- function(targetId, + comparatorId, + outcomeId, + databaseId, + indicationId, + outputFile, + template = "template.Rnw", + workingDirectory = "temp", + emptyWorkingDirectory = TRUE) { + + if (missing(outputFile)) { + stop("Must provide an output file name") + } + + currentDirectory <- getwd() + on.exit(setwd(currentDirectory)) + + input <- file(template, "r") + + name <- paste0("paper_", targetId, "_", comparatorId, "_", outcomeId, "_", databaseId) + + if (!dir.exists(workingDirectory)) { + dir.create(workingDirectory) + } + + workingDirectory <- file.path(workingDirectory, name) + + if (!dir.exists(workingDirectory)) { + dir.create(workingDirectory) + } + + if (is.null(setwd(workingDirectory))) { + stop(paste0("Unable to change directory into: ", workingDirectory)) + } + + system(paste0("cp ", file.path(currentDirectory, "pnas-new.cls"), " .")) + system(paste0("cp ", file.path(currentDirectory, "widetext.sty"), " .")) + system(paste0("cp ", file.path(currentDirectory, "pnasresearcharticle.sty"), " .")) + system(paste0("cp ", file.path(currentDirectory, "Sweave.sty"), " .")) + + texName <- paste0(name, ".Rnw") + output <- file(texName, "w") + + while (TRUE) { + line <- readLines(input, n = 1) + if (length(line) == 0) { + break + } + line <- sub("DATABASE_ID_TAG", paste0("\"", databaseId, "\""), line) + line <- sub("TARGET_ID_TAG", targetId, line) + line <- sub("COMPARATOR_ID_TAG", comparatorId, line) + line <- sub("OUTCOME_ID_TAG", outcomeId, line) + line <- sub("INDICATION_ID_TAG", indicationId, line) + line <- sub("CURRENT_DIRECTORY", currentDirectory, line) + writeLines(line, output) + } + close(input) + close(output) + + Sweave(texName) + system(paste0("pdflatex ", name)) + system(paste0("pdflatex ", name)) + + # Save result + workingName <- file.path(workingDirectory, name) + workingName <- paste0(workingName, ".pdf") + + setwd(currentDirectory) + + system(paste0("cp ", workingName, " ", outputFile)) + + if (emptyWorkingDirectory) { + # deleteName = file.path(workingDirectory, "*") + # system(paste0("rm ", deleteName)) + unlink(workingDirectory, recursive = TRUE) + } + + invisible(outputFile) +} + diff --git a/LegendMedCentral/Sweave.sty b/LegendMedCentral/Sweave.sty new file mode 100644 index 00000000..45db4057 --- /dev/null +++ b/LegendMedCentral/Sweave.sty @@ -0,0 +1,39 @@ +\NeedsTeXFormat{LaTeX2e} +\ProvidesPackage{Sweave}{} + +\RequirePackage{ifthen} +\newboolean{Sweave@gin} +\setboolean{Sweave@gin}{true} +\newboolean{Sweave@ae} +\setboolean{Sweave@ae}{true} + +\DeclareOption{nogin}{\setboolean{Sweave@gin}{false}} +\DeclareOption{noae}{\setboolean{Sweave@ae}{false}} +\ProcessOptions + +\RequirePackage{graphicx,fancyvrb} +\IfFileExists{upquote.sty}{\RequirePackage{upquote}}{} + +\ifthenelse{\boolean{Sweave@gin}}{\setkeys{Gin}{width=0.8\textwidth}}{}% +\ifthenelse{\boolean{Sweave@ae}}{% + \RequirePackage[T1]{fontenc} + \RequirePackage{ae} +}{}% + +\DefineVerbatimEnvironment{Sinput}{Verbatim}{fontshape=sl} +\DefineVerbatimEnvironment{Soutput}{Verbatim}{} +\DefineVerbatimEnvironment{Scode}{Verbatim}{fontshape=sl} + +\newenvironment{Schunk}{}{} + +\newcommand{\Sconcordance}[1]{% + \ifx\pdfoutput\undefined% + \csname newcount\endcsname\pdfoutput\fi% + \ifcase\pdfoutput\special{#1}% + \else% + \begingroup% + \pdfcompresslevel=0% + \immediate\pdfobj stream{#1}% + \pdfcatalog{/SweaveConcordance \the\pdflastobj\space 0 R}% + \endgroup% + \fi} diff --git a/LegendMedCentral/Table1Specs.csv b/LegendMedCentral/Table1Specs.csv new file mode 100644 index 00000000..6389f2be --- /dev/null +++ b/LegendMedCentral/Table1Specs.csv @@ -0,0 +1,9 @@ +label,analysisId,covariateIds +Age group,3, +Gender: female,1,8532001 +Race,4, +Ethnicity,5, +Medical history: General,210,4006969210;438409210;4212540210;255573210;201606210;4182210210;440383210;201820210;318800210;192671210;439727210;432867210;316866210;4104000210;433736210;80180210;255848210;140168210;4030518210;80809210;435783210;4279309210;81893210;81902210;197494210;4134440210 +Medical history: Cardiovascular disease,210,313217210;381591210;317576210;321588210;316139210;4185932210;321052210;440417210;444247210 +Medical history: Neoplasms,210,4044013210;432571210;40481902210;443392210;4112853210;4180790210;443388210;197508210;200962210 +Medication use,410,21601782410;21602796410;21604686410;21604389410;21603932410;21601387410;21602028410;21600960410;21601664410;21601744410;21601461410;21600046410;21603248410;21600712410;21603890410;21601853410;21604254410;21604489410;21604752410 diff --git a/LegendMedCentral/bibliography.bib b/LegendMedCentral/bibliography.bib new file mode 100644 index 00000000..8bb87f7e --- /dev/null +++ b/LegendMedCentral/bibliography.bib @@ -0,0 +1,419 @@ +% 27592566 +@Article{pmid27592566, + Author="Schuemie, M. J. and Hripcsak, G. and Ryan, P. B. and Madigan, D. and Suchard, M. A. ", + Title="{{R}obust empirical calibration of p-values using observational data}", + Journal="Stat Med", + Year="2016", + Volume="35", + Number="22", + Pages="3883--3888", + Month="Sep" +} + +% 23900808 +@Article{pmid23900808, + Author="Schuemie, M. J. and Ryan, P. B. and DuMouchel, W. and Suchard, M. A. and Madigan, D. ", + Title="{{I}nterpreting observational studies: why empirical calibration is needed to correct p-values}", + Journal="Stat Med", + Year="2014", + Volume="33", + Number="2", + Pages="209--218", + Month="Jan" +} + +% 27993747 +@Article{pmid27993747, + Author="Voss, E. A. and Boyce, R. D. and Ryan, P. B. and van der Lei, J. and Rijnbeek, P. R. and Schuemie, M. J. ", + Title="{{A}ccuracy of an {A}utomated {K}nowledge {B}ase for {I}dentifying {D}rug {A}dverse {R}eactions}", + Journal="J Biomed Inform", + Year="2016", + Month="Dec" +} + +% 16091054 +@Article{pmid16091054, + Author="Tata, L. J. and Fortun, P. J. and Hubbard, R. B. and Smeeth, L. and Hawkey, C. J. and Smith, C. J. and Whitaker, H. J. and Farrington, C. P. and Card, T. R. and West, J. ", + Title="{{D}oes concurrent prescription of selective serotonin reuptake inhibitors and non-steroidal anti-inflammatory drugs substantially increase the risk of upper gastrointestinal bleeding?}", + Journal="Aliment. Pharmacol. Ther.", + Year="2005", + Volume="22", + Number="3", + Pages="175--181", + Month="Aug" +} + +5821 +@Article{pmid27695821, + Author="Graham, D. J. and Reichman, M. E. and Wernecke, M. and Hsueh, Y. H. and Izem, R. and Southworth, M. R. and Wei, Y. and Liao, J. and Goulding, M. R. and Mott, K. and Chillarige, Y. and MaCurdy, T. E. and Worrall, C. and Kelman, J. A. ", + Title="{{S}troke, {B}leeding, and {M}ortality {R}isks in {E}lderly {M}edicare {B}eneficiaries {T}reated {W}ith {D}abigatran or {R}ivaroxaban for {N}onvalvular {A}trial {F}ibrillation}", + Journal="JAMA Intern Med", + Year="2016", + Volume="176", + Number="11", + Pages="1662--1671", + Month="Nov" +} + +% 23484796 +@Article{pmid23484796, + Author="Southworth, M. R. and Reichman, M. E. and Unger, E. F. ", + Title="{{D}abigatran and postmarketing reports of bleeding}", + Journal="N. Engl. J. Med.", + Year="2013", + Volume="368", + Number="14", + Pages="1272--1274", + Month="Apr" +} + +% 25005708 +@Article{pmid25005708, + Author="Noren, G. N. and Caster, O. and Juhlin, K. and Lindquist, M. ", + Title="{{Z}oo or savannah? {C}hoice of training ground for evidence-based pharmacovigilance}", + Journal="Drug Saf", + Year="2014", + Volume="37", + Number="9", + Pages="655--659", + Month="Sep" +} + +@article{tibshirani1996regression, + title={Regression shrinkage and selection via the lasso}, + author={Tibshirani, Robert}, + journal={Journal of the Royal Statistical Society. Series B (Methodological)}, + pages={267--288}, + year={1996}, + publisher={JSTOR} +} + +@article{Suchard2013, + author = {Suchard, Marc A. and Simpson, Shawn E. and Zorych, Ivan and Ryan, Patrick and Madigan, David}, + title = {Massive Parallelization of Serial Inference Algorithms for a Complex Generalized Linear Model}, + journal = {ACM Trans. Model. Comput. Simul.}, + issue_date = {January 2013}, + volume = {23}, + number = {1}, + month = jan, + year = {2013}, + issn = {1049-3301}, + pages = {10:1--10:17}, + articleno = {10}, + numpages = {17}, + url = {http://doi.acm.org/10.1145/2414416.2414791}, + doi = {10.1145/2414416.2414791}, + acmid = {2414791}, + publisher = {ACM}, + address = {New York, NY, USA}, + keywords = {Optimization, big data, parallel processing}, +} + + +@article{jamaNegControls, +author = {Arnold, BF and Ercumen, A}, +title = {Negative control outcomes: A tool to detect bias in randomized trials}, +journal = {JAMA}, +volume = {316}, +number = {24}, +pages = {2597-2598}, +year = {2016}, +doi = {10.1001/jama.2016.17700}, +URL = { + http://dx.doi.org/10.1001/jama.2016.17700}, +eprint = {/data/journals/jama/935941/jvp160163.pdf} +} + +% 27993747 +@Article{pmid27993747, + Author="Voss, E. A. and Boyce, R. D. and Ryan, P. B. and van der Lei, J. and Rijnbeek, P. R. and Schuemie, M. J. ", + Title="{{A}ccuracy of an {A}utomated {K}nowledge {B}ase for {I}dentifying {D}rug {A}dverse {R}eactions}", + Journal="J Biomed Inform", + Year="2016", + Month="Dec" +} + + +% 20335814 +@Article{pmid20335814, + Author="Lipsitch, M. and Tchetgen Tchetgen, E. and Cohen, T. ", + Title="{{N}egative controls: a tool for detecting confounding and bias in observational studies}", + Journal="Epidemiology", + Year="2010", + Volume="21", + Number="3", + Pages="383--388", + Month="May" +} + +% 27182642 +@Article{pmid27182642, + Author="Arnold, B. F. and Ercumen, A. and Benjamin-Chung, J. and Colford, J. M. ", + Title="{{B}rief {R}eport: {N}egative {C}ontrols to {D}etect {S}election {B}ias and {M}easurement {B}ias in {E}pidemiologic {S}tudies}", + Journal="Epidemiology", + Year="2016", + Volume="27", + Number="5", + Pages="637--641", + Month="Sep" +} + +@Article{pmid23321761, + Author="Prasad, V. and Jena, A. B. ", + Title="{{P}respecified falsification end points: can they validate true observational associations?}", + Journal="JAMA", + Year="2013", + Volume="309", + Number="3", + Pages="241--242", + Month="Jan" +} + +% 18208871 +@Article{pmid18208871, + Author="Zaadstra, B. M. and Chorus, A. M. and van Buuren, S. and Kalsbeek, H. and van Noort, J. M. ", + Title="{{S}elective association of multiple sclerosis with infectious mononucleosis}", + Journal="Mult. Scler.", + Year="2008", + Volume="14", + Number="3", + Pages="307--313", + Month="Apr" +} + +% 28430842 +@Article{pmid28430842, + Author="Flanders, W. D. and Strickland, M. J. and Klein, M. ", + Title="{{A} {N}ew {M}ethod for {P}artial {C}orrection of {R}esidual {C}onfounding in {T}ime-{S}eries and {O}ther {O}bservational {S}tudies}", + Journal="Am. J. Epidemiol.", + Year="2017", + Pages="1--9", + Month="Apr" +} + +% 26050254 +@Article{pmid26050254, + Author="Herrett, E. and Gallagher, A. M. and Bhaskaran, K. and Forbes, H. and Mathur, R. and van Staa, T. and Smeeth, L. ", + Title="{{D}ata {R}esource {P}rofile: {C}linical {P}ractice {R}esearch {D}atalink ({C}{P}{R}{D})}", + Journal="Int J Epidemiol", + Year="2015", + Volume="44", + Number="3", + Pages="827--836", + Month="Jun" +} + +% 18092305 +@Article{pmid18092305, + Author="van Staa, T. P. and Parkinson, J. ", + Title="{{R}esponse to: {V}alidation studies of the health improvement network ({T}{H}{I}{N}) database for pharmacoepidemiology research by {L}ewis et al}", + Journal="Pharmacoepidemiol Drug Saf", + Year="2008", + Volume="17", + Number="1", + Pages="103--104", + Month="Jan" +} + +% 28027378 +@Article{pmid28027378, + Author="Arnold, B. F. and Ercumen, A. ", + Title="{{N}egative {C}ontrol {O}utcomes: {A} {T}ool to {D}etect {B}ias in {R}andomized {T}rials}", + Journal="JAMA", + Year="2016", + Volume="316", + Number="24", + Pages="2597--2598", + Month="12" +} + +% 27592566 +@Article{pmid27592566, + Author="Schuemie, M. J. and Hripcsak, G. and Ryan, P. B. and Madigan, D. and Suchard, M. A. ", + Title="{{R}obust empirical calibration of p-values using observational data}", + Journal="Stat Med", + Year="2016", + Volume="35", + Number="22", + Pages="3883--3888", + Month="Sep" +} + +% 27182642 +@Article{pmid27182642, + Author="Arnold, B. F. and Ercumen, A. and Benjamin-Chung, J. and Colford, J. M. ", + Title="{{B}rief {R}eport: {N}egative {C}ontrols to {D}etect {S}election {B}ias and {M}easurement {B}ias in {E}pidemiologic {S}tudies}", + Journal="Epidemiology", + Year="2016", + Volume="27", + Number="5", + Pages="637--641", + Month="Sep" +} + +% 27029385 +@Article{pmid27029385, + Author="Tuccori, M. and Filion, K. B. and Yin, H. and Yu, O. H. and Platt, R. W. and Azoulay, L. ", + Title="{{P}ioglitazone use and risk of bladder cancer: population based cohort study}", + Journal="BMJ", + Year="2016", + Volume="352", + Pages="i1541", + Month="Mar" +} + +% 26846201 +@Article{pmid26846201, + Author="Alves, C. and Penedones, A. and Mendes, D. and Batel Marques, F. ", + Title="{{A} systematic review and meta-analysis of the association between systemic fluoroquinolones and retinal detachment}", + Journal="Acta Ophthalmol", + Year="2016", + Volume="94", + Number="5", + Pages="e251--259", + Month="Aug" +} + +% 25598384 +@Article{pmid25598384, + Author="Dusetzina, S. B. and Brookhart, M. A. and Maciejewski, M. L. ", + Title="{{C}ontrol {O}utcomes and {E}xposures for {I}mproving {I}nternal {V}alidity of {N}onrandomized {S}tudies}", + Journal="Health Serv Res", + Year="2015", + Volume="50", + Number="5", + Pages="1432--1451", + Month="Oct" +} + +% 25525200 +@Article{pmid25525200, + Author="Chui, C. S. and Wong, I. C. and Wong, L. Y. and Chan, E. W. ", + Title="{{A}ssociation between oral fluoroquinolone use and the development of retinal detachment: a systematic review and meta-analysis of observational studies}", + Journal="J. Antimicrob. Chemother.", + Year="2015", + Volume="70", + Number="4", + Pages="971--978", + Month="Apr" +} + +% 24833754 +@Article{pmid24833754, + Author="Chui, C. S. and Man, K. K. and Cheng, C. L. and Chan, E. W. and Lau, W. C. and Cheng, V. C. and Wong, D. S. and Yang Kao, Y. H. and Wong, I. C. ", + Title="{{A}n investigation of the potential association between retinal detachment and oral fluoroquinolones: a self-controlled case series study}", + Journal="J. Antimicrob. Chemother.", + Year="2014", + Volume="69", + Number="9", + Pages="2563--2567", + Month="Sep" +} + +% 24526267 +@Article{pmid24526267, + Author="Fife, D. and Zhu, V. and Voss, E. and Levy-Clarke, G. and Ryan, P. ", + Title="{{E}xposure to oral fluoroquinolones and the risk of retinal detachment: retrospective analyses of two large healthcare databases}", + Journal="Drug Saf", + Year="2014", + Volume="37", + Number="3", + Pages="171--182", + Month="Mar" +} + +% 24363326 +@Article{pmid24363326, + Author="Tchetgen Tchetgen, E. ", + Title="{{T}he control outcome calibration approach for causal inference with unobserved confounding}", + Journal="Am. J. Epidemiol.", + Year="2014", + Volume="179", + Number="5", + Pages="633--640", + Month="Mar" +} + +% 24281462 +@Article{pmid24281462, + Author="Pasternak, B. and Svanstrom, H. and Melbye, M. and Hviid, A. ", + Title="{{A}ssociation between oral fluoroquinolone use and retinal detachment}", + Journal="JAMA", + Year="2013", + Volume="310", + Number="20", + Pages="2184--2190", + Month="Nov" +} + +% 23900808 +@Article{pmid23900808, + Author="Schuemie, M. J. and Ryan, P. B. and DuMouchel, W. and Suchard, M. A. and Madigan, D. ", + Title="{{I}nterpreting observational studies: why empirical calibration is needed to correct p-values}", + Journal="Stat Med", + Year="2014", + Volume="33", + Number="2", + Pages="209--218", + Month="Jan" +} + +% 23321761 +@Article{pmid23321761, + Author="Prasad, V. and Jena, A. B. ", + Title="{{P}respecified falsification end points: can they validate true observational associations?}", + Journal="JAMA", + Year="2013", + Volume="309", + Number="3", + Pages="241--242", + Month="Jan" +} + +% 22574756 +@Article{pmid22574756, + Author="Wei, L. and MacDonald, T. M. and Mackenzie, I. S. ", + Title="{{P}ioglitazone and bladder cancer: a propensity score matched cohort study}", + Journal="Br J Clin Pharmacol", + Year="2013", + Volume="75", + Number="1", + Pages="254--259", + Month="Jan" +} + +% 22474205 +@Article{pmid22474205, + Author="Etminan, M. and Forooghian, F. and Brophy, J. M. and Bird, S. T. and Maberley, D. ", + Title="{{O}ral fluoroquinolones and the risk of retinal detachment}", + Journal="JAMA", + Year="2012", + Volume="307", + Number="13", + Pages="1414--1419", + Month="Apr" +} + +% 20335814 +@Article{pmid20335814, + Author="Lipsitch, M. and Tchetgen Tchetgen, E. and Cohen, T. ", + Title="{{N}egative controls: a tool for detecting confounding and bias in observational studies}", + Journal="Epidemiology", + Year="2010", + Volume="21", + Number="3", + Pages="383--388", + Month="May" +} + +% 24166219 +@Article{pmid24166219, + Author="Overhage, J. M. and Ryan, P. B. and Schuemie, M. J. and Stang, P. E. ", + Title="{{D}esideratum for evidence based epidemiology}", + Journal="Drug Saf", + Year="2013", + Volume="36 Suppl 1", + Pages="5--14", + Month="Oct" +} + + diff --git a/LegendMedCentral/blank_template.tex b/LegendMedCentral/blank_template.tex new file mode 100644 index 00000000..189b4cf4 --- /dev/null +++ b/LegendMedCentral/blank_template.tex @@ -0,0 +1,131 @@ +\documentclass[$if(papersize)$$papersize$paper,$else$letter,$endif$$if(fontsize)$$fontsize$,$else$9pt,$endif$$if(one_column)$$if(lineno)$lineno,$endif$$else$twocolumn,$endif$$if(one_sided)$$else$twoside,$endif$printwatermark=$if(watermark)$$watermark$$else$false$endif$]{pnas-markdown} + +%% Some pieces required from the pandoc template +\providecommand{\tightlist}{% + \setlength{\itemsep}{0pt}\setlength{\parskip}{0pt}} + +% Use the lineno option to display guide line numbers if required. +% Note that the use of elements such as single-column equations +% may affect the guide line number alignment. + +\usepackage[T1]{fontenc} +\usepackage[utf8]{inputenc} +$if(tables)$ +\usepackage{longtable} +$endif$ + +% The geometry package layout settings need to be set here... +\geometry{layoutsize={0.95588\paperwidth,0.98864\paperheight},% + layouthoffset=0.02206\paperwidth,% + layoutvoffset=0.00568\paperheight} + +$if(headercolor)$ +\definecolor{pinpblue}{HTML}{$headercolor$} +$else$ +\definecolor{pinpblue}{HTML}{EB6622} +$endif$ +$if(linkcolor)$ +\definecolor{pnasbluetext}{HTML}{$linkcolor$} +$else$ +\definecolor{pnasbluetext}{RGB}{101,0,0} % +$endif$ + + +$for(header-includes)$ +$header-includes$ +$endfor$ + +\title{$title$} + +$for(author)$ +\author[$author.affiliation$]{$author.name$} +$endfor$ + +$for(address)$ + \affil[$address.code$]{$address.address$} +$endfor$ + +$if(numbersections)$ +\setcounter{secnumdepth}{$if(secnumdepth)$$secnumdepth$$else$5$endif$} +$else$ +\setcounter{secnumdepth}{0} +$endif$ + +% Please give the surname of the lead author for the running footer +\leadauthor{$lead_author_surname$} + +% Keywords are not mandatory, but authors are strongly encouraged to provide them. If provided, please include two to five keywords, separated by the pipe symbol, e.g: +$if(keywords)$ \keywords{ $for(keywords)$ $keywords$ $sep$| $endfor$ } $endif$ + +\begin{abstract} +$abstract$ +\end{abstract} + +\dates{This report was \textbf{automatically} compiled on \today.} +$if(doi)$ +\doi{$doi$} +$endif$ + +$if(footer_contents)$ +\pinpfootercontents{$footer_contents$} +$endif$ + +$if(author_declaration)$ +\authordeclaration{$author_declaration$} +$endif$ + +$if(corresponding_author)$ +\correspondingauthor{\textsuperscript{$corresponding_author$}}} +$endif$ + +\begin{document} + +% Optional adjustment to line up main text (after abstract) of first page with line numbers, when using both lineno and twocolumn options. +% You should only change this length when you've finalised the article contents. +%\verticaladjustment{-2pt} + +\maketitle +\thispagestyle{firststyle} +\ifthenelse{\boolean{shortarticle}}{\ifthenelse{\boolean{singlecolumn}}{\abscontentformatted}{\abscontent}}{} + +% If your first paragraph (i.e. with the \dropcap) contains a list environment (quote, quotation, theorem, definition, enumerate, itemize...), the line after the list may have some extra indentation. If this is the case, add \parshape=0 to the end of the list environment. + +$if(acknowledgements)$ +\acknow{$acknowledgements$} +$endif$ + +$body$ + +%\showmatmethods +$if(acknowledgements)$ +\showacknow +$endif$ + +$if(skip_final_break)$ +$else$ +\pnasbreak +$endif$ + +$if(natbib)$ +$if(bibliography)$ +$if(biblio-title)$ +$if(book-class)$ +\renewcommand\bibname{$biblio-title$} +$else$ +\renewcommand\refname{$biblio-title$} +$endif$ +$endif$ +\bibliography{$for(bibliography)$$bibliography$$sep$,$endfor$} +\bibliographystyle{$if(biblio-style)$$biblio-style$$else$jss$endif$} +$endif$ +$endif$ + +$if(biblatex)$ +\printbibliography$if(biblio-title)$[title=$biblio-title$]$endif$ +$endif$ + +$for(include-after)$ +$include-after$ +$endfor$ + +\end{document} diff --git a/LegendMedCentral/dbPaper.rmd b/LegendMedCentral/dbPaper.rmd new file mode 100644 index 00000000..f6ca841f --- /dev/null +++ b/LegendMedCentral/dbPaper.rmd @@ -0,0 +1,276 @@ +--- +csl: pnas.csl + +output: + pdf_document: + fig_caption: yes + html_document: default +bibliography: bibliography.bib +params: + databaseId: "MDCR" + targetId: 739138 + comparatorId: 715259 + outcomeId: 18 + setTitle: "A Comparison of Sertraline to Duloxetine for the Risk of Stroke in the MDCD Database." +title: "`r params$setTitle`" +--- + + +```{r, echo=FALSE, message=FALSE, comment=FALSE, warning=FALSE, results='hide'} +library(DatabaseConnector) +library(knitr) +library(kableExtra) +source("DataPulls.R") +source("PlotsAndTables.R") +options(knitr.kable.NA = '') + +# params <- list(databaseId = "MDCR", +# targetId = 739138, +# comparatorId = 715259, +# outcomeId = 18) + +useStoredObject <- FALSE + +if (!useStoredObject) { + # connectionDetails <- createConnectionDetails(dbms = "postgresql", + # server = "localhost/ohdsi", + # user = "postgres", + # password = Sys.getenv("pwPostgres"), + # schema = "legend") + connectionDetails <- createConnectionDetails(dbms = "postgresql", + server = paste(Sys.getenv("legendServer"), Sys.getenv("legendDatabase"), sep = "/"), + port = Sys.getenv("legendPort"), + user = Sys.getenv("legendUser"), + password = Sys.getenv("legendPw"), + schema = Sys.getenv("legendSchema")) + connection <- connect(connectionDetails) + targetName <- getExposureName(connection = connection, exposureId = params$targetId) + comparatorName <- getExposureName(connection = connection, exposureId = params$comparatorId) + outcomeName <- getOutcomeName(connection = connection, outcomeId = params$outcomeId) + analyses <- getAnalyses(connection = connection) + databaseDetails <- getDatabaseDetails(connection = connection, + databaseId = params$databaseId) + studyPeriod <- getStudyPeriod(connection = connection, + targetId = params$targetId, + comparatorId = params$comparatorId, + databaseId = params$databaseId) + mainResults <- getMainResults(connection = connection, + targetIds = params$targetId, + comparatorIds = params$comparatorId, + outcomeIds = params$outcomeId, + databaseIds = params$databaseId, + analysisIds = c(1, 2, 3, 4)) + + subgroupResults <- getSubgroupResults(connection = connection, + targetIds = params$targetId, + comparatorIds = params$comparatorId, + outcomeIds = params$outcomeId, + databaseIds = params$databaseId) + + controlResults <- getControlResults(connection = connection, + targetId = params$targetId, + comparatorId = params$comparatorId, + analysisId = 1, + databaseId = params$databaseId) + + attrition <- getAttrition(connection = connection, + targetId = params$targetId, + comparatorId = params$comparatorId, + outcomeId = params$outcomeId, + analysisId = 1, + databaseId = params$databaseId) + + followUpDist <- getCmFollowUpDist(connection = connection, + targetId = params$targetId, + comparatorId = params$comparatorId, + outcomeId = params$outcomeId, + databaseId = params$databaseId, + analysisId = 1) + + balance <- getCovariateBalance(connection = connection, + targetId = params$targetId, + comparatorId = params$comparatorId, + databaseId = params$databaseId, + analysisId = 2) + + popCharacteristics <- getCovariateBalance(connection = connection, + targetId = params$targetId, + comparatorId = params$comparatorId, + databaseId = params$databaseId, + analysisId = 1, + outcomeId = params$outcomeId) + + ps <- getPs(connection = connection, + targetIds = params$targetId, + comparatorIds = params$comparatorId, + databaseId = params$databaseId) + + kaplanMeier <- getKaplanMeier(connection = connection, + targetId = params$targetId, + comparatorId = params$comparatorId, + outcomeId = params$outcomeId, + databaseId = params$databaseId, + analysisId = 2) +} else { + load("paperData.rda") +} +``` + +\centerline{Martijn J. Schuemie$^{1,2}$} +\centerline{Marc A. Suchard$^{1,3,4,5}$} +\centerline{George M. Hripcsak$^{1,6}$} +\centerline{Patrick B. Ryan$^{1,2,6}$} +\centerline{David Madigan$^{1,7}$} + +$^{1}$ Observational Health Data Sciences and Informatics, New York, NY +$^{2}$ Janssen Research & Development, Titusville, NJ +$^{3}$ Department of Biomathematics, University of Califoria, Los Angeles, CA +$^{4}$ Department of Biostatistics, University of Califoria, Los Angeles, CA +$^{5}$ Department of Human Genetics, University of Califoria, Los Angeles, CA +$^{6}$ Department of Biomedical Informatics, Columbia University, New York, NY +$^{7}$ Department of Statistics, Columbia University, New York, NY + +Corresponding author: Martijn J. Schuemie, Janssen R&D, 1125 Trenton Harbourton Road, Titusville, NJ, 08560, Phone: +31 631793897, schuemie@ohdsi.org + +# Abstract + +To do + +# Introduction + +This is a very important study. Here's a really cool paper @pmid23900808. + +# Methods + +The study spanned the period from `r studyPeriod$minDate` until `r studyPeriod$minDate`. + +## Data source + +`r databaseDetails$description` + +# Results + +```{r, echo = FALSE, fig.width=6, fig.height=7.5, out.width = '50%', fig.align='center'} +drawAttritionDiagram(attrition, targetName, comparatorName) +``` +**Figure 1**. Attrition diagram. + + +**Table 1**. Select population characteristics +```{r, echo = FALSE} +table <- prepareTable1(popCharacteristics) +# Remove 1st header, with add back later with merged columns: +header <- as.character(table[1, ]) +header[header == "1"] <- "" +table <- table[-1, ] +# Indentation needs to be made explicit (not by leading spaces): +needIndent <- which(substr(table[, 1], 1, 1) == " ") + +kable_styling(add_indent(add_header_above(kable(table, "latex", + booktabs = TRUE, + longtable = TRUE, + row.names = FALSE, + col.names = header, + linesep = "", + align = c("l", "r", "r", "r", "r", "r", "r")), + c("", "Before stratification" = 3, "After stratification" = 3)), + needIndent), + font_size = 7, + latex_options = c("HOLD_position", "repeat_header")) + +``` + +**Table 2**. Number of subjects, follow-up time (in days), number of outcome events, and event incidence rate (IR) per 1,000 patient years (PY) in the target and comparator group after stratification or matching, as well as the minimum detectable relative risk (MDRR). Note that the IR does not account for any stratification or matching. +```{r, echo = FALSE} +table <- preparePowerTable(mainResults, analyses) + +header <- c("Analysis", "Target", "Comp.", "Target", "Comp.", "Target", "Comp.", "Target", "Comp.", "MDRR") +kable_styling(add_header_above(kable(table, "latex", + booktabs = TRUE, + row.names = FALSE, + col.names = header, + align = c("l", "r", "r", "r", "r", "r", "r", "r", "r", "r")), + c("", "Subjects" = 2, "PYs" = 2, "Outcomes" = 2, "IR (per 1,000 PY)" = 2, "")), + font_size = 7, + latex_options = c("HOLD_position")) + +``` + + +**Table 2**. Time (days) at risk distribution expressed as minimum (Min), 10th Percentile (P10), 25th percentile (P25), median, 75th percentile (P75), 90th percentile (P90) and maximum (Max) in the target and comparator cohort after stratification. +```{r, echo = FALSE} +table <- prepareFollowUpDistTable(followUpDist) +kable_styling(kable(table, "latex", + booktabs = TRUE, + longtable = FALSE, + row.names = FALSE, + linesep = "", + align = c("l", "r", "r", "r", "r", "r", "r", "r")), + font_size = 8, + latex_options = c("HOLD_position")) + +``` + +```{r, echo = FALSE, fig.width=5, fig.height=3.5, out.width = '50%', fig.align='center'} +plotPs(ps, targetName, comparatorName) +``` +**Figure 2**. Preference score distribution. The preference score is a transformation of the propensity score that adjusts for differences in the sizes of the two treatment groups. A higher overlap indicates subjects in the two groups were more similar in terms of their predicted probability of receiving one treatment over the other. + +```{r, echo = FALSE, fig.width=4, fig.height=4, out.width = '50%', fig.align='center', warning=FALSE} +plotCovariateBalanceScatterPlot(balance, beforeLabel = "Before stratification", afterLabel = "After stratification") +``` +**Figure 3**. Covariate balance before and after stratification. Each dot represents the standardizes difference of means for a single covariate before and after stratification on the propensity score. + +```{r, echo = FALSE, fig.width=12, fig.height=4, out.width = '100%', fig.align='center', warning=FALSE} +plotScatter(controlResults) +``` +**Figure 4**. Systematic error + + +**Table 3**. Hazard ratios, 95% confidence intervals, uncalibrated and empirically calibrated, for various analyses. +```{r, echo = FALSE} +table <- prepareMainResultsTable(mainResults, analyses) +kable_styling(kable(table, "latex", + booktabs = TRUE, + longtable = FALSE, + row.names = FALSE, + linesep = ""), + font_size = 8, + latex_options = c("HOLD_position")) +``` + +```{r, echo = FALSE, fig.width=7, fig.height=5, out.width = '100%', fig.align='center', results='hide'} +plotKaplanMeier(kaplanMeier, targetName, comparatorName) +``` +**Figure 3**. Kaplan Meier plot, showing survival as a function of time. This plot +is adjusted for the propensity score stratification: The target curve (`r targetName`) shows the actual observed survival. The +comparator curve (`r comparatorName`) applies reweighting to approximate the counterfactual of what the target survival +would look like had the target cohort been exposed to the comparator instead. The shaded area denotes +the 95 percent confidence interval. + + +**Table 4**. Subgroup interactions +```{r, echo = FALSE} +table <- prepareSubgroupTable(subgroupResults) + +header <- c("Subgroup", "Target", "Comparator", "HRR (95% CI)", "P" ,"Cal. P", "HRR (95% CI)", "P" ,"Cal. P") +kable_styling(add_header_above(kable(table, "latex", + booktabs = TRUE, + row.names = FALSE, + col.names = header, + align = c("l", "r", "r", "r", "r", "r", "r", "r", "r")), + c("", "Subjects" = 2, "On-treatment" = 3, "Intent-to-treat" = 3)), + font_size = 8, + latex_options = c("HOLD_position")) + +``` + +# Conclusions + +# References + +```{r, echo=FALSE, message=FALSE, comment=FALSE, warning=FALSE, results='hide'} +if (!useStoredObject) { + DatabaseConnector::disconnect(connection) +} +``` diff --git a/LegendMedCentral/dbPaperPinp.Rmd b/LegendMedCentral/dbPaperPinp.Rmd new file mode 100644 index 00000000..48879b43 --- /dev/null +++ b/LegendMedCentral/dbPaperPinp.Rmd @@ -0,0 +1,387 @@ +--- +params: + databaseId: "MDCR" + targetId: 739138 + comparatorId: 715259 + outcomeId: 18 + setTitle: "Stroke risk in new-users of sertaline versus duloxetine for major depressive disorder in the MDCR database." +title: "`r params$setTitle`" +# Corresponding author: Martijn J. Schuemie, Janssen R&D, 1125 Trenton Harbourton Road, Titusville, NJ, 08560, Phone: +31 631793897, schuemie@ohdsi.org +author: + + - name: Martijn J. Schuemie + affiliation: a,b,c + - name: Patrick B. Ryan + affiliation: a,b,d + - name: Seng Chan You + affiliation: a,e + - name: Nicole Pratt + affiliation: a,f + - name: David Madigan + affiliation: a,g + - name: George Hripcsak + affiliation: a,d + - name: Marc A. Suchard + affiliation: a,c,h,i +address: + - code: a + address: Observational Health Data Sciences and Informatics, New York, NY, USA + - code: b + address: Janssen Research & Development, Titusville, NJ, USA + - code: c + address: Department of Biostatistics, University of Califoria, Los Angeles, CA + - code: d + address: Department of Biomedical Informatics, Columbia University, New York, NY + - code: e + address: Department of Biomedical Informatics, Ajou University, Suwon, South Korea + - code: f + address: Sansom Institute, University of South Australia, Adelaide SA, Australia + - code: g + address: Department of Statistics, Columbia University, New York, NY + - code: h + address: Department of Biomathematics, University of Califoria, Los Angeles, CA + - code: i + address: Department of Human Genetics, University of Califoria, Los Angeles, CA +lead_author_surname: Schuemie et al. +doi: "https://cran.r-project.org/package=YourPackage" +abstract: | + Your abstract will be typeset here, and used by default a visually distinctive font. + An abstract should explain to the general reader the major contributions of the article. +# Optional: Acknowledgements +acknowledgements: | + This template package builds upon, and extends, the work of the excellent + gratefully acknowledged as this work would not have been possible without them. Our extensions + are under the same respective licensing term + [rticles](https://cran.r-project.org/package=rticles) package, and both packages rely on the + [PNAS LaTeX](http://www.pnas.org/site/authors/latex.xhtml) macros. Both these sources are + ([GPL-3](https://www.gnu.org/licenses/gpl-3.0.en.html) and + [LPPL (>= 1.3)](https://www.latex-project.org/lppl/)). +# Optional: One or more keywords +keywords: + - one + - two + - optional + - keywords + - here +papersize: letter +fontsize: 9pt +# Optional: Force one-column layout, default is two-column +# one_column: true +# Optional: Enables lineno mode, but only if one_column mode is also true +#lineno: true +# Optional: Enable one-sided layout, default is two-sided +#one_sided: true +# Optional: Enable section numbering, default is unnumbered +#numbersections: true +# Optional: Specify the depth of section number, default is 5 +#secnumdepth: 5 +# Optional: Skip inserting final break between acknowledgements, default is false +skip_final_break: true +# Optional: Bibliography +bibliography: bibliography.bib +# Optional: Enable a 'Draft' watermark on the document +watermark: true +footer_contents: "LEGEND Project Document" +output: pinp::pinp +# Required: Vignette metadata for inclusion in a package. +vignette: > + %\VignetteIndexEntry{YourPackage-vignetteentry} + %\VignetteKeywords{YourPackage, r, anotherkeyword} + %\VignettePackage{YourPackage} + %\VignetteEngine{knitr::rmarkdown} +editor_options: + chunk_output_type: console +--- + +## Introduction + +This *pinp is not PNAS* template started when the introduction to +[Rcpp](http://dirk.eddelbuettel.com/code/rcpp.html) by \cite{PeerJ:Rcpp} +was converted into this updated +[Rcpp Introduction](https://eddelbuettel.github.io/pinp/Rcpp-introduction.pdf) +vignette. It is based on the +[pnas_article](https://github.com/rstudio/rticles/tree/master/inst/rmarkdown/templates/pnas_article) +template of the wonderful [rticles](https://cran.r-project.org/package=rticles) package by +\cite{CRAN:rticles}. The conversion from markdown to latex is facilitated by +[rmarkdown](https://cran.r-project.org/package=rmarkdown) +\citep{CRAN:rmarkdown} and [knitr](https://cran.r-project.org/package=knitr) +\citep{CRAN:knitr}. The underlying LaTeX macros are from +[pnas.org](http://www.pnas.org/site/authors/latex.xhtml). + +The remainder of the document carries over from the corresponding +[pnas_article](https://github.com/rstudio/rticles/tree/master/inst/rmarkdown/templates/pnas_article) +template document. but has been edited and updated to our use case. A +few specific tips follow. In general, for fine-tuning some knowledge +of LaTeX is helpful. + + + +```{r, echo=FALSE, message=FALSE, comment=FALSE, results='hide'} +library(DatabaseConnector) +library(CohortMethod) +library(Legend) +library(knitr) +library(xtable) +library(ggplot2) +source("DataPulls.R") +source("PlotsAndTables.R") +options(knitr.kable.NA = '') + +# params <- list(databaseId = "MDCR", +# targetId = 739138, +# comparatorId = 715259, +# outcomeId = 18) + +useStoredObject <- TRUE + +if (!useStoredObject) { + connectionDetails <- createConnectionDetails(dbms = "postgresql", + server = "localhost/ohdsi", + user = "postgres", + password = Sys.getenv("pwPostgres"), + schema = "legend") + connection <- connect(connectionDetails) + targetName <- getExposureName(connection, params$targetId) + comparatorName <- getExposureName(connection, params$comparatorId) + outcomeName <- getOutcomeName(connection, params$outcomeId) + analyses <- getAnalyses(connection) + mainResults <- getMainResults(connection, + targetIds = params$targetId, + comparatorIds = params$comparatorId, + outcomeIds = params$outcomeId, + databaseIds = params$databaseId) + + attrition <- getAttrition(connection, + targetId = params$targetId, + comparatorId = params$comparatorId, + outcomeId = params$outcomeId, + analysisId = 1, + databaseId = params$databaseId) + + balance <- getCovariateBalance(connection, + targetId = params$targetId, + comparatorId = params$comparatorId, + databaseId = params$databaseId) + + ps <- getPs(connection, + targetId = params$targetId, + comparatorId = params$comparatorId, + databaseId = params$databaseId) + + kaplanMeier <- getKaplanMeier(connection, + targetId = params$targetId, + comparatorId = params$comparatorId, + outcomeId = params$outcomeId, + databaseId = params$databaseId, + analysisId = 2) +} else { + load("paperData.rda") +} +``` + +## Methods + +## Results + +Table \ref{tab:demographics} \ldots + +\clearpage + +\begin{figure*} +\caption{\textbf{Patient demographics.} Target (T) population is sertaline new-users. Comparative (C) population is dulexotine new-users. We report the standardized difference of population means (StdDiff) before and after stratification for selected base-line patient characteristics.}\label{tab:demographics} +\begin{center} +\resizebox{0.5\textwidth}{!}{ +\begin{tabular}{lrrrrrr} +\hline +& \multicolumn{3}{c}{Before stratification} +& \multicolumn{3}{c}{After stratification} \\ +\multicolumn{1}{c}{Characteristic} + & \multicolumn{1}{c}{T (\%)} + & \multicolumn{1}{c}{C (\%)} + & \multicolumn{1}{c}{StdDiff} + & \multicolumn{1}{c}{T (\%)} + & \multicolumn{1}{c}{C (\%)} + & \multicolumn{1}{c}{StdDiff} \\ + \hline +```{r, echo=FALSE, results="asis", cache=TRUE} +table <- prepareTable1(balance) +table <- table[3:nrow(table),] + +print(xtable(table, format = "latex", align = c("l","l","r","r","r","r","r","r")), + include.rownames = FALSE, + include.colnames = FALSE, + hline.after = NULL, + only.contents = TRUE, + sanitize.text.function = identity) +``` +\end{tabular} +} +\end{center} +\end{figure*} + +\clearpage + +```{r, echo=FALSE, cache=TRUE} +plot <- plotPs(ps, targetName, comparatorName) +suppressMessages(ggsave("ps.pdf", plot, + width = 5, height = 5, units = "in")) +``` + +\begin{figure} + \centerline{ + \includegraphics[width=0.4\textwidth]{ps} + } + \caption{\textbf{Preference score distribution for sertaline and dulexotine new-users.} + The preference score is a transformation of the propensity score that adjusts for size differences between populations. A higher overlap indicates that subjects in the two populations are more similar in terms of their predicted probability of receiving one treatment over the other. + } +\end{figure} + +More text here. + +\begin{figure} +\begin{tabular}{lrrrr} +```{r, echo=FALSE, results="asis"} +table <- mainResults +table$hr <- sprintf("%.2f (%.2f - %.2f)", mainResults$rr, mainResults$ci95lb, mainResults$ci95ub) +table$p <- sprintf("%.2f", table$p) +table$calHr <- sprintf("%.2f (%.2f - %.2f)", mainResults$calibratedRr, mainResults$calibratedCi95Lb, mainResults$calibratedCi95Ub) +table$calibratedP <- sprintf("%.2f", table$calibratedP) +table <- merge(table, analyses) +table <- table[, c("description", "hr", "p", "calHr", "calibratedP")] + +print(xtable(table), + include.rownames = FALSE, + include.colnames = FALSE, + hline.after = NULL, + only.contents = TRUE, + sanitize.text.function = identity) +``` +\end{tabular} +\end{figure} + + +## Discussion + +## Appendix + +```{r, echo=FALSE, cache=TRUE} +plot <- drawAttritionDiagram(attrition, targetName, comparatorName) +suppressMessages(ggsave("attrition.pdf", plot, + width = 6, height = 10, units = "in")) +``` + +\begin{figure*} + \begin{center} + \includegraphics[width=0.66\textwidth]{attrition} + \end{center} + \caption{Attrition diagram for selecting new-users of }\label{fig:attrition} +\end{figure*} + +## Inline R Code + +The PNAS sample included a fixed PNG image here, but this document prefers +to show the results and embedding of _R_ code. + +```{r figex, fig.width=3, fig.height=3, cache=TRUE, echo=TRUE, fig.cap="Narrow ggplot2 figure"} +library(ggplot2) +ggplot(mtcars, aes(wt, mpg)) + + geom_point(size=3, aes(colour=factor(cyl))) + + theme(legend.position="none") +``` + +Here we use a standard knitr bloc with explicit options for + +- figure width and height (`fig.width`, `fig.height`), both set to three inches; +- whether the code is shown (`echo=TRUE`); and +- the caption (`fig.cap`) as shown above. + + +## Digital Figures + +Markdown, Pandoc and LaTeX support `.eps` and `.pdf` files. + +Figures and Tables should be labelled and referenced in the standard way +using the `\label{}` and `\ref{}` commands. + +The R examples above show how to insert a column-wide +figure. To insert a figure wider than one column, please use the +`\begin{figure*}...\end{figure*}` environment. + +One (roundabout) way of doing this is to _not_ actually plot a figure, but to +save it in a file as the following segment shows: + +```{r densityPlot, echo=TRUE} +library(ggplot2) +p <- ggplot(data = midwest, + mapping = aes(x = area, + fill = state, + color = state)) + + geom_density(alpha = 0.3) +## save to file +suppressMessages(ggsave("densities.pdf", p)) +``` + +This file is then included via standard LaTeX commands. + +\begin{figure*} + \begin{center} + \includegraphics[width=0.66\textwidth, height=3.5in]{densities} + \end{center} + \caption{Wide ggplot2 figure}\label{fig} +\end{figure*} + + +## Typeset Code (But Do Not Run It) + +We can also just show code. + +```r +xx <- faithful[,"eruptions"] +fit <- density(xx) +plot(fit) +``` + +This simply used a pandoc bloc started and ended by three backticks, +with `r` as the language choice. Similarly, _many_ other languages +can be typeset directly simply by relying on pandoc. + + +## Single column equations + +Authors may use 1- or 2-column equations in their article, according to +their preference. + +To allow an equation to span both columns, options are to use the +`\begin{figure*}...\end{figure*}` environment mentioned above for +figures, or to use the `\begin{widetext}...\end{widetext}` environment +as shown in equation \ref{eqn:example} below. + +Please note that this option may run into problems with floats and +footnotes, as mentioned in the [cuted package +documentation](http://texdoc.net/pkg/cuted). In the case of problems +with footnotes, it may be possible to correct the situation using +commands `\footnotemark` and `\footnotetext`. + +\begin{equation} + \begin{aligned} +(x+y)^3&=(x+y)(x+y)^2\\ + &=(x+y)(x^2+2xy+y^2) \\ + &=x^3+3x^2y+3xy^3+x^3. + \label{eqn:example} + \end{aligned} +\end{equation} + + + + diff --git a/LegendMedCentral/global.R b/LegendMedCentral/global.R new file mode 100644 index 00000000..20f4b2ce --- /dev/null +++ b/LegendMedCentral/global.R @@ -0,0 +1,25 @@ +library(DatabaseConnector) +source("DataPulls.R") +source("PlotsAndTables.R") + +# connectionDetails <- createConnectionDetails(dbms = 'postgresql', server = 'localhost/ohdsi', user +# = 'postgres', password = Sys.getenv('pwPostgres'), schema = 'legend') +connectionDetails <- createConnectionDetails(dbms = "postgresql", + server = paste(Sys.getenv("legendServer"), + Sys.getenv("legendDatabase"), + sep = "/"), + port = Sys.getenv("legendPort"), + user = Sys.getenv("legendUser"), + password = Sys.getenv("legendPw"), + schema = Sys.getenv("legendSchema")) +connection <- connect(connectionDetails) + +exposures <- getExposures(connection) +exposures$exposureName <- sapply(exposures$exposureName, uncapitalize) + +outcomes <- getOutcomes(connection) +databases <- getDatabases(connection) + +writeLines("Closing connection") +disconnect(connection) + diff --git a/LegendMedCentral/ijrexoda_files/figure-latex/attrition_plot-1.pdf b/LegendMedCentral/ijrexoda_files/figure-latex/attrition_plot-1.pdf new file mode 100644 index 0000000000000000000000000000000000000000..969989af7751e811416e4696a1b5abc561806e12 GIT binary patch literal 5186 zcmZ`-c_7r?_a1~yi=CACBtn*1j5Sh>E$i6#j4_yEX3UHl%h*H6OQIxu_E)lHi$X}2 zvG%5vETssQHB0?w>aBPC{_cPGIp^Ga?)~FA&pA>SNPPvEA_6QGJ{3M4P7fb;CV^o9 z6d<^t18Zu6A-W_int~(Xk!T7QkU?s|p)fTV6sin^B2=JoSun(u;PL<3tZ@_{MwBIB zKtdC}aTqdS?oT25Qy5_uB!Y)O21{aEl@yf~VGQj1T?8g13qE-gjKzB}vw;7~27p)x z5U~J67fnI?5WE101=?cqnyh9$s#G>c{-7Fgwh1Q|qr zp*XLoMJf=%GN%z+S){jXI{2q?ccnq7S{NUoGeN&@KNZb|kH6hqN{;)@REJn>T`qTC2WOX{FfoLi<2}*qbtJQi-Sc>d#aeRqmgf zUnf88m|rZIgQ&ep^i~Z1@}~aoRC|X>$5^XYzwZHjJ5gHQs3Jt|0C=iCCg9|@dro6p zMz`H>TfaH`%Vt7uHq7~*PcBoe`LqhP(^@=88f`syc8)YU9St~T8lCN^8r3bQ+suMO zFxh2dJ=8TP;p0Jz#ziH4gB-*VWJp`b^Q;U%l(zO8cbne6hT`mOO6ANOPnQw8d6PYz zw7giHok>M$t1jn-gv@ogf3aM2k=Ia!CpOh9y{6{qXMd9UvRL8bAULnu6|qSlRclP@ z6edzW;Tp$Z`95iUW}Bfvx)bN(ve@0XH=8Z}kQ7!zDL`()KyFnk`dIJIf5`EB!V&_@=5>BCz`Be)XF+WTmgrE=!9 zrZGF^s!)Yy0Wq$kRqqL4Z>`_CJ7=nbZiZ>eax0tlQeE%dj6|>VPVIXsPk z*6-Ip6_f-M%A9G3%Dw$APnyp4&$n-Kj-@uW>n`6(=tmFVIzT^z2IWVIX1k_6M{~)G ziaB-3^8!)X0CpF4s&|#EesIV$RxWtBH)kVZWE^_ZRaax&J5vPk+DkfSw@E+JK2`mk zn8hzf4w0tXQZZ>eGIHB?*U-stsOD*X-{8d_sGapl*2@K-$AwWjW+x{-Nv9V&F^R0_MLpX=-j$}~tpDgz$Ni#Y42S@%S=^xw- zF~)h20VjaT$(Dc%gS!d-3=W0?5L2uN4y{9=0!~nd4WR@FRN+vUztK38hJVs7qgr6B zuoS=v!l+k_8?aQ03mBr$pm0D_6QU0XV9Z0l7XgSKm11B;VU{aRO#otG1y@!DV9b(c z`D3TXVDDefx&$8r$%=@^{O~4Q8t4GZKdpb26eh&X#R+1htE+=1V?6*BrkBglBE{VO zeE(@?RlqY7fFQ9Ka2PD}P>30$@Id}7A8=)LmH$~jn9u)JJ~GoTT3d|?#n78on=P*L z#9bRW?`_FyxUbnTS@AfGi|5S4B#?v((wc}wB^U07%e)TD*G;aJh`Ypss+`{?f*kQ9 z3LHu^@+cRXxF4|8moXu}9&$drnf}siiT1P+l(Zem-ezLY6}C6mUSM*zBlb$Xmm4R` z-j5(QAJA)Jb+wMrhCXXLYw)uKpLG5W;pWEuz?ZG#!`cb0pl{jN8XP2GAd4Fbv!6G{ zoJEAY)wJwxN!6Km-?)b`?T4P}mvD%H+oq5|%R2?HrDM6(m*G*GB0c2(DeT9Yap~zR z>U=E;$!;RTv%5DM;4Q~6krbooQ=NpFN|9hQ6_Cu;amBY}D-Rz9%vBk9gu-+H=(S<@ z*^fgI`(8SK4|hj@ucIQLWKpchF=wmjD=GZ(lXSZ2Y0sGbv3B3f^Un=NT|zp#?|!;X|7SBiy}zzjrKLWko0|^yM@@=vCSA? zoFK?$p2ebRC#KI00*b3@@!wDL6Kf21wR|)s?` z*6A^SEPJ|6^r?;Pn;YEiUvG~!q+Nc#!8?#<&suQg;HeNXkj!yjfGfyDZeWSFr_+G# zOJDq8`i;yjdc;?nUA@WI$3l{!i5LSUyq*u$|KaAgBP#*`>78PmJ9X$C8~?*y_a5@r zgScO_v7VNR-R0*7dmSN=#DWBb1;T1`4qS^UcatvW@Xz5zM5+)EP{J{<5o(-@;XQ7< z##t<(`?JDiKZ1Kt@kCvE%p+(SLjiOji&kB-PdYTi#;(h2A$o1Ml&+2;tKg~m9Lr+S z(&)Kd&v#DmWGDw4LHl&;a!}rUn}UIyN1FXp@CAoNylqK=qX2qR)o+Nf#ydlmo zx#+Qz0EeC)%);c_o+sjhm!|U4a&2=}@=H;i7MaB-M{Gu9&Vg5XP4&;`^$qsF15xBP zL^9(Q_3d&p1`fZge#g6_wkgOFnTtt)B_0Sh5j`eY%~~x|eP}pQ{gOy$0=lr${&$V1 zqVsY4I!JfjePH*%K|DcxLF^|IX^}^#D8zeeXPq_8V&xv$ymll?6YYrn^&S<&=2Mg*{z+JeME*of$L6`q0Vu%LhjW8eKq5HW9n&1zSUT>N5s6a`e=J2 zO{Au|s8ov-%Ft6%MK)aWi0_dF=}d{263swLx4s8ANz=jPl@9(`_K^wc2dJFm_Q!Y0 zd=#*i89(9r6Td=b87o^l?vGhEO7-j z1nF41mL#0C+`K#6$cNTIpOPh7KqSkKjx9Ku9$f?$yz1@$A z2Dhgq_ZNGtzzQkK{yY9sjjN53jY@%?fvCVsfeV4_D_ooMJCZwxH=8%DI5aqpaIkZf zbJXqo6fNH_(C!kw6J2p7;fi~L$^m~7Ex4`HerUfcUb*GGj*6eEgXfSNsZRj&1a7MI z(l>ByuS&J5F{})B2p-dSxR?EHQ(uh2fRLGxPCQ5aArrpgl=OBVY@*|kLZreTg(mrI z2NC-YC*SJ1x=n9iLMHyDH?1q$o!{Hadl<7^R-Uf#$Gy(A=gyyVq#F_78^H>JIf%Y zE2^l(t914>-OKfFjq(EX z1@rmyGV;%MQM;~n8Dh%a?K)lKhGY33`FCNa^QSYWii9`i#~X;6ttWHUCO0Lf^#bA* z<)7N$YT4M}>yWx7WxzLh8FpFW@{)S)Esp+`p|FBlMa4z_EKUL^;p);8$gH_! z!?9Fptuq%)Uu9{gPi0vqf3|)oWW6V=XtU^PL5tZQ(-+xmvRcQQwb-sF-|(|GT6sbs)y*BVmt_Rj%-x(`i;I%g0nT)(x{r zSx|yo!`Nrj9_i1t1=`J5C^~AjbQ1c)Yols$ z=R;*`6y+ho4T_#F=E=5$H}fi2L*||01>^KOR8{JIieJP&mwBdEk6SD(H5E6eN(md6 z8_S)UAiTx5Y^3(trJkidzgmO6+neh{x9zo^d^-PPyza1!ogy6~{z9y(naqhX=uW(T z;`)dC7HB(EUHo0+Dq}|x=P?(oMQ!aI&Hv1*;T1d6pmNWJ!smZ91vFKB`1EYpw#dfL zaUEabw$vB+V6&eiKRS+fgQmVErlPO97TUMj*kF`jQuDq&WHRJ^cq|*OFR`yr;idw% zoLF|-|Fc_LYtIBVbogbbPZ^=8?z$LjjAV>hXvW6EYWwM!px^E$*3i5*Tzole^KbLd zIlodLO&yY2NSqftd5~ID*Hut79n`b5E6!1>KWGQMTHUVP(=VLp>f!RCafVnzei)K7&ABD6 z!Eu=5M2u)mBjkk3qDYo%@KoGZ>abmNMOKp#abf83cJkyr>JP#z!}=r5-A!NK*>0B4 z){*h_aR;(6t!^f3s5x%y=K7%!#7?El9H4b_PD|sXTWjPA%y^}=Hul>}$o+RmzMwmz z`jN{=Ul?>9qe(-wT{o!PMo&}Hi#oLBzBzC8&Wv4rK;4Ez1y3k{bza#XuE;oB{NUNQ zp+)Qx<=M)Pok)eJ>-GDnQ1WYqdEakMH!kukH7r#w$!XsRdH3bO%BRJm1oP|=w)Lpx zt^dey^7&;P8xL2~)QIwX?(FPvgnBp8yzw#CdvR83PjL1jGqIC_{X4 zcz-hB^0!IMcai;5<^CAOe3#%5D}Q&&_sI+sWN3Rcv@b*aGGzJpOMmznVtp=PDL4!o z4EcE}z)bh=lbi1{{io*taltP&4~AgS08|kUh5kLGzlKA<9{f}Oe-D5uLjMs!C1E|m zPynU`X5fD=Kt)+uNg412eqnG%yTDuk{uc&QVYE2^#9%5=#%So@nEHQWVQNbM15;u2 zH~)-f5B522#`pZpN2%8ah)Uw*3Ue~YD%&^R9~i81H{AXd0Q sEaP7Qh!NhCz-Z9E_e+)p0tNWhEs-f`66O03BGeFSU@0j*bA9mt0T$cYhX4Qo literal 0 HcmV?d00001 diff --git a/LegendMedCentral/ijrexoda_files/figure-latex/error.pdf b/LegendMedCentral/ijrexoda_files/figure-latex/error.pdf new file mode 100644 index 0000000000000000000000000000000000000000..8966ee0810e4bec025819e176196d32e819bba49 GIT binary patch literal 40444 zcmZ_!WmFx{(*+7+!GpWIA0)UF2<``h1b27W;DO-o65KVo1$TFMcXzml}G33!X%>S zsAp+oLc*k=XJX_)!U}o-Nb>(P;QW6Xyg&E;w7rqFg8n*?aQ!uB0vb8k zIN2M3-pBU;_rCWB{^t%EBWn{!QxaAVR#r|DCNVQhN6-?O#4JJH`C?>XV`%g~aR*0` z)2!fK(}umIE3CP#S6aM#lA$E1`rHNcIncm-x6e#MEdanL zm9Opow^^sOF~pQo8puD<2A(fei66Fz1z+co-wq=0*2EuW;NG_5W*;;XULMxI-(Bbk zydL}ze46?GIwbgZe_KL)>F??7`0`X@L-y9A^9J=$@wO>Qbo_kZF8Dn6b{j45diw+P z(y{Mv_ab$VuU*LP<)?x!a7)i=TjY1ojf3K}Pc;>h&loJT8olDdFx9pV1v_Bs`UkG~NTwib2Pqh~m z44FMlO%Wf}a6Z9!MaZko-fJFV@a~!LYh5=M$4fPJeC{1nw>Y?(KI*zC=XtPwcIDyp zO1NdyODB46VjjyZnC81QA-pYcdcvrIe>85l&gA~k`aJ=y#Ycg|TXy*Qc*!l(+iGeE zIzT7KdV-eL&8D&a<^1mU>F4B~Nrt6#JYTE2SFL)LK@tNig0R;WYgtysSd1Sw%3yCr zNOC4U?-}{gyfz2P%~X-bb+I?|s>Z45kg>e6O{gBxLH9?wbKoueXFZrw2EwGrgk zmVi>r+8*f3s{-z`=yKNupKDAd1fFfQGeG@f4D-yb*~wg>+xEcJD+8iWXPcSdv* zs|Dij0m@*4V~~1g8TT2v1pqW)c$HH9eq3Bj{qlttTF@GMFJdfvFTCLn&XF|Ap+`b6 z(X|tn#vWzdDT_06Bp*G<>`3i>o=O9se`s#D?ig!)d$T-lj;KSq>UV%P#78NaANNv8 zPye9qW%WH_=Q=|`!(LmMX2}~cJXJsBCf|Pwvw#`yj-=f0hlnWcz!B3=)^eY zM0j~c^oiI|hcY8D)!)1-J#O(UwS2})68CFLzbnd?0U3UaXp$_@-1ZtMtD7DRWUsdk zgS!e#nW8;$*n*U2h^$3;>`fRWxX$y&0c3efi@Q17uflLACVqr%2aPDgc(H14(S}hf zGe%eZ5}5SdSOT|jK?$r!ZK)#}N&MvZiueQb-LYlvFb*n{CoSny@J5i2y~#_`U zWxfp*0Ax9nPdph`Q4Su^bA3R zVuR4JpAr;0N6oh6QWsjx5nNKNPlU3E>QQY&-#!yNYoaib(l50msF+R7{qdMBIyQm? zYS{ma8<*dCx-yZ6R;cvd#hSmWpuzzCH({vP8(pN_0o5}JG6z4d1g?Bn*y~7YccuaE zv%&ORyp0tsLAU%KM|0t{<-r%th++N=5>{sP`(rp#9nv&Ca!A7mOUEsI?p2mTYo|^j zes!i3+fBT((RlH?Z>mG!EO_`*Qx5mH0=^wL&z&u?w6}~gK=GEW8R|SRX=lC)>gZN(qdu_ zin1t+Z1VjmX;5UFBgCao#eRzoDN?ii^=kSp=~1NrFjb*dB2!_gpS~ZIf}wIECY7O_ zdTvGw&_$Vx@Q>3)mD^|ADjLwc&OEi>S8#4mx_zTx+8pD?U6LgcmVXIO&ioC}+7|s@ z0kq(|Ymd8Xa5EDt{{5)X7ADa5MjGKHR&TSG=}5|$zjeJuY%HZg03-0X0x7sy(&svAnZ}=H+9nk4}1{i~)?RYJW=cQ&b`e zse7vY1vH1&kbYT~4QQ4CT~@_Eug-vig?+)%d-5+(8OY`niav!hPkW;8noNbLL&xFX zglBQ8ebOvR&?1-n3AYwFWga>1smMW6Hc%~p97S(77`R+Tb;PXYCA<3?W9zr~3M}`o z_+`?duT}}~@O@)YId*XNc=Hwb<0>P)Wo50D?QM5iM=JD8>>bxa5p|Z9CdZ4CsXdcO z3jy|c2|HFB9ER87I}t4bj3pzp56$uGvZkMgIQnm9aUBQa^Fo4_^?qy+*)BZNHT%wF zOB!l@jatG6j`O;g49xa1c`iJ1t#K)v$>x+rUR_t;)S_PJwuaQTMLn5IPcpSxBU1ah zh&0K8K{u}0L$w}dRf-F#)GYy6bfi4nSg%+1#rl_kei>}~(l2t>3wl`BhkIK!fbO(f zn?EXkR0|WldcQbeO)eqgldj>Na9aWtZaEjxKHZ8uL9U7;*9p?#M=iMqO;OUi>e%aC z1yWax_u)CWgYN`%>FImh&!hl$r9VCLpD#@;UxSX8JyVFtJ+QV_vT?6p8ePuOs;k@W&K6nh2A)Wap2z&okAB%1 zUYEz_f-tbJZLM;4nCqy&8d}S(REtlG!e37X@^Q8eEMZ!ki)$dNt7q)Z19Cpt#K4t*{cMhK!qpm} zxq!?F7)DU2tyHXErIX*7Q zIHXFq$JAm7ShgHunAbS@d3e<87;8QG4ZLP~JKFL-f(6Ds_S#G}Ws}m-Xlt%}9bTqo zAy;VudSmXZd&vYXHmKrOI3ZpQ-LUA6N~Yk$jM@-P@fAEIS@#ugT}Ra5xq<(()ak2i zpFU_A%Vk;_g5ExwhvlK9JOj8KGvQ8+pTz_xE8y|o4pOF@DS!6PiScWzQjJMeh-{|N z$HP#$toB!P4!>y|LL3H!(bJv%5^VV`ee!E~!5>@uS2MKc;EVI?QqSkD*E60PvPQ2^A0oTBEOgt^gvNRw6VSgvk<_ghsN+F=9F1&Mk~C zx|j=ULG@cn@$N4<+h3p!Rt=)X>Po_#aTBP5FmSA#=p8yWtPc{^WD&)A2JV1z(pg7fW@B;{{t5he?)ATEb zxpowGcD{A)q*=(eTPp*{xyc8lY5L4e4l#rR**boH`Rb|sx%%vKHEizd^r-QxoOO7W z)zBVmr&k#26tkS|t{X@7&pWn)P_Tn9_QUJhTaJ|4!j!!@EDfyKHk~*I3j=*ghtOK~ zzIT+IOTbXV)clc(3WOS4FD+Tg{-Is9as@e+;a#5LAj-$zgfcBY#>2*X`K{0-XWfXp z3qI!-(}2GrP~Rq9lkU2x{Mf`Y1aH3L*bo@V90&}q0K{sY|RY3Z)8 zlTB{cH4@+3JP$_c3m;mOm|F&^ZK_UmjIi6Wl~!_<7|+|bBVKl7N=;;Eni2FG6e&~9 z5el?hdMUQCDhRKGoIsFY-QJ7>U7&p_u=e{wT3-0DK#B9<@1R?n+{|K^w+=fU3?63o zO}6hi56 z8vp4wkPopUtl;R>K+iqXuSvc(F0j2oJM=bSLd3W|weTNdPtek5thOHi8}UcYY_(c- z0($3*8w~67&Gh+!r1fXuCMgwJHjW#UW5&RR`~0I z;CWkURS`TKnG44?Hg+}6HDgn<7-5lt1g;VG$UCyChNvps&GB?96Fd!Q*dCiK^!#7& z)-M9Ha^{a}EAaiNzWQtJoh!E>GWfOG&G1U+?vGFQNcRuU4*ssfn_mcS;nFHP-nPjC zq4VD``gKLU>L@$+fPU=cA1Q82l*0UTDwlIh%xEMFd0uUR*DxAjC!F;)!T9%w*g;K2 z=Svr_V%~!V+rjr4KY4e!O!HSWHy{Y8nh&|VZ_cwdlhljFWo>COx_#&Y-SKwHsDd9m zFdD18syRJS-814klRh1P7(13?Ce07*0fBek?3i^RE z$nH|3weXfP&6+ESL1>EfH&C{{Z&6%^69c^G(i@mp+AK?q8NQusx{9513qUm8*iRHJ z5cNnG_P}M}EVG7USFnC{zU8%hFL`93t<9`qT4O=0?rRhCkTwgksAF~z#11#-=d}jE zI}FF9@7+sIL}~-73yPXsq)hBY2_Gex@a6t*r$L$7Mmr#IJ{R5rMsss*D2YRmm+l9v z?$x8rUl3U%$IbMsK@>fI5eK6p+>MFXIPtw8Mc*Ynxo0AJ(Ve(vhJBqSa&^>T8ja}S z>{f~z)n5!ROpIKooPOR>j3mr~vgw87PDo#gDEzxcY2BH{@%Qy!B3zjZPv%Nm$2`?m z;H(P=3aPC5y^23_-^%Y{VsQF(vaz~{);Fo^!o}PgJH^U1{&|YwbxfMN8EqSz&xo+m~bHJvC5KYGd8MrC4!;V{ey6gHFwItvV?>cKw+3pM$(x z_n7)1s~QE2ld?@_#*!Fo58XG^-Qgs=+_7*AmX6p#+s>^X7UmuA6_vpl$;Y^l{Q$!M zT6)VN4iT{d7M*~Or0-1|50{h%0+y`xDAkX3H|bM*ie~AF3d7iX%)33I4_Va)ZH3m8 ze>((&)1~@PtQ~XVzO)<3(YNXK$txK>E4{v-Q=T~FB>GMwUEyTw^WpqE$XD}oK1=)k z_S0C&l70uV*=45uhLclgZ@r*nfAM$^*U{cTD+p1gE>0i3QdG!57=QBIsoY46XVX!G zouIWmTJhg1+itNL>WaEwV@gx$*che`Hn{%qgGHS&@$V05R|bPNaVJkh&r$5*Ex+^4 zzO(e-C05oczHd}(09;A&X`_edP6pKxxqW>c*tFF02La4TG7tr+MT>55>I?Vm%w{4e z=K{?W-#`V4xc&cp!z!EU)WjE>*M`7CSnoWR>pgpKAF(U0A=B3>wvW#~QIMLZJ&Fk0 z4911)p!<8kTuy358r3({=&s~S13`-wu;PvwvQ2zl)p+QOIJk5m-ff{_GVMJ5&?;vq zcoJ&Eagtc`^82YDI8uLd1hX2A{pkPgTDQWHMvk-W|MImmD$OxG~zE z-QWCXy^t*{9D01kC8QSqQa@{ZNzFd|wp))#f3erzkiTpL%Xe<_cB)$%PM3;ex$tXTTx9{DmlL2c+$TWkV{F*=Tj zL+zgnD{ya<>uqc2+>FGoc$V4$`6}$4b?mkwT<6?{d*K_vpN-;#4Tzl|ueD({ymn)d z?)z1bdq13uaM`B%rFN7&<28Ic56$!)t2D=PEUw^?u^Uj*cz*5Icw#yH;xVe_+_tDO zV)5y5%h#movBY`c$7^X?{o$MW8IG4^!=D<8{W-k;&$W816L%?4={4a>-K9b-zC6^# z1&PV|2A8#0eFeLaw}j|-;3wqv-{uAvg4l($WE6A)1ik;X>a3e8+Do>5N_Wqks5Ftd z@i7P(PF_OLxb|rj^|1!+5XZTS=zHf_;Js3`hvB?*1JXOx$U!^La6>`+LWo4stiFiE-7_CqAz(9 z*|w%24iP155>9#_6;_a;|B|3C}Yc`N^Adp`P``i_RwufpI&(W}B;>!DBr z%u(}u!~whjrEIBp`ef|{GL&LEBq#>`F8u4 zaxl#$r0eXe_D-K;o7N2%oogweIM8|jb+!p3;ZQzI7O}0!>z)Ywz{?}3uZjOl#vA5L zF6tVk1!9KvOI$N@hIOmNoR1ly0EzB5C^pw`F2%TX-7qBL)373Z`ZT7|;nqE@?>CH{ zizUh1q-T%v@b`PdV}`tAD<$$QwFZAMh5Bevq$=GhB6XX9NjW*>y3pQdY)UB=fh}Vt zr^8?Lzb~<)#LKvKhBTWdMy94}?L5QW2;yp$ zjq+xwL5aGr<^AVKhP0JO+8^@f_1e=lmKu04+Hkp&LI~8x&{q3iT*N+}eQWz1iK=MC znT6TY&VgB#Jfi=;yFaytD0^qEAv!t4c-lrsNs^q zP5a*s(O=TD|4y>ieNCW7oE0+L)dz2>=$?a>65{ZMCw(zewx)ScYl-12!0HKf;cQiY z?dG-6sBO8E`Z6kf*htgA#yeHV?NeZ_m%5U1XnmWgL zc%e-P+QS$z&&1NX^(w6RbA#dimz~(W&WGZRuOEE6*QSb+`cA!~Iiy>S9}aq`Kt>qx z@ar0-g#XQM^>x={gCe_s#974iv5E?!*i@!q5rc%-*J6V$083~qG_NY(W8+JDt}x!^ zN_Cs&K*S6$Up&hP&aV|Fu56LxN^lb4e6haDS7_+OJ_IGCC~%C%y)F!^B6$$DC)Qk; zlTl|e>||~XQ@>LPBzy{OQBwMR#_?MMPA-_imJ{Zm^noV31IA7;rONz{+`$ZeYy`Z( zOJMBN&zjL(FjI65uptVAjc{6mt+4vmb3Cujw}A?3+(L9IzEPDXNZhvBr#^%0iF zdy$N6W7^QuYKzYZw8ocgo_}k^8a3B32^>_B-TOsNfkY8@(JxD)%wY|6uQ1IO3#n4v zgn>u>67N-HQgqj(#p4uzcE5s?=+aTl3FNV&12u(lqrA0 zFK{S*>aA}$tyeRk?pE8hK;XdiOr$TboS~)5m4x@*s@DGHWEE1PXEv`e?AlU0(W)?^ z$egP4gcLeYe>jOWM?mAfCk@p#BYPq$omb~t>BA!$$fo}4#dvg+(ofgqSFg8Wc+A0& z=E>m~c;)`pFEG}3snYh+)TitTekmwWsraZZ&Xpl;%UxtzG>=X4v!doKN@gbaCV?G_ zkb$3>$=c!-QYskRzU(E156=49qOt>X+AU140HMUL@QEa5xdvO#M>G%Oys8}(B{7;cTC?ULF$zOcYAIw(|AF|#l;)5dm7EBWD)K3U&DGt7E|+wT@(5E>y&$Xt zVFH7_b;;Id*^d>R_LB+a$)}U`B^+WOw8sx9xV`x2l%jy8WS=AKk)l8jJ3KGVSzAy4 zA~P|*c>n$LscJPFY7~@=kHoD;0r;uhSi$B3Fq@Dlefnf5EAgJ{NM98q*__m=ivmNP z%52mt;tRY@%(8k1gjiRs;3$WYtk>4$PA0i(Aep4Q^6cs~wiwnd(jI2HrpoNJt9zRS z@#JN6u(Rn+U#j$x)a-j3e?qQ{J#9}Lg(|E5dAtxv0^iVMsqzck$!ilv8QoBp*m5r& z!iy#j`e^Es1g%e({kY(Sz5EM6LJDSeW)i3kKjZyd{Ty}w^jY}J6-~oDZcXAhFR>~) zAnC^(1|pxArSt1>ZITezYKYumcq!1eK1J@K1n?3nY3IO zaYyrI;+pl}(z8KWsZ|{`C>AcDTo-Wjfli}0_)qv)72K%8LJaMN5}n53Ci%E^Jm52V z@#qiNT87$XI*nDi^xx)6Mh@x*$Jk3pm{ESPU+B-i4dV_FrIz+3NE&lMIH~2jU82&U zszC<_sArg3pUUPzjL-LRET>9Cf_fQx+dA22=N{ww@(Cs9`Hc0!VAAGJq18GimWrQ( znPUuJd6z5W*&1IO0cp{oZU%^F{4Y=}x}mtlBTmZYgb)L&t!_z(&u}7BULEnkR5xps zMx=c_!4&Ac;h`Yc@pMcOZRs(67)kdq;x~Ok$gGKP@rX0RFCV<`%&UDu^fX+KwALm2 zhmNN_q^s!4Q~d(m^wdEZN|+!T8Off3y}1kSh~ghwo;qcQxFqD-a&W^IM)#4=Eq30q z?I~S1l-BOYWiR^kT!0srSEELwTA_O?kgJ>9$A>$``~!9DoF1`mCl+^1_Rp9 zYpSoZbjBK>vwo^L(OolNf(J)gYAvpmZypiad6Z2PUCcK*_Qq@d{f_Zvi=(vhAA_SY zR@&7)+*CA@eP)CC(#>D#w;_Fic^|Nsgm47eQe~6}RjAfsYN+UXAlCp#J3X0W%MB1N zgkNgFa7Q*1!y;r!(p!;z7(ROO%yi~PMgGB*g9|QAvsek@y{n9YH5J=PwJ%6f2Vr}( zrs?83u!V^1Cs7|D)vpe+oYh3klzLAn@yp3=Qm7{s@XH~~7jXi$bEg1b(IPN~;u+e1 zt)ALlCcrfS0Sy(F&xKK$n1y3ACFMH{*xBU9w0p$VHaYXzxGD@wloX_=tmIDRtX(m4JA){nUvr9#tY-IY6{`fGD8J|6 z1Xp(m5z5B9G=dTrDY|&}buvaSn@s~%PL&LkP5CA4Hby959=k@d+&CM}@Yo@^5dB!r zL9F{Qle8yP%nw7zB+=89IW&`w)_f*ACmv#-gJkUB%Dts+14G9+_YZR7|4Z!7Fl?N%=Fa7j<=?u= zow95OP+M5;I=lWG(|XPwhw9H*((#>$C8S%Ks(k3UbeKMCGpYr~ZJoMO;EC+3)%-OO zsvSDm`qI&Ey`3_1ykEe0{KJlwJ;o&jAg20oQ6Uoqx0DdKyBl}6h7T#?CwFMOW`FR;K|Is%0+;E;MFBCHC2+#wRPzh9wfXPpO{X^x*z4&%PS0 zk>N-5H$ZiFTLEi6LLZfhRun-o&Ztb=6{BQ=liLGOebwlcL!u?&@**UD2Y?E_>o%yd z4kq5)AJWKP3Hkfv57%uEnss*hAU|D6?(ecwpW8VkFvl>K0 zVLkEBWp@dyf#4GSJO~6uQ9+;~(bgFCH&D)t(!h(m-lGhr=IsVcMes-lvVnXQe~+N_=I zMJ?6`SVPb~-EP4x4I<++S|=^ig;F^n?Z=!OPzS(0kzq6U;_eq*6jyqp?$6(`m{T)G z|CU1eIV~fjOlA*q{7lsYX5v{=|1IgODr~_tJp$5UDNh-ZSqhqFL#ZB35eE{c7HqIl zvJ;N=LQ36%4DVXk?p82$EOi)5z6Y9NjC?ZO+RI32;A=?vN^__po?!VFiC+-Y z&ya}?QnRLEy*l5&smLur#Ja1A{Iin5QxQS7iitasjX| ze?=5u7}@PEf2st$Hl)(O2MM46EV8qXHNW9y(nASkTk^dwyx5yDtGlB6WuyE&Y3p7U zTkiTnl-Wh^98s}_OTXwCcDMZf407FT;N>ZB+BE-H11sepL5i$ivsD^Y1^-Hz=>}Z{ zFg@E)FjOo%3UROy$O`&D0X-Gcs6Ly25OsZNa(akTT){#iS$%#yETjdya*Ki?hDN!3 z80M;cdo5V!pcEhDQHd;HPJ_2ljz+t>GdBzv}FS-FE2kBE^rP(Ym4D2CaZ$6?3` z8t(B-ZV}Du9t}pDep8;{hPEJB-fq449#2I_G#Ib9p6mSf z9#>(kc+)B^Lq_&Oz#C7%cj|VmV_|)z{4s;Fbyzy1W%EvawFTo1;$$FA()=vsg1O?g zA3xf1TE~r^2=0;9VX^q_%9t76GXsH--p_l)&Qo!WW-L_+)q%uDj$=3q#*%zD5+c>s zd1qvuKgq+*O(u+$^{SI+*e!LAkZSLGW11p!q6g|m^nPo)!IFDkB`yumKtF3$8C5F~ z$e;C5Y%q-uo9Z_WW+b!YVk-Qs_N~~aN^hG~AZpO~yC(DpYtcjWx z@w6XXVTZoR)(NE4ne#;AzaCaLEq=3J24$doY2mbS3=)=G-=Y*5b*I8yk9hOn==bg8 z%RBcY!2V_Z%h22|1SE|hJ1Z3bldW+Pvx)T{OBXo?ZivYAPHf|k#5{ZPjKY)|%3piz z!|n@%j^MVP}&g;NLIP+t+Bh0JyDI(CUir_hQ z9e10_ZIq@VY^0SSj4cpcFW`mWM~uy_2U!Hy)h&Yf0LTYVS>m@Q=B^esc`w{o zhQ1{M8-Agpl{}4+1InYv(|2pUXnZe^jM3=&)Xzd7jh5gJhNBcbh*h_gmdc>RsZZ%# zpAeN^P$Cel;l`A=L!6S79#JA7cE7{u>v=!Zcgf=t(6-(_NkCTn&sCDN5#e_U8f!hQ zSt?})-D>w^2?)j+72HlT<-EZ2?cjLc`HLe+K zP`5yImP<0xGR;M^3?<~qSfZ?kwqsv7DfO6ay*e@4W^hC<_BLkR^%oT!K7TZ(41pp` zp?gLRb!Oyu4vn(D4Iw=}7BL~BN>#Ri8lAu&TBVZ%>S4L!^V((HF>4k@O&)VUIpwN# zA25F9#UAJsy6VVk45G-Z+Le=D#4le02i7Cet+ef%B%*W zOCB?)nA58DVfi3*uD3b+z7pwN)9R1Z*zGY?R)^6VX>Bg8Xv~^A^7TRK)=y>PgBbzy zYy3pPEcaIWPw2Jjgd$D4Mjo4bRc5;8Cvx1Gf5aw;#a(gwVo*Bh^>DvvEFa?C$+TU* zVi@G;7{bbfULWhyh^%>B>g-~qUA1{)8)~%R(`FZ7+sEQQ6DkREaRiGPe~vS;!N-y@ zIJsEBbLb75ih8fe2Dw};;|Icpv+f~H*CiJfJ*qY`*XABBg#{naR^rbEx$nxcy5Ywc z&*bAJ-&K7X*RWqes3O4dlG$|`7=Z!QbqW*f+Ew0}M;r6g8M}^3``%FLohRJ8dhgK~ zG-!J0$sU5nv9%-E<=2FA#@s1{pcd(p#jyAg`c$(o>obGX@pl!|I0o$dU+EJ;)YOlR zG@MwfYr{6b#qro=8-dSjhe}Z@>iM|xpubU`b0F!$!2rw@fFRJdD8ABCX!1tN{++;; zwyw)trzCl%ZnqA@O~X48lZf#6?YJAdXCy_h6;cuwG52$maMBeA(8H2IpxPoncLJid z*1}cB|8jR*&9*Xkr)z-*uVF(ml@%H)kxK5XevaM;fs1j~ zp@|MOq7H4)6lg?{nrlxg>>PJ3@X?^x<-jr8it9T_7*sCv*+wlEBw{&AS!Kau7HuI! zRZ`<15mZGg_)8Q*t-EBu#vhgAPGB*#zin4dh?i06^1NBLxyy&;x&eZRKSo<@hK;9ck4 zf3Ja7-lpHdK}Z3tw&g|ckV-tY>BkO(WRdmD6IjsrLn}+d-(N=^AodVcAfRsv0gKiC zZE@o1B{VL@%dLQA^1>CTV;TdHqGRZHVU8P2!EUtpOI zV@Q9|Z!2bE%5@1Lyui~TT_HaT(zNavLB`DVj_Ut|+dfadU=aa#2brD$$A<`r6Paeo zn}<)vfvq{t#DGl64fGIdg<3!72mu^LDIpu5EV!m}gAvk|mxE`52v6>lXeWs(gp1`e|*TLBH6j8K=Aot7DFhfa5@?bQ;cg)}QVqM(`(tc?P{-4@=_ce%ec`BVd zUpH->%mSH2?qHhYM=re@twcrj;x&On1Pipx8VdaL$iVR!-EX9BlAK7_VD7;Ia zt^#k%uw1avYs@!C{Yc9>#{P VILsP`XKsU@AoCv=~&U3l9u6Bs1Vg?G7D&KC2eV zeN6}Hccl$-?Y^Vte;%91p-#9gmCF(_S#B}LYr9GesM-Ccva1N~C#XHhW=Av}Xdn3c`+;6#+cSsZ#; zHpk6`XqRs)2=N~!434K|n`{$j&`3ZlC_?h4D*<-ZpBGcMl zX&M!HJ-SkkZ9wHBTjVmvEObxdOk&cB*zl1K(@Q%FM1w zUnA_)ik3HPqedF1n}%sMVK)2Nd5keg%LecsR@QklY^_4L7ryp+zm5#T54uQu=%PqAT zGyJh-k9v~&@W?DCHOm3%{mIS5(qbd-GdC~hch&bo@6~;S<(82bHK=>=(-}K{Ok(bF zEDn%Z=u^znkpG{Sw2jZLK&<4NMIUE0xur{Apy+tRE>F3BpD2F`(zh;eXey^kcS)lrV@%x3J4lZK$wo9DK^^ch*%cjoSxIK~h+M>~EVl*x#o0?B_)bySB0H zAC4-bcy|S2+eVX~67)G1@KXZnD~2X7e_sW-z)db!@bBO94Z4BLj=gRrnbC8(Me^Q( zDuLN)B*EYCvo0IJw_|os(+S2+Fe#)8=uI+KFEX|!r6>zP;uW)*lnP5!xO*T&%)b9Q zmqy)sym=++=Le-^D<``GIZa zW|;*+2erjvlb&OQPaQ_>zgF6ARp*)#;JvD2i*x9zSQFiOKd;8BT>(HAG&8xybX?~C znW%tt1jg*pH3+BO(xI~8{)v8=28v}O7k>4PAJ(lzJ1D{#hdc<7$32i za)S#DqD1^86+B1w>amdV_0Rv}c3Jh4!({@J2x1Hb<`;k(KK1=iCq4S|z6oo9{8fU} zpIPWjG`uz{geg5Sh7-RdWYwd_>Sd(ep`6qYaSspD@_tx; zQ%Sjk|CxaW-N@I!#96um(q|txdp5iL6EZfc3WV=U^-J(aBp0L};#HUO4H;-Dl`v=l zk2;%aCob}(S^|Pp;QQ3}753Phn-Wi)T`E$qsY=2@!F$wLr%^!|TRAJl-jWdIv zLYhP^o?6vJ9Z4tffz45gzM=d3v`58FFZ&;Oi_Ff!-*{g1iH`iZ?xE`p2igQg7%D9FJsvySagu*BY2g^+tA+ zj|gtC^Q9bLIEPFkM)b=}kv;OXVutu%Rd(d}QQ?yaBCioZ; z-wr1z`1=tY`?-x=n&wB&BBC(oZ(14egvTlFFsrM%E z>@{TT>BvQD)HwKkU8Vd{L%7a)K$WwPdZz+^^|yKE^U%!e)^~x5*CK@Ep_%Va7ampL z*$6@z#t#iW^G4J^te7ksXR=ZzbKDNAQlQhL-o= z&`iP(TJxo^F0c6PO0wdC=0)DoEc+Ie{`9961>~7!b>!tBqsXy%TN~(l+IuO{H;2kk zb8i&O3}>w$1!q+8^V_$%Gg4k+>TeCa!*8dNOe|{e0{Ti+zfVWxULRHr?ufjobEnU| z)pkj)B|7}5(p1iTB^aGMvubc*TuVXHnyT2p%UPZ(vf#0AO19ZxCp?*?$hWZ4Eay(Q z*s>oz&@Ra*PJp?o*YzTPX`=wxAVoUIN6yhHeqXh9PV{s$@RWKjJqbSHO=xkh6=Y(Z zJ0@;n40-hz)W5Fieap0Oq)Av=P6#cS5Onr@Jr>-0e70Dwc}vO|E9@oAly@y#wC*!` z5%M0NLtfuI7R*rC}NW9^_KpUP9OUi ze>lhM#cC5}cAAVEILvRU^$>KN(84=o&DdR^bXn0o0jd7FFESmc7@Q~8MmkGtZj>PS z2xu(5XhAZ=7H<&~{V5@!3&1Mi@9NT}fN0{FSDMbYMu{mP#(GXv|d zhA-i9q9eBQ7;<;BQ0q;g5IHrjT!w#}4P)b22y?VTKd-OqDxzw*2UGr#g$A)|x-H#6 zCSFAANri^qaeFw~fSo#o2QwMLSGqyJ7EKFTe%XcQbuRh=&E~`vX{lPNK98)--tsU$ z?@_DTsAb)Mz_`o5!ZiAubpGdQ5aIt$(Jb?lGFJ+|z+@jReZ=R>bKCN0d8#*w$*smt zJdDGriD(X_e>K5?a8FxC4$S{UqW;bsrS>rHNFzOY;P>x zN5FwjPL#<0l2*j+qlp*=Wxk+(bzNy05d3~AVn=z0RQ>^Afy0Da0@}E1k;UA&ZAQgK z&T7NaW1qmXDq3Y5v+Be|3SB(8lcA;A>Mec2o8C?~zxloljY7Y>Ah7bHm4(7I<%)~dD^#UVI8x#LHo9VqsI=uVQ#)ral2x)Czi>;Av`5) z+$@ueqUIZzJi6^Pdc=8$hu-mL>hA8GY#yFf%_no#3}^bJty*fzFVxQOxN zy|p@%yuxo&*E4bvv>ZmqYk@{i@HO2aCD{{9Vjp|nYvt=#=QgPNyN>I?hs!qxIV+h8 z)mx2O+tGo+<9jDkI)cX$@SS=5tj}SRLRT#81#)r^J7fF`hd0hp3xqw1aM5n+mS9 zs(a_fffW`zdT1Uk0u>2Rz%c+1_yAORa3p(_BqJv1$W`8KZZLMJ_Hy`jWl(9Z_A<_{ zjF0h%-E~pglY~Z$|1k{eSkq1Oxg(xhgm8OMiJ+l7Q_~Fx9+nn!i=Yy*tzHO5zc?v{&u3QT$DbjOLjkV`zcf0Sbwj_m4xMNG z_`s+xvc{BO+;ElFYg=G#>TjZN&?&r?;SitMRcL&I1>$(D9fS-Y5VE^WE`VF%97oqA z5J{{htw!M;{zh%x>jQN!h_(hRnb+9qP|vVm)6Li7JfX~6Mxn^Id@1j<)T^hrLx>TJ=tY<>{;TL0~z8V#SNX)S) zE?4=)cjl_fmh7O6w-bC~+|{FRg%>Zf<{R?Pptf&laSjD}b8auN)|Tq%oF|>BqvK;< zFTL)p2aIPioB>FhR3RQUwkiCdv-Noy;R{`|U&OFBG< z=V)7zaMG}`q!F~Rn70U95z7_K%&MO04D)b~PA?K}Qs*IK*l4=OwD&=xEa9JkHURGZeEAj&^r7tnc>lZCS-9EwBY^Mw_`q!&0d zvA1-qn*d3oKc$0MVFG)*2;0n%-dJdn)Q$vQ#WCm~88D*${9)50j#rMgLS*id!FAl7 zC&}<+84UNrYDHkr+{X6iIj;$z+@zPoj9KlSuc)LR&obo2Ob=2a&#KaiDID7`7xjcH zZstQ#JpO?EfF=edC0j+nWd4P~WIv8=t-4K^L=s0BWMTdNLg6SNE|v6~e=JeG_EHykr$PLulcWX9{n z>U&d)G;Le4CR5j3e?>{)pkUrqChovhJMl?0^w$txq*b(C#Sfd4&z4*~#>Pjilx@rt z*6@AbD3*2x@)7qSEA?4m^beoI9h-_urcd>r)C&s#5}g}oUkuEhU8s}3Q8OqpmsSCo zi%)_BRO^-K(OV`gGHGYXO0m()*)K>jDWpGSsUy`a{ram62+|l&k_mZoBIQwL+CE8F z7>t^52^!=`KJO^RdJ^>n`&MWvq+DpZPOq?_U=A1m@qa=MI{a$&r}YEAqi=~w8pT0! zJ~im$KBJ=3F%73v9#|<4M!);SqJCUmC}m9_+Xbjm7p3=UWYBBP+Uj>}>s-GQ!+L-_ zST8s2xC!q1r!ZjeIF`5o2$IkRs&T4+L<+f-aH2BjL?PQ zVPtnMR61a;+z-?0aAR4qWXi1!Drge~_cwe|u;FYQzfw;s2`(F+Wdwut20N zz=R;rX4tjSx*wLP%g1b5B$rSG#6my7A_{&-2k#Pi7^arbn>}aH8h$a4h5efpL|4d9 zyX>o%$V*Zu1XkWb)Tc1n0(r7RyZ#($<`c_3Fj?ZiiAY?}=FMK})%e2`qv$iv#}225 zUu-JsOI3%Jr~V(x-ZCnTrimI1?(Xhx0fM^)f(Ca8?hxDw?(S|ug1fuBySux4@(p?N z?(RAJXZLWX8Jd}?u9>Rpp03+>P@F=dixU0YzOBh61}_VXQ%OCx##;~Qvl|v_eC4=C zIc!fxn?hEF@xYjnk~hCwC@igMZqdR5P$?M3gY0e9T1Gsu%et>-_^5N@