v0.7.1

darwin-eu · Feb 23, 2024 · 99448b7 · 99448b7
1 parent 26f6697
commit 99448b7
Show file tree

Hide file tree

Showing 14 changed files with 204 additions and 260 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: IncidencePrevalence
 Title: Estimate Incidence and Prevalence using the OMOP Common Data Model
-Version: 0.7.0
+Version: 0.7.1
 Authors@R: c(
     person("Edward", "Burn", email = "[email protected]", 
     role = c("aut", "cre"), 
@@ -25,7 +25,7 @@ Authors@R: c(
 Description: Calculate incidence and prevalence using data mapped to the Observational Medical Outcomes Partnership (OMOP) common data model. Incidence and prevalence can be estimated for the total population in a database or for a stratification cohort.
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1
 Depends: 
     R (>= 4.0)
 Imports: 

diff --git a/NAMESPACE b/NAMESPACE
@@ -10,9 +10,11 @@ S3method(prevalenceSet,PrevalenceResult)
 S3method(settings,IncidenceResult)
 S3method(settings,PrevalenceResult)
 export("%>%")
+export(attrition)
 export(benchmarkIncidencePrevalence)
 export(bindIncidenceEstimates)
 export(bindPrevalenceEstimates)
+export(cohortCount)
 export(estimateIncidence)
 export(estimatePeriodPrevalence)
 export(estimatePointPrevalence)
@@ -27,8 +29,10 @@ export(plotIncidence)
 export(plotPrevalence)
 export(prevalenceAttrition)
 export(prevalenceSet)
+export(settings)
 importFrom(magrittr,"%>%")
 importFrom(omopgenerics,attrition)
+importFrom(omopgenerics,cohortCount)
 importFrom(omopgenerics,settings)
 importFrom(rlang,":=")
 importFrom(rlang,.data)

diff --git a/R/estimateIncidence.R b/R/estimateIncidence.R
@@ -365,65 +365,22 @@ estimateIncidence <- function(cdm,
 
   # person_table summary
   if (returnParticipants == TRUE) {
-    participantTables <- unname(purrr::as_vector(irsList[stringr::str_detect(
-      names(irsList),
-      "study_population"
-    )]))
-    # combine to a single participants
-    # from 1st analysis
-    participants <- dplyr::tbl(
-      attr(attr(cdm, "cdm_source"), "dbcon"),
-      CDMConnector::inSchema(
-        attr(attr(cdm, "cdm_source"), "write_schema"),
-        participantTables[[1]]
-      )
-    )
-
-
-    if (length(participantTables) >= 2) {
-      # join additional analyses
-      participantTables <- participantTables[2:length(participantTables)]
-      for (i in seq_along(participantTables)) {
-        participants <- participants %>%
-          dplyr::full_join(
-            dplyr::tbl(
-              attr(attr(cdm, "cdm_source"), "dbcon"),
-              CDMConnector::inSchema(
-                attr(attr(cdm, "cdm_source"), "write_schema"),
-                participantTables[[i]]
-              )
-            ),
-            by = "subject_id"
-          )
-        cdm <- omopgenerics::insertTable(cdm = cdm,
-                                         name = paste0(tablePrefix, "_p_", i),
-                                         table = participants)
-      }
-    }
+    participantTables <- irsList[grepl("study_population_analyis_", names(irsList))]
 
     # make sure to not overwrite any existing participant table (from
     # previous function calls)
     p <- 1 + length(stringr::str_subset(
       CDMConnector::listTables(attr(attr(cdm, "cdm_source"), "dbcon"),
         schema = attr(attr(cdm, "cdm_source"), "write_Schema")
       ),
-      "inc_participants"
+      "inc_participants_"
     ))
 
-
-    cdm <- omopgenerics::insertTable(cdm = cdm,
-                                     name = paste0("inc_participants", p),
-                                     table = participants)
-    cdm[[paste0("inc_participants", p)]] <- cdm[[paste0("inc_participants", p)]] %>%
-      dplyr::compute(
-        name = paste0("inc_participants", p),
-        temporary = FALSE,
-        overwrite = TRUE
-      )
-    CDMConnector::dropTable(
-      cdm = cdm,
-      name = tidyselect::starts_with(paste0(tablePrefix, "_p_"))
-    )
+    nm <- paste0("inc_participants_", p)
+    cdm[[nm]] <- purrr::reduce(
+      participantTables, dplyr::full_join, by = "subject_id"
+    ) %>%
+      dplyr::compute(name = nm, temporary = FALSE, overwrite = TRUE)
   }
 
   CDMConnector::dropTable(
@@ -456,7 +413,7 @@ estimateIncidence <- function(cdm,
   attr(irs, "attrition") <- attrition
   attr(irs, "settings") <- analysisSettings
   if (returnParticipants == TRUE) {
-    attr(irs, "participants") <- cdm$inc_participants1
+    attr(irs, "participants") <- cdm[[nm]]
   }
   class(irs) <- c("IncidencePrevalenceResult", "IncidenceResult", class(irs))
 

diff --git a/R/estimatePrevalence.R b/R/estimatePrevalence.R
@@ -382,79 +382,29 @@ estimatePrevalence <- function(cdm,
 
   # participants
   if (returnParticipants == TRUE) {
-    participantTables <- unname(purrr::as_vector(prsList[stringr::str_detect(
-      names(prsList),
-      "study_population"
-    )]))
-
-    # combine to a single participants
-    # from 1st analysis
-
-    participants <- dplyr::tbl(
-      attr(attr(cdm, "cdm_source"), "dbcon"),
-      CDMConnector::inSchema(
-        attr(attr(cdm, "cdm_source"), "write_schema"),
-        participantTables[[1]]
-      )
-    )
-
-    if (length(participantTables) >= 2) {
-      # join additional analyses
-      participantTables <- participantTables[2:length(participantTables)]
-      for (i in seq_along(participantTables)) {
-        participants <- participants %>%
-          dplyr::full_join(
-            dplyr::tbl(
-              attr(attr(cdm, "cdm_source"), "dbcon"),
-              CDMConnector::inSchema(
-                attr(attr(cdm, "cdm_source"), "write_schema"),
-                participantTables[[i]]
-              )
-            ),
-            by = "subject_id"
-          )
-
-        cdm <- omopgenerics::insertTable(cdm = cdm,
-                                         name = paste0(tablePrefix,"_p_", i),
-                                         table = participants)
-      }
-    }
+    participantTables <- prsList[grepl("study_population_analyis_", names(prsList))]
 
     # make sure to not overwrite any existing participant table (from
     # previous function calls)
     p <- 1 + length(stringr::str_subset(
       CDMConnector::listTables(attr(attr(cdm, "cdm_source"), "dbcon"),
-        schema = attr(attr(cdm, "cdm_source"), "write_schema")
+                               schema = attr(attr(cdm, "cdm_source"), "write_Schema")
       ),
-      paste0(type, "_prev_participants")
+      paste0(type, "_prev_participants_")
     ))
 
-    cdm <- omopgenerics::insertTable(cdm = cdm,
-                                     name = paste0(type, "_prev_participants", p),
-                                     table = participants)
-    cdm[[paste0(type, "_prev_participants", p)]] <- cdm[[paste0(type, "_prev_participants", p)]] %>%
-      dplyr::compute(
-        name = paste0(type, "_prev_participants", p),
-        temporary = FALSE,
-        overwrite = TRUE
-      )
-
-    CDMConnector::dropTable(
-      cdm = cdm,
-      name = tidyselect::starts_with(paste0(
-        tablePrefix,
-        "_analysis_"
-      ))
-    )
-    CDMConnector::dropTable(
-      cdm = cdm,
-      name = tidyselect::starts_with(paste0(
-        tablePrefix,
-        "_p_"
-      ))
-    )
+    nm <- paste0(type, "_prev_participants_", p)
+    cdm[[nm]] <- purrr::reduce(
+      participantTables, dplyr::full_join, by = "subject_id"
+    ) %>%
+      dplyr::compute(name = nm, temporary = FALSE, overwrite = TRUE)
   }
 
+  CDMConnector::dropTable(
+    cdm = cdm,
+    name = tidyselect::starts_with(paste0(tablePrefix, "_analysis_"))
+  )
+
   # prevalence estimates
   prs <- prsList[names(prsList) == "pr"]
   prs <- dplyr::bind_rows(prs,
@@ -515,23 +465,19 @@ estimatePrevalence <- function(cdm,
   attr(prs, "settings") <- analysisSettings
   attr(prs, "attrition") <- attrition
   if (returnParticipants == TRUE) {
-    attr(prs, "participants") <- cdm[[paste0(type, "_prev_participants", p)]]
+    attr(prs, "participants") <- cdm[[nm]]
   }
 
   class(prs) <- c("IncidencePrevalenceResult", "PrevalenceResult", class(prs))
 
-
   dur <- abs(as.numeric(Sys.time() - startCollect, units = "secs"))
   message(glue::glue(
     "Time taken: {floor(dur/60)} mins and {dur %% 60 %/% 1} secs"
   ))
 
-
   return(prs)
 }
 
-
-
 binomialCiWilson <- function(x, n) {
   alpha <- 0.05
   p <- x / n

diff --git a/R/getIncidence.R b/R/getIncidence.R
@@ -369,20 +369,12 @@ getIncidence <- function(cdm,
         ) := "outcome_start_date"
       ) %>%
       dplyr::compute(
-        name = paste0(
-          tablePrefix,
-          "_analysis_",
-          analysisId
-        ),
+        name = paste0(tablePrefix, "_analysis_", analysisId),
         temporary = FALSE,
         overwrite = TRUE
       )
     # keep a record of the table name
-    results[["person_table"]] <- paste0(
-      tablePrefix,
-      "_analysis_",
-      analysisId
-    )
+    results[["person_table"]] <- studyPopDb
   }
 
   return(results)