Skip to content

Commit 7f3b66d

Browse files
catalamarticatalamarti
authored
Merge pull request #31 from oxford-pharmacoepi/addendum
Addendum
2 parents 68db00a + a5a08fc commit 7f3b66d

File tree

7 files changed

+172
-25
lines changed

7 files changed

+172
-25
lines changed

‎CharacterisationCode/Addendum.R

+90
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,90 @@
1+
start_time <- Sys.time()
2+
outputFolder <- here::here("Results")
3+
4+
logfile <- file.path( paste0(outputFolder,
5+
"/log_addendum", dbName, "_", format(Sys.time(), "%d_%m_%Y_%H_%M_%S"),".txt"
6+
))
7+
8+
log_message <- function(message) {
9+
cat(paste(Sys.time(), "-", message, "\n"), file = logfile, append = TRUE)
10+
cli::cli_inform(paste(Sys.time(), "-", message, "\n"))
11+
}
12+
13+
log_message("Start time recorded")
14+
15+
16+
sex <- TRUE
17+
ageGroup <- list(c(0,19), c(20, 39),c(40, 59), c(60, 79), c(80, Inf))
18+
ageGroup <- omopgenerics::validateAgeGroupArgument(ageGroup, ageGroupName = "")[[1]]
19+
dateRange <- as.Date(c("2012-01-01", NA))
20+
21+
log_message("Getting population characteristics")
22+
23+
24+
cdm <- omopgenerics::bind(
25+
CohortConstructor::demographicsCohort(cdm, "population_1", sex = "Both"),
26+
CohortConstructor::demographicsCohort(cdm, "population_2", sex = "Both", ageRange = ageGroup),
27+
name = "population"
28+
)
29+
30+
omopgenerics::dropSourceTable(cdm = cdm, dplyr::starts_with("population_1"))
31+
omopgenerics::dropSourceTable(cdm = cdm, dplyr::starts_with("population_2"))
32+
33+
34+
set <- omopgenerics::settings(cdm$population) |>
35+
dplyr::mutate(cohort_name = tolower(dplyr::if_else(
36+
is.na(.data$age_range), "general_population", paste0("age_group_", .data$age_range)
37+
))) |>
38+
dplyr::select("cohort_definition_id", "cohort_name")
39+
40+
result_populationCharacteristics <- cdm$population |>
41+
omopgenerics::newCohortTable(cohortSetRef = set, .softValidation = TRUE) |>
42+
CohortConstructor::trimToDateRange(dateRange = dateRange) |>
43+
PatientProfiles::addSexQuery() |>
44+
CohortCharacteristics::summariseCharacteristics(
45+
strata = list("sex"),
46+
estimates = list(
47+
date = c("min", "q25", "median", "q75", "max"),
48+
numeric = c("min", "q25", "median", "q75", "max", "mean", "sd", "density"),
49+
categorical = c("count", "percentage"),
50+
binary = c("count", "percentage")
51+
)
52+
)
53+
54+
log_message("Summarising in observation records and person-days")
55+
56+
result_inObservation <- OmopSketch::summariseInObservation(cdm$observation_period,
57+
output = c("records","person-days"),
58+
interval = "years",
59+
sex = sex,
60+
ageGroup = ageGroup,
61+
dateRange = dateRange)
62+
log_message("Summarising missing data - person table")
63+
64+
result_missingDataPerson <- OmopSketch::summariseMissingData(cdm,
65+
omopTableName = "person")
66+
67+
result <- omopgenerics::bind(result_populationCharacteristics, result_inObservation, result_missingDataPerson)
68+
omopgenerics::exportSummarisedResult(result, minCellCount = minCellCount, path = outputFolder, fileName = "result_addendum_{cdm_name}.csv")
69+
70+
71+
72+
# Calculate duration and log
73+
dur <- abs(as.numeric(Sys.time() - start_time, units = "secs"))
74+
log_message(paste("Study code finished. Code ran in", floor(dur / 60), "min and", dur %% 60 %/% 1, "sec"))
75+
76+
# Close connection
77+
CDMConnector::cdmDisconnect(cdm)
78+
log_message("Database connection closed")
79+
80+
# Zip the results
81+
log_message("Zipping results")
82+
83+
files_to_zip <- list.files(outputFolder)
84+
files_to_zip <- files_to_zip[stringr::str_detect(files_to_zip, "addendum")]
85+
86+
zip::zip(zipfile = file.path(paste0(
87+
outputFolder, "/results_addendum_", dbName, ".zip"
88+
)),
89+
files = files_to_zip,
90+
root = outputFolder)

‎CharacterisationCode/CodeToRun.R

+16-2
Original file line numberDiff line numberDiff line change
@@ -13,9 +13,23 @@ prefix <- "..."
1313
cdm <- CDMConnector::cdmFromCon(con = con,
1414
cdmSchema = cdmSchema,
1515
writeSchema = c(schema = writeSchema,
16-
prefix = prefix))
16+
prefix = prefix),
17+
cdmName = dbName)
1718

1819
minCellCount = 5
1920

2021

21-
source("RunCharacterisation.R")
22+
# set Addendum = FALSE if you want to run the all characterisation,
23+
# set Addendum = TRUE if you want to run only the addendum
24+
Addendum <- ...
25+
26+
27+
if (!Addendum){
28+
29+
source("RunCharacterisation.R")
30+
31+
} else {
32+
33+
source("Addendum.R")
34+
35+
}

‎CharacterisationCode/RunCharacterisation.R

+38-6
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,7 @@ log_message <- function(message) {
1111
cli::cli_inform(paste(Sys.time(), "-", message, "\n"))
1212
}
1313

14-
log_message("Start time recorded. Code version: 1.0.4")
14+
log_message("Start time recorded. Code version: 1.0.7")
1515

1616
tableName <- c("observation_period", "visit_occurrence", "condition_occurrence", "drug_exposure", "procedure_occurrence",
1717
"device_exposure", "measurement" , "observation", "death")
@@ -26,10 +26,35 @@ snapshot <- OmopSketch::summariseOmopSnapshot(cdm)
2626

2727
# Population Characteristics
2828
log_message("Getting population characteristics")
29-
result_populationCharacteristics <- CohortConstructor::demographicsCohort(cdm, "population", ageRange = ageGroup, sex = "Both" ) |>
30-
PatientProfiles::addDemographicsQuery(sex = TRUE, age = FALSE, ageGroup = ageGroup) |>
31-
CohortConstructor::requireInDateRange(dateRange = dateRange)|>
32-
CohortCharacteristics::summariseCharacteristics(strata = list("sex", "age_group") )
29+
30+
cdm <- omopgenerics::bind(
31+
CohortConstructor::demographicsCohort(cdm, "population_1", sex = "Both"),
32+
CohortConstructor::demographicsCohort(cdm, "population_2", sex = "Both", ageRange = ageGroup),
33+
name = "population"
34+
)
35+
36+
37+
set <- omopgenerics::settings(cdm$population) |>
38+
dplyr::mutate(cohort_name = tolower(dplyr::if_else(
39+
is.na(.data$age_range), "general_population", paste0("age_group_", .data$age_range)
40+
))) |>
41+
dplyr::select("cohort_definition_id", "cohort_name")
42+
43+
result_populationCharacteristics <- cdm$population |>
44+
omopgenerics::newCohortTable(cohortSetRef = set, .softValidation = TRUE) |>
45+
CohortConstructor::trimToDateRange(dateRange = dateRange) |>
46+
PatientProfiles::addSexQuery() |>
47+
CohortCharacteristics::summariseCharacteristics(
48+
strata = list("sex"),
49+
estimates = list(
50+
date = c("min", "q25", "median", "q75", "max"),
51+
numeric = c("min", "q25", "median", "q75", "max", "mean", "sd", "density"),
52+
categorical = c("count", "percentage"),
53+
binary = c("count", "percentage")
54+
)
55+
)
56+
57+
omopgenerics::dropSourceTable(cdm = cdm, c("population_1", "population_2", "population"))
3358

3459
# Summarise missing data
3560
log_message("Summarising missing data")
@@ -39,6 +64,9 @@ result_missingData <- OmopSketch::summariseMissingData(cdm ,
3964
ageGroup = ageGroup,
4065
year = TRUE,
4166
dateRange = dateRange)
67+
68+
69+
4270

4371
# Summarise concept counts
4472
log_message("Summarising concept id counts")
@@ -87,8 +115,12 @@ result_observationPeriod <- OmopSketch::summariseObservationPeriod(cdm$observati
87115
ageGroup = ageGroup,
88116
dateRange = dateRange)
89117

118+
log_message("Summarising missing data - person table")
119+
120+
result_missingDataPerson <- OmopSketch::summariseMissingData(cdm,
121+
omopTableName = "person")
90122
# Combine results and export
91-
result <- omopgenerics::bind(snapshot, result_populationCharacteristics, result_missingData, result_conceptIdCount, result_clinicalRecords, result_recordCounts, result_inObservation, result_observationPeriod)
123+
result <- omopgenerics::bind(snapshot, result_populationCharacteristics, result_missingData, result_conceptIdCount, result_clinicalRecords, result_recordCounts, result_inObservation, result_observationPeriod, result_missingDataPerson)
92124
omopgenerics::exportSummarisedResult(result, minCellCount = minCellCount, path = outputFolder, fileName = paste0(
93125
"result_characterisation_", dbName, ".csv"))
94126

‎CharacterisationCode/renv.lock

+8-4
Original file line numberDiff line numberDiff line change
@@ -102,9 +102,13 @@
102102
},
103103
"OmopSketch": {
104104
"Package": "OmopSketch",
105-
"Version": "0.2.2",
106-
"Source": "Repository",
107-
"Repository": "CRAN",
105+
"Version": "0.2.2.900",
106+
"Source": "GitHub",
107+
"RemoteType": "github",
108+
"RemoteHost": "api.github.com",
109+
"RemoteRepo": "OmopSketch",
110+
"RemoteUsername": "OHDSI",
111+
"RemoteSha": "1ed494d9447aea13489d074f3b586a69736d79b4",
108112
"Requirements": [
109113
"CDMConnector",
110114
"CohortConstructor",
@@ -122,7 +126,7 @@
122126
"tibble",
123127
"tidyr"
124128
],
125-
"Hash": "5d839495075246010f0d3d1be05ea239"
129+
"Hash": "3f7472f989e9bd091cf7e814f2db3881"
126130
},
127131
"PatientProfiles": {
128132
"Package": "PatientProfiles",

‎shiny/data/preprocess.R

+14-9
Original file line numberDiff line numberDiff line change
@@ -1,13 +1,13 @@
11
# shiny is prepared to work with this resultList, please do not change them
22
resultList <- list(
3-
"summarise_omop_snapshot" = c(1L),
4-
"summarise_characteristics" = c(2L),
5-
"summarise_missing_data" = c(3L),
6-
"summarise_concept_id_counts" = c(4L),
7-
"summarise_clinical_records" = c(5L),
8-
"summarise_record_count" = c(6L),
9-
"summarise_in_observation" = c(7L),
10-
"summarise_observation_period" = c(8L)
3+
"summarise_omop_snapshot" ,
4+
"summarise_characteristics",
5+
"summarise_missing_data" ,
6+
"summarise_concept_id_counts",
7+
"summarise_clinical_records" ,
8+
"summarise_record_count" ,
9+
"summarise_in_observation" ,
10+
"summarise_observation_period"
1111
)
1212

1313
source(file.path(getwd(), "functions.R"))
@@ -24,7 +24,12 @@ result <- purrr::map(csv_files, \(x){
2424
omopgenerics::newSummarisedResult()
2525

2626
# result <- omopgenerics::importSummarisedResult(file.path(getwd(), "data"))
27-
27+
resultList <- resultList |>
28+
purrr::map(\(x) {
29+
omopgenerics::settings(result) |>
30+
dplyr::filter(.data$result_type %in% .env$x) |>
31+
dplyr::pull(.data$result_id) }) |>
32+
rlang::set_names(resultList)
2833
data <- prepareResult(result, resultList)
2934
filterValues <- defaultFilterValues(result, resultList)
3035

‎shiny/server.R

+2
Original file line numberDiff line numberDiff line change
@@ -151,6 +151,7 @@ server <- function(input, output, session) {
151151
dplyr::select(!"result_id")|>
152152
dplyr::mutate(estimate_value = suppressWarnings(dplyr::if_else(.data$estimate_value == "-", NA_integer_, as.numeric(.data$estimate_value))))
153153

154+
154155
# columns to eliminate
155156
colsEliminate <- colnames(res)
156157
colsEliminate <- colsEliminate[!colsEliminate %in% c(
@@ -173,6 +174,7 @@ server <- function(input, output, session) {
173174
dplyr::select(!dplyr::any_of(colsEliminate))
174175
})
175176
output$summarise_missing_data_tidy <- DT::renderDT({
177+
176178
DT::datatable(
177179
getTidyDataSummariseMissingData(),
178180
options = list(scrollX = TRUE),

‎shiny/ui.R

+4-4
Original file line numberDiff line numberDiff line change
@@ -201,7 +201,7 @@ ui <- bslib::page_navbar(
201201
),
202202
class = "text-end"
203203
),
204-
204+
205205
# sidebar = bslib::sidebar(
206206
# sortable::bucket_list(
207207
# header = NULL,
@@ -584,7 +584,7 @@ ui <- bslib::page_navbar(
584584
),
585585
class = "text-end"
586586
),
587-
DT::dataTableOutput("summarise_clinical_records_gt_15")
587+
DT::dataTableOutput("summarise_clinical_records_gt_15")
588588

589589
)
590590
)
@@ -742,7 +742,7 @@ ui <- bslib::page_navbar(
742742
# ),
743743
# position = "right"
744744
# ),
745-
DT::dataTableOutput("summarise_record_count_gt_0")
745+
DT::dataTableOutput("summarise_record_count_gt_0")
746746
#)
747747
)
748748
),
@@ -1069,7 +1069,7 @@ ui <- bslib::page_navbar(
10691069
# ),
10701070
# position = "right"
10711071
# ),
1072-
DT::dataTableOutput("summarise_in_observation_gt_0")
1072+
DT::dataTableOutput("summarise_in_observation_gt_0")
10731073
#)
10741074
)
10751075
),

0 commit comments

Comments
 (0)