Merge pull request #2 from oxford-pharmacoepi/refactor

refactor

DESCRIPTION

@@ -15,11 +15,13 @@ Suggests:
     gt,
     omock,
     testthat (>= 3.0.0),
-    knitr
+    knitr,
+    RPostgres
 Config/testthat/edition: 3
 RoxygenNote: 7.3.1
 Imports: 
     CDMConnector,
+    CodelistGenerator,
     CohortCharacteristics,
     CohortConstructor,
     cli,
@@ -30,6 +32,7 @@ Imports:
     PatientProfiles,
     rmarkdown,
     rlang,
+    vctrs,
     visOmopResults
 URL: https://oxford-pharmacoepi.github.io/phenotypeR/
 VignetteBuilder: knitr

NAMESPACE

@@ -1,9 +1,10 @@
 # Generated by roxygen2: do not edit by hand
 
 export("%>%")
-export(phenotypeCohort)
-export(reportPhenotype)
-export(shinyPhenotype)
+export(codelistDiagnostics)
+export(cohortDiagnostics)
+export(reportDiagnostics)
+export(shinyDiagnostics)
 importFrom(magrittr,"%>%")
 importFrom(rlang,.data)
 importFrom(rlang,.env)

R/codelistDiagnostics.R

@@ -0,0 +1,49 @@
+
+#' Run codelist-level diagnostics
+#'
+#' @param cohort Cohort table
+#'
+#' @return A summarised result
+#' @export
+#'
+#' @examples
+codelistDiagnostics <- function(cohort){
+
+  cdm <- omopgenerics::cdmReference(cohort)
+  cohortName <- omopgenerics::tableName(cohort)
+  cohortIds <- omopgenerics::settings(cohort) |>
+    dplyr::select("cohort_definition_id") |>
+    dplyr::pull()
+
+
+  results <- list()
+
+  age_groups = lapply(as.list(1:length(seq(0, 110, 5))),
+                      function(k, x1 = seq(0, 110, 5), x2 = seq(4, 120, 5)) {
+                        c(x1[k], x2[k])})
+
+  cli::cli_bullets(c("*" = "Getting code counts in database"))
+
+  cli::cli_bullets(c("*" = "Getting index event breakdown"))
+  for(i in seq_along(cohortIds)){
+    results[[paste0("index_event_", i)]] <- CodelistGenerator::summariseCohortCodeUse(
+      x = omopgenerics::cohortCodelist(cdm[[cohortName]], cohortIds[[i]]),
+      cdm = cdm,
+      cohortTable = cohortName,
+      cohortId = cohortIds[[i]],
+      timing = "entry",
+      countBy = c("record", "person"),
+      byConcept = TRUE,
+      byYear = FALSE,
+      bySex = FALSE,
+      ageGroup = NULL
+    )
+  }
+
+  cli::cli_bullets(c("*" = "Getting orphan concepts"))
+
+  results <- vctrs::list_drop_empty(results)
+  results <- omopgenerics::bind(results)
+
+  results
+}

R/phenotypeCohort.R → R/cohortDiagnostics.R

@@ -1,30 +1,39 @@
-#' Phenotype a set of cohorts
+
+#' Run cohort-level diagnostics
 #'
 #' @param cohort Cohort table
 #'
 #' @return A summarised result
 #' @export
 #'
 #' @examples
-phenotypeCohort <- function(cohort){
+cohortDiagnostics <- function(cohort){
 
   cdm <- omopgenerics::cdmReference(cohort)
   cohortName <- omopgenerics::tableName(cohort)
+  cohortIds <- omopgenerics::settings(cohort) |>
+    dplyr::select("cohort_definition_id") |>
+    dplyr::pull()
 
   results <- list()
 
   age_groups = lapply(as.list(1:length(seq(0, 110, 5))),
                       function(k, x1 = seq(0, 110, 5), x2 = seq(4, 120, 5)) {
                         c(x1[k], x2[k])})
 
-  cli::cli_bullets(c("*" = "Getting cdm summary"))
-  results[["cdm_summary"]] <- summary(cdm)
+  cli::cli_bullets(c("*" = "Getting cohort counts"))
+  results[["cohort_counts"]] <- cdm[[cohortName]] |>
+    CohortCharacteristics::summariseCohortCount()
+
+  cli::cli_bullets(c("*" = "Getting cohort attrition"))
+  results[["cohort_counts"]] <- cdm[[cohortName]] |>
+    CohortCharacteristics::summariseCohortAttrition()
 
   cli::cli_bullets(c("*" = "Getting cohort summary"))
   results[["cohort_summary"]] <- cdm[[cohortName]] %>%
     dplyr::mutate(days_in_cohort = as.integer(!!CDMConnector::datediff(
       start = "cohort_start_date", end = "cohort_end_date", interval = "day"
-                                                          ))) |>
+    ))) |>
     PatientProfiles::addDemographics() |>
     CohortCharacteristics::summariseCharacteristics(
       strata = c("sex"),
@@ -40,14 +49,14 @@ phenotypeCohort <- function(cohort){
     )
 
   if(length(omopgenerics::settings(cdm[[cohortName]]) |>
-     dplyr::pull("cohort_definition_id")) > 1){
-  cli::cli_bullets(c("*" = "Getting cohort overlap"))
-  results[["cohort_overlap"]] <- CohortCharacteristics::summariseCohortOverlap(
-    cdm[[cohortName]])
-
-  cli::cli_bullets(c("*" = "Getting cohort timing"))
-  results[["cohort_timing"]] <- CohortCharacteristics::summariseCohortTiming(cdm[[cohortName]],
-                        density = TRUE)
+            dplyr::pull("cohort_definition_id")) > 1){
+    cli::cli_bullets(c("*" = "Getting cohort overlap"))
+    results[["cohort_overlap"]] <- CohortCharacteristics::summariseCohortOverlap(
+      cdm[[cohortName]])
+
+    cli::cli_bullets(c("*" = "Getting cohort timing"))
+    results[["cohort_timing"]] <- CohortCharacteristics::summariseCohortTiming(cdm[[cohortName]],
+                                                                               density = TRUE)
   } else {
     cli::cli_bullets(c("*" = "Only one cohort in settings - skipping cohort overlap and timing"))
   }
@@ -77,7 +86,7 @@ phenotypeCohort <- function(cohort){
     minimumFrequency = 0.0005
   )
 
-
+  results <- vctrs::list_drop_empty(results)
   results <- omopgenerics::bind(results)
 
   results

R/reportPhenotype.R → R/reportDiagnostics.R

@@ -8,7 +8,7 @@
 #' @export
 #'
 #' @examples
-reportPhenotype <- function(result,
+reportDiagnostics <- function(result,
                             directory = here::here()){
 
     input <- system.file("rmd", "phenotype_report.Rmd",

R/shinyPhenotype.R → R/shinyDiagnostics.R

@@ -7,6 +7,6 @@
 #' @export
 #'
 #' @examples
-shinyPhenotype <- function(result){
+shinyDiagnostics <- function(result){
 
 }

inst/rmd/phenotype_report.Rmd

@@ -21,11 +21,18 @@ library(gt)
 summary(result)
 ```
 
-
 ```{r}
 omopgenerics::settings(result)
 ```
 
+# Index event breakdown
+```{r}
+if(any("cohort_code_use" == omopgenerics::settings(result) |> 
+   dplyr::pull("result_type")) == TRUE){
+CodelistGenerator::tableCohortCodeUse(result = result)
+}
+```
+
 # Cohort overlap
 
 ```{r}

tests/testthat/test-codelistDiagnostics.R

@@ -0,0 +1,3 @@
+test_that("multiplication works", {
+  expect_equal(2 * 2, 4)
+})

tests/testthat/test-phenotypeCohort.R → tests/testthat/test-cohortDiagnostics.R

@@ -10,7 +10,7 @@ test_that("run with a single cohort", {
   cdm <- CDMConnector::copyCdmTo(con = db, cdm = cdm_local,
                           schema ="main", overwrite = TRUE)
   expect_no_error(result <- cdm$my_cohort |>
-    phenotypeCohort())
+    cohortDiagnostics())
 
   # cohort and timing and overlap should have been skipped
   expect_false(any("cohort_overlap" ==
@@ -31,7 +31,7 @@ test_that("run with multiple cohorts", {
   cdm <- CDMConnector::copyCdmTo(con = db, cdm = cdm_local,
                                  schema ="main", overwrite = TRUE)
   expect_no_error(result <- cdm$my_cohort |>
-                    phenotypeCohort())
+                    cohortDiagnostics())
 
   # cohort and timing and overlap should have been estimated
   expect_true(any("cohort_overlap" ==

tests/testthat/test-dbms.R

@@ -0,0 +1,35 @@
+test_that("postgres test", {
+  skip_on_cran()
+  skip_if(Sys.getenv("CDM5_POSTGRESQL_DBNAME") == "")
+
+  db <- DBI::dbConnect(RPostgres::Postgres(),
+                       dbname = Sys.getenv("CDM5_POSTGRESQL_DBNAME"),
+                       host = Sys.getenv("CDM5_POSTGRESQL_HOST"),
+                       user = Sys.getenv("CDM5_POSTGRESQL_USER"),
+                       password = Sys.getenv("CDM5_POSTGRESQL_PASSWORD"))
+  cdm <- CDMConnector::cdm_from_con(
+    con = db,
+    cdm_schema = Sys.getenv("CDM5_POSTGRESQL_CDM_SCHEMA"),
+    write_schema = c(schema =  Sys.getenv("CDM5_POSTGRESQL_SCRATCH_SCHEMA"),
+                     prefix = "incp_")
+  )
+
+  cdm$gi_bleed <- CohortConstructor::conceptCohort(cdm = cdm,
+                                                  conceptSet = list("gi_bleed" = 192671),
+                                                  name = "gi_bleed")
+  drug_codes <- CodelistGenerator::getDrugIngredientCodes(cdm,
+                                       name = c("diclofenac",
+                                                "acetaminophen"))
+  cdm$drugs <- CohortConstructor::conceptCohort(cdm = cdm,
+                                                   conceptSet = drug_codes,
+                                                   name = "drugs")
+  cdm <- omopgenerics::bind(cdm$gi_bleed, cdm$drugs, name = "my_cohort")
+
+  result_code_diag <- codelistDiagnostics(cdm$my_cohort)
+  result_cohort_diag <- cohortDiagnostics(cdm$my_cohort)
+  expect_no_error(reportDiagnostics(result = result_code_diag))
+  expect_no_error(shinyDiagnostics(result = result_cohort_diag))
+
+  CDMConnector::cdm_disconnect(cdm = cdm)
+
+})

tests/testthat/test-reportPhenotype.R → tests/testthat/test-reportDiagnostics.R

@@ -10,8 +10,8 @@ test_that("basic working example with one cohort", {
   db <- DBI::dbConnect(duckdb::duckdb())
   cdm <- CDMConnector::copyCdmTo(con = db, cdm = cdm_local,
                                  schema ="main", overwrite = TRUE)
-  my_result <- cdm$my_cohort |> phenotypeCohort()
-  expect_no_error(reportPhenotype(result = my_result))
+  my_result <- cdm$my_cohort |> cohortDiagnostics()
+  expect_no_error(reportDiagnostics(result = my_result))
 
 })
 
@@ -28,7 +28,7 @@ test_that("basic working example with two cohorts", {
   db <- DBI::dbConnect(duckdb::duckdb())
   cdm <- CDMConnector::copyCdmTo(con = db, cdm = cdm_local,
                                  schema ="main", overwrite = TRUE)
-  my_result <- cdm$my_cohort |> phenotypeCohort()
-  expect_no_error(reportPhenotype(result = my_result))
+  my_result <- cdm$my_cohort |> cohortDiagnostics()
+  expect_no_error(reportDiagnostics(result = my_result))
 
 })