include more helper functions

OHDSI · Oct 29, 2024 · b0c1a62 · b0c1a62
1 parent 3396147
commit b0c1a62
Show file tree

Hide file tree

Showing 2 changed files with 77 additions and 6 deletions.
diff --git a/R/generateSequenceCohortSet.R b/R/generateSequenceCohortSet.R
@@ -104,7 +104,6 @@ generateSequenceCohortSet <- function(cdm,
 
   ### nsr
   nsr_name <- omopgenerics::uniqueId()
-  nsr_summary_name <- paste0(nsr_name, "_nsr_summary")
 
   index_res <- inc_cohort_check(cdm = cdm,
                                 tableName = indexTable,
@@ -128,8 +127,28 @@ generateSequenceCohortSet <- function(cdm,
                    cohort have no events during the cohortDateRange specified.")
   }
 
+  index_nsr_summary <- inc_cohort_summary(cdm = cdm,
+                                          tableName = indexTable,
+                                          cohortId = indexId,
+                                          nsrTableName = nsr_name,
+                                          cohortDateRange = cohortDateRange)
+
+  marker_nsr_summary <- inc_cohort_summary(cdm = cdm,
+                                           tableName = markerTable,
+                                           cohortId = markerId,
+                                           nsrTableName = nsr_name,
+                                           cohortDateRange = cohortDateRange)
+
   nsr_df <- index_nsr_summary |>
-    dplyr::full_join(marker_nsr_summary,
+    dplyr::rename(
+      "index_cohort_definition_id" = "cohort_definition_id",
+      "index_n" = "n"
+    ) |>
+    dplyr::full_join(marker_nsr_summary |>
+                       dplyr::rename(
+                         "marker_cohort_definition_id" = "cohort_definition_id",
+                         "marker_n" = "n"
+                       ),
                      by = "cohort_start_date",
                      relationship = "many-to-many") |>
     dplyr::select(
@@ -146,13 +165,15 @@ generateSequenceCohortSet <- function(cdm,
     dplyr::filter(!is.na(.data$index_cohort_definition_id)) |>
     dplyr::distinct(.data$index_cohort_definition_id) |>
     dplyr::collect() |>
-    dplyr::pull(.data$index_cohort_definition_id)
+    dplyr::arrange(.data$index_cohort_definition_id) |>
+    dplyr::pull("index_cohort_definition_id")
 
   existing_marker_id <- nsr_df |>
     dplyr::filter(!is.na(.data$marker_cohort_definition_id)) |>
     dplyr::distinct(.data$marker_cohort_definition_id) |>
     dplyr::collect() |>
-    dplyr::pull(.data$marker_cohort_definition_id)
+    dplyr::arrange(.data$marker_cohort_definition_id) |>
+    dplyr::pull("marker_cohort_definition_id")
 
   for (i in existing_index_id){
     for (j in existing_marker_id){

diff --git a/R/helpers.R b/R/helpers.R
@@ -64,8 +64,58 @@ preprocessCohort <- function(cdm, cohortName, cohortId, cohortDateRange) {
   return(cohort)
 }
 
-inc_cohort_summary <- function(cdm, tableName, cohortId, nsrTableName, cohortDateRange){
+inc_cohort_check <- function(cdm, tableName, cohortId, nsrTableName, cohortDateRange){
   nsr_cohort <- cdm [[tableName]]
+
+  tbl_name <- paste0(nsrTableName, omopgenerics::uniqueTableName())
+
+  if (any(is.na(cohortDateRange))) {
+    cohortDateRange <- getcohortDateRange(
+      cdm = cdm,
+      cohortDateRange = cohortDateRange
+    )
+  }
+
+  if (!is.null(cohortId)){
+    nsr_cohort <- nsr_cohort |>
+      dplyr::filter(.data$cohort_definition_id %in% .env$cohortId)
+  }
+  cohort_definition_ids <- nsr_cohort |>
+    dplyr::distinct(.data$cohort_definition_id) |>
+    dplyr::collect() |>
+    dplyr::arrange(.data$cohort_definition_id) |>
+    dplyr::pull("cohort_definition_id")
+
+  inc_cohort_ids <- nsr_cohort |>
+    dplyr::group_by(.data$cohort_definition_id, .data$subject_id) |>
+    dplyr::arrange(.data$cohort_start_date) |>
+    dplyr::mutate(row_num = dplyr::row_number()) |>
+    dplyr::filter(.data$row_num == 1) |>
+    dplyr::select(-"row_num") |>
+    dplyr::ungroup() |>
+    dplyr::group_by(.data$cohort_definition_id, .data$cohort_start_date) |>
+    dplyr::summarise(n = dplyr::n()) |>
+    dplyr::ungroup() |>
+    dplyr::filter(
+      .data$cohort_start_date <= !!cohortDateRange[[2]] &
+        .data$cohort_start_date >= !!cohortDateRange[[1]]
+    ) |>
+    dplyr::compute(name = tbl_name, temporary = FALSE) |>
+    dplyr::distinct(.data$cohort_definition_id) |>
+    dplyr::collect() |>
+    dplyr::arrange(.data$cohort_definition_id) |>
+    dplyr::pull("cohort_definition_id")
+
+  diff <- setdiff(inc_cohort_ids, cohort_definition_ids)
+  return(diff)
+}
+
+inc_cohort_summary <- function(cdm, tableName, cohortId, nsrTableName, cohortDateRange){
+
+  nsr_cohort <- cdm[[tableName]]
+
+  tbl_name <- paste0(nsrTableName, omopgenerics::uniqueTableName())
+
   if (!is.null(cohortId)) {
     nsr_cohort <- nsr_cohort |>
       dplyr::filter(.data$cohort_definition_id %in% .env$cohortId)
@@ -84,7 +134,7 @@ inc_cohort_summary <- function(cdm, tableName, cohortId, nsrTableName, cohortDat
       .data$cohort_start_date <= !!cohortDateRange[[2]] &
         .data$cohort_start_date >= !!cohortDateRange[[1]]
     ) |>
-    dplyr::compute(name = nsrTableName, temporary = FALSE)
+    dplyr::compute(name = tbl_name, temporary = FALSE)
   return(nsr_cohort_summary)
 }