#157

OHDSI · Oct 21, 2024 · 1e4dbb0 · 1e4dbb0
1 parent 170f497
commit 1e4dbb0
Show file tree

Hide file tree

Showing 3 changed files with 30 additions and 24 deletions.
diff --git a/R/getSummarisedResult.R b/R/getSummarisedResult.R
@@ -1,6 +1,6 @@
 getSummarisedResult <- function(x) {
   settings <- c("days_prior_observation", "washout_window", "index_marker_gap",
-                "combination_window", "confidence_interval")
+                "combination_window", "moving_average_restriction", "confidence_interval")
   x_sum <- x |>
     dplyr::mutate(
       group_name = "index_cohort_name &&& marker_cohort_name",
@@ -56,7 +56,7 @@ getSummarisedResult <- function(x) {
 
   x_sum <- x_sum |>
     dplyr::left_join(setting, by = c("days_prior_observation", "washout_window",
-                     "index_marker_gap", "combination_window", "confidence_interval",
+                     "index_marker_gap", "combination_window", "moving_average_restriction", "confidence_interval",
                      "cdm_name")) |>
     dplyr::select(dplyr::all_of(omopgenerics::resultColumns())) |>
     omopgenerics::newSummarisedResult(

diff --git a/R/summariseSequenceRatios.R b/R/summariseSequenceRatios.R
@@ -44,18 +44,16 @@ summariseSequenceRatios <- function(cohort,
       dplyr::pull("cohort_definition_id")
   }
 
-  temp <- list()
-  temp2<-list()
-  results <- list()
   cohort_tidy <- cohort |>
     dplyr::filter(.data$cohort_definition_id %in% cohortId) |>
     dplyr::left_join(omopgenerics::settings(cohort), copy = T, by = "cohort_definition_id") |>
     dplyr::compute()
 
+  output <- data.frame()
+
   for (i in (cohort_tidy |> dplyr::distinct(.data$index_id) |> dplyr::pull())){
     for (j in (cohort_tidy |> dplyr::filter(.data$index_id == i) |> dplyr::distinct(.data$marker_id) |> dplyr::pull())){
-        temp[[paste0("index_", i, "_marker_", j)]] <-
-        cohort_tidy |>
+      temporary_cohort <- cohort_tidy |>
         dplyr::filter(.data$index_id == i & .data$marker_id == j) |>
         dplyr::left_join(
           cohort_tidy |>
@@ -75,27 +73,29 @@ summariseSequenceRatios <- function(cohort,
             "cohort_start_date", "cohort_end_date"
           ))) |>
         dplyr::collect() |>
-        dplyr::group_by(.data$days_first, .data$index_id, .data$index_name, .data$marker_id, .data$marker_name, .data$days_prior_observation, .data$washout_window, .data$index_marker_gap, .data$combination_window) |>
+        dplyr::group_by(.data$days_first, .data$index_id, .data$index_name, .data$marker_id, .data$marker_name, .data$days_prior_observation, .data$washout_window, .data$index_marker_gap, .data$combination_window, .data$moving_average_restriction) |>
         dplyr::summarise(marker_first = sum(.data$order_ba, na.rm = T), index_first = sum((!.data$order_ba), na.rm = T), .groups = "drop") |>
         dplyr::ungroup()
 
-      temp2[[paste0("index_",i, "_marker_", j)]] <-
-        temp[[paste0("index_",i, "_marker_", j)]] |>
-        dplyr::group_by(.data$index_id, .data$index_name, .data$marker_id, .data$marker_name, .data$days_prior_observation, .data$washout_window, .data$index_marker_gap, .data$combination_window) |>
-        dplyr::summarise(marker_first = sum(.data$marker_first), index_first = sum(.data$index_first), .groups = "drop") |>
-        dplyr::ungroup()
-
-      csr <- crudeSequenceRatio(temp[[paste0("index_",i, "_marker_", j)]])
+      csr <- crudeSequenceRatio(temporary_cohort)
       nsr <- omopgenerics::settings(cohort) |>
         dplyr::filter(.data$index_id == i & .data$marker_id == j) |>
         dplyr::pull("nsr")
-      asr <- adjustedSequenceRatio(temp[[paste0("index_",i, "_marker_", j)]], nsr = nsr)
-      counts <- getConfidenceInterval(temp[[paste0("index_",i, "_marker_", j)]], nsr = nsr, confidenceInterval = confidenceInterval) |>
+      asr <- csr/nsr
+      counts <- getConfidenceInterval(temporary_cohort,
+                                      nsr = nsr,
+                                      confidenceInterval = confidenceInterval) |>
         dplyr::select(-c("index_first", "marker_first"))
 
-      results[[paste0("index_",i, "_marker_", j)]] <- cbind(temp2[[paste0("index_",i, "_marker_", j)]],
-                                                            cbind(tibble::tibble(csr = csr,asr = asr),
-                                                                  counts)) |>
+      meta_info <-
+        temporary_cohort |>
+        dplyr::group_by(.data$index_id, .data$index_name, .data$marker_id, .data$marker_name, .data$days_prior_observation, .data$washout_window, .data$index_marker_gap, .data$combination_window, .data$moving_average_restriction) |>
+        dplyr::summarise(marker_first = sum(.data$marker_first), index_first = sum(.data$index_first), .groups = "drop") |>
+        dplyr::ungroup()
+
+      partial_result <- cbind(meta_info,
+                              cbind(tibble::tibble(csr = csr,asr = asr),
+                                    counts)) |>
         dplyr::mutate(marker_first_percentage = round(.data$marker_first/(.data$marker_first + .data$index_first)*100, digits = 1),
                       index_first_percentage = round(.data$index_first/(.data$marker_first + .data$index_first)*100, digits = 1),
                       confidence_interval = as.character(.env$confidenceInterval)) |>
@@ -104,12 +104,11 @@ summariseSequenceRatios <- function(cohort,
                       "csr", "lower_csr_ci", "upper_csr_ci",
                       "asr", "lower_asr_ci", "upper_asr_ci",
                       "days_prior_observation", "washout_window", "index_marker_gap", "combination_window",
-                      "confidence_interval")
+                      "moving_average_restriction", "confidence_interval")
+      output <- rbind(output, partial_result)
     }
   }
 
-  output <- Reduce(dplyr::union_all, results)
-
   ifp_100 <- output |>
     dplyr::filter(.data$index_first_percentage == 100) |>
     dplyr::tally() |>

diff --git a/README.md b/README.md
@@ -88,12 +88,14 @@ cdm <- generateSequenceCohortSet(
   markerTable = "amoxicillin",
   name = "aspirin_amoxicillin"
 )
+#> ! cohort columns will be reordered to match the expected order:
+#>   cohort_definition_id, subject_id, cohort_start_date, and cohort_end_date.
 
 cdm$aspirin_amoxicillin %>% 
   dplyr::glimpse()
 #> Rows: ??
 #> Columns: 6
-#> Database: DuckDB v1.0.0 [root@Darwin 23.6.0:R 4.4.1//private/var/folders/pl/k11lm9710hlgl02nvzx4z9wr0000gp/T/RtmpW84FVx/filefe981fd421a8.duckdb]
+#> Database: DuckDB v0.10.1 [xihangc@Windows 10 x64:R 4.3.1/C:\Users\xihangc\AppData\Local\Temp\Rtmpq80Ncd\file3ff054e0221b.duckdb]
 #> $ cohort_definition_id <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1…
 #> $ subject_id           <int> 65, 119, 185, 144, 235, 197, 310, 280, 316, 331, …
 #> $ cohort_start_date    <date> 1968-07-29, 1967-05-28, 1947-04-07, 1978-10-30, …
@@ -112,6 +114,11 @@ intervals.
 
 ``` r
 res <- summariseSequenceRatios(cohort = cdm$aspirin_amoxicillin)
+#> Joining with `by = join_by(days_prior_observation, washout_window,
+#> index_marker_gap, combination_window, confidence_interval,
+#> moving_average_restriction, cdm_name)`
+#> ! The following column type were changed: • result_id: from character to
+#> integer
 
 res %>% glimpse()
 #> Rows: 10