Merge pull request #37 from OHDSI/phenotype_fun

single phenotype fun

DESCRIPTION

@@ -22,6 +22,7 @@ Suggests:
     gt,
     omock,
     OmopSketch,
+    omopViewer,
     testthat (>= 3.0.0),
     knitr,
     RPostgres,
@@ -50,5 +51,5 @@ Imports:
 URL: https://oxford-pharmacoepi.github.io/phenotypeR/
 VignetteBuilder: knitr
 Remotes: 
-    darwin-eu-dev/CohortCharacteristics
-
+    darwin-eu-dev/CohortCharacteristics,
+    oxford-pharmacoepi/omopViewer

NAMESPACE

@@ -1,10 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
 export("%>%")
-export(codelistDiagnostics)
-export(cohortDiagnostics)
-export(cohortToPopulationDiagnostics)
-export(databaseDiagnostics)
+export(phenotype)
 export(reportDiagnostics)
 export(shinyDiagnostics)
 importFrom(magrittr,"%>%")

R/codelistDiagnostics.R

@@ -5,18 +5,7 @@
 #' tables as these will be used for deriving concept counts.
 #'
 #' @return A summarised result
-#' @export
-#'
-#' @examples
-#' \donttest{
-#' library(CohortConstructor)
-#'
-#' cdm <- mockCohortConstructor(conditionOccurrence = TRUE)
-#'
-#' cohort <- conceptCohort(cdm = cdm, conceptSet = list(a = 1), name = "cohort")
-#'
-#' cohort |> attrition()
-#' }
+#' @noRd
 codelistDiagnostics <- function(cohort){
 
   cdm <- omopgenerics::cdmReference(cohort)

R/cohortDiagnostics.R

@@ -9,9 +9,7 @@
 #' large scale characteristics
 #'
 #' @return A summarised result
-#' @export
-#'
-#' @examples
+#' @noRd
 cohortDiagnostics <- function(cohort,
                               strata = list(),
                               matchCohort = TRUE,

R/cohortToPopulationDiagnostics.R

@@ -5,9 +5,7 @@
 #' NULL, no sampling will be performed.
 #'
 #' @return A summarised result
-#' @export
-#'
-#' @examples
+#' @noRd
 cohortToPopulationDiagnostics <- function(cohort,
                                           nSample = 1000){
 

R/databaseDiagnostics.R

@@ -5,9 +5,7 @@
 #' @param cdm CDM reference
 #'
 #' @return
-#' @export
-#'
-#' @examples
+#' @noRd
 databaseDiagnostics <- function(cdm){
 
 OmopSketch::summariseOmopSnapshot(cdm)

R/phenotype.R

@@ -0,0 +1,32 @@
+
+#' Phenotype a cohort
+#'
+#' @param cohort Cohort
+#' @param nSample The number of people to take a random sample for matching to
+#' the database population. If NULL, no sampling will be performed and the
+#' entire cohorts will be used.
+#'
+#' @return A summarised result
+#' @export
+#'
+#' @examples
+phenotype <- function(cohort,
+                      nSample = 1000){
+
+  cdm <- omopgenerics::cdmReference(cohort)
+
+  results <- list()
+
+  results[["db_diag"]] <- databaseDiagnostics(cdm)
+  results[["code_diag"]] <- codelistDiagnostics(cohort)
+  results[["cohort_diag"]] <- cohortDiagnostics(cohort)
+  results[["cohort_to_pop_diag"]] <- cohortToPopulationDiagnostics(cohort,
+                                                                   nSample = nSample)
+
+  results <- results |>
+    vctrs::list_drop_empty() |>
+    omopgenerics::bind()
+
+  results
+
+}

README.Rmd

@@ -60,26 +60,9 @@ cdm$gibleed <- conceptCohort(cdm = cdm,
                                    conceptSet = list(gibleed = 192671L),
                                    name = "gibleed")
 
-gibleed_code_diag <- cdm$gibleed |>
-   codelistDiagnostics()
-gibleed_code_diag |> 
+result <- cdm$gibleed |>
+   phenotype()
+result |> 
   glimpse()
 ```
 
-## Cohort diagnostics
-
-```{r, message=FALSE}
-gibleed_cohort_diag <- cdm$gibleed |>
-   cohortDiagnostics()
-gibleed_cohort_diag |> 
-  glimpse()
-```
-
-
-## Combining results
-```{r, message=FALSE}
-diagnostics <- bind(gibleed_cohort_diag) |> 
-  suppress(minCellCount = 5)
-diagnostics |> 
-  glimpse()
-```

README.md

@@ -46,6 +46,7 @@ library(CDMConnector)
 library(phenotypeR)
 library(CohortConstructor)
 library(dplyr)
+#> Warning: package 'dplyr' was built under R version 4.2.3
 
 con <- DBI::dbConnect(duckdb::duckdb(dbdir = CDMConnector::eunomia_dir()))
 cdm <- CDMConnector::cdm_from_con(con = con,
@@ -56,71 +57,25 @@ cdm$gibleed <- conceptCohort(cdm = cdm,
                                    conceptSet = list(gibleed = 192671L),
                                    name = "gibleed")
 
-gibleed_code_diag <- cdm$gibleed |>
-   codelistDiagnostics()
-gibleed_code_diag |> 
+result <- cdm$gibleed |>
+   phenotype()
+#> Warning: The CDM reference containing the cohort must also contain achilles tables.
+#> Returning only index event breakdown.
+result |> 
   glimpse()
-#> Rows: 4
+#> Rows: 3,017
 #> Columns: 13
-#> $ result_id        <int> 1, 1, 1, 1
+#> $ result_id        <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 3,…
 #> $ cdm_name         <chr> "Synthea synthetic health database", "Synthea synthet…
-#> $ group_name       <chr> "cohort_name &&& codelist_name", "cohort_name &&& cod…
-#> $ group_level      <chr> "gibleed &&& gibleed", "gibleed &&& gibleed", "giblee…
-#> $ strata_name      <chr> "overall", "overall", "overall", "overall"
-#> $ strata_level     <chr> "overall", "overall", "overall", "overall"
-#> $ variable_name    <chr> "overall", "Gastrointestinal hemorrhage", "overall", …
-#> $ variable_level   <chr> NA, "192671", NA, "192671"
-#> $ estimate_name    <chr> "record_count", "record_count", "person_count", "pers…
-#> $ estimate_type    <chr> "integer", "integer", "integer", "integer"
-#> $ estimate_value   <chr> "479", "479", "479", "479"
-#> $ additional_name  <chr> "overall", "source_concept_name &&& source_concept_id…
-#> $ additional_level <chr> "overall", "Gastrointestinal hemorrhage, unspecified …
-```
-
-## Cohort diagnostics
-
-``` r
-gibleed_cohort_diag <- cdm$gibleed |>
-   cohortDiagnostics()
-gibleed_cohort_diag |> 
-  glimpse()
-#> Rows: 1,814
-#> Columns: 13
-#> $ result_id        <int> 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,…
-#> $ cdm_name         <chr> "Synthea synthetic health database", "Synthea synthet…
-#> $ group_name       <chr> "cohort_name", "cohort_name", "cohort_name", "cohort_…
-#> $ group_level      <chr> "gibleed", "gibleed", "gibleed", "gibleed", "gibleed"…
-#> $ strata_name      <chr> "reason", "reason", "reason", "reason", "overall", "o…
-#> $ strata_level     <chr> "Initial qualifying events", "Initial qualifying even…
-#> $ variable_name    <chr> "number_records", "number_subjects", "excluded_record…
-#> $ variable_level   <chr> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, N…
-#> $ estimate_name    <chr> "count", "count", "count", "count", "count", "count",…
-#> $ estimate_type    <chr> "integer", "integer", "integer", "integer", "integer"…
-#> $ estimate_value   <chr> "479", "479", "0", "0", "479", "479", "1944-01-20", "…
-#> $ additional_name  <chr> "reason_id", "reason_id", "reason_id", "reason_id", "…
-#> $ additional_level <chr> "1", "1", "1", "1", "overall", "overall", "overall", …
-```
-
-## Combining results
-
-``` r
-diagnostics <- bind(gibleed_cohort_diag) |> 
-  suppress(minCellCount = 5)
-diagnostics |> 
-  glimpse()
-#> Rows: 1,814
-#> Columns: 13
-#> $ result_id        <int> 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,…
-#> $ cdm_name         <chr> "Synthea synthetic health database", "Synthea synthet…
-#> $ group_name       <chr> "cohort_name", "cohort_name", "cohort_name", "cohort_…
-#> $ group_level      <chr> "gibleed", "gibleed", "gibleed", "gibleed", "gibleed"…
-#> $ strata_name      <chr> "reason", "reason", "reason", "reason", "overall", "o…
-#> $ strata_level     <chr> "Initial qualifying events", "Initial qualifying even…
-#> $ variable_name    <chr> "number_records", "number_subjects", "excluded_record…
+#> $ group_name       <chr> "overall", "overall", "overall", "overall", "overall"…
+#> $ group_level      <chr> "overall", "overall", "overall", "overall", "overall"…
+#> $ strata_name      <chr> "overall", "overall", "overall", "overall", "overall"…
+#> $ strata_level     <chr> "overall", "overall", "overall", "overall", "overall"…
+#> $ variable_name    <chr> "general", "general", "observation_period", "cdm", "g…
 #> $ variable_level   <chr> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, N…
-#> $ estimate_name    <chr> "count", "count", "count", "count", "count", "count",…
-#> $ estimate_type    <chr> "integer", "integer", "integer", "integer", "integer"…
-#> $ estimate_value   <chr> "479", "479", "0", "0", "479", "479", "1944-01-20", "…
-#> $ additional_name  <chr> "reason_id", "reason_id", "reason_id", "reason_id", "…
-#> $ additional_level <chr> "1", "1", "1", "1", "overall", "overall", "overall", …
+#> $ estimate_name    <chr> "snapshot_date", "person_count", "count", "source_nam…
+#> $ estimate_type    <chr> "date", "integer", "integer", "character", "character…
+#> $ estimate_value   <chr> "2024-09-29", "2694", "5343", "Synthea synthetic heal…
+#> $ additional_name  <chr> "overall", "overall", "overall", "overall", "overall"…
+#> $ additional_level <chr> "overall", "overall", "overall", "overall", "overall"…
 ```