v0.1.0

.Rbuildignore

@@ -8,3 +8,4 @@
 ^pkgdown$
 ^doc$
 ^Meta$
+^cran-comments\.md$

DESCRIPTION

@@ -8,11 +8,15 @@ Authors@R: c(
     person("Marti", "Catala", , "[email protected]", 
     role = c("aut"), comment = c(ORCID = "0000-0003-3308-9905")),
     person("Xihang", "Chen", , "[email protected]", 
-    role = c("aut"), comment = c(ORCID = "0009-0001-8112-8959")),    
+    role = c("aut"), comment = c(ORCID = "0009-0001-8112-8959")),
+    person("Marta", "Alcalde-Herraiz", , "[email protected]", 
+    role = c("aut"), comment = c(ORCID = "0009-0002-4405-1814")),
     person("Albert", "Prats-Uribe", , "[email protected]", 
     role = "aut", comment = c(ORCID = "0000-0003-1202-9153")))
 Description: Phenotype study cohorts in data mapped to the 
-    Observational Medical Outcomes Partnership Common Data Model.
+    Observational Medical Outcomes Partnership Common Data Model. Diagnostics 
+    are run at the database, codelist, cohort, and population level to assess 
+    whether study cohorts are ready for research.
 License: Apache License (>= 2)
 Encoding: UTF-8
 LazyData: true
@@ -22,7 +26,6 @@ Suggests:
     DBI,
     gt,
     omock,
-    OmopSketch,
     testthat (>= 3.0.0),
     knitr,
     visOmopResults,
@@ -52,10 +55,11 @@ Imports:
     dplyr,
     IncidencePrevalence (>= 0.8.0),
     omopgenerics,
+    OmopSketch,
     magrittr,
     purrr,
     rlang,
-    usethis,
-    vctrs
+    vctrs,
+    usethis
 URL: https://ohdsi.github.io/PhenotypeR/
 VignetteBuilder: knitr

R/codelistDiagnostics.R

@@ -113,11 +113,11 @@ codelistDiagnostics <- function(cohort){
   cli::cli_bullets(c("*" = "Getting code counts in database based on achilles"))
   results[[paste0("achilles_code_use")]] <- CodelistGenerator::summariseAchillesCodeUse(x = all_codelists, cdm = cdm)
 
-  cli::cli_bullets(c("*" = "Getting unmapped concepts"))
-  results[[paste0("unmapped_codes", i)]] <- CodelistGenerator::summariseUnmappedCodes(
-    x = all_codelists,
-    cdm = cdm
-  )
+  # cli::cli_bullets(c("*" = "Getting unmapped concepts"))
+  # results[[paste0("unmapped_codes", i)]] <- CodelistGenerator::summariseUnmappedCodes(
+  #   x = all_codelists,
+  #   cdm = cdm
+  # )
 
   cli::cli_bullets(c("*" = "Getting orphan concepts"))
   results[[paste0("orphan_codes", i)]] <- CodelistGenerator::summariseOrphanCodes(

R/shinyDiagnostics.R

@@ -49,12 +49,17 @@
 #'                                  schema ="main",
 #'                                  overwrite = TRUE)
 #'   my_result_cohort_diag <- cdm$my_cohort |> phenotypeDiagnostics()
-#'   shinyDiagnostics(my_result_cohort_diag, here::here())
+#'   shinyDiagnostics(my_result_cohort_diag, tempdir())
 #' }
 shinyDiagnostics <- function(result,
                              directory,
                              open = rlang::is_interactive()){
 
+  if(file.exists(file.path(directory, "shiny"))){
+  cli::cli_inform(c("i" = "Existing {.strong shiny} folder in {.arg directory} will be overwritten."))
+  unlink(file.path(directory, "shiny"), recursive = TRUE)
+  }
+
   file.copy(from = system.file("shiny",
                                package = "PhenotypeR"),
             to = directory,

README.Rmd

@@ -70,5 +70,5 @@ summary(result)
 
 Once we have our results we can quickly view them in an interactive application. This shiny app will be saved in a new directory and can be further customised.
 ```{r, eval=FALSE}
-shinyDiagnostics(result = result)
+shinyDiagnostics(result = result, directory = tempdir())
 ```

README.md

@@ -71,15 +71,15 @@ result <- cdm$gibleed |>
 
 ``` r
 summary(result)
-#> A summarised_result object with 15951 rows, 49 different result_id, 1 different
+#> A summarised_result object with 18179 rows, 49 different result_id, 1 different
 #> cdm names, and 24 settings.
 #> CDM names: Synthea synthetic health database.
 #> Settings: package_name, package_version, result_type, timing, table_name,
 #> cohort_definition_id, cdm_version, vocabulary_version,
 #> analysis_outcome_washout, analysis_repeated_events, analysis_interval,
 #> analysis_complete_database_intervals, denominator_age_group, denominator_sex,
 #> denominator_days_prior_observation, denominator_start_date,
-#> denominator_end_date, denominator_time_at_risk, …, type, and analysis.
+#> denominator_end_date, denominator_target_cohort_name, …, type, and analysis.
 ```
 
 Once we have our results we can quickly view them in an interactive

cran-comments.md

@@ -0,0 +1,9 @@
+## R CMD check results
+
+0 errors | 0 warnings | 1 note
+
+* This is a re-submission. 
+* A more thorough description is provided.  
+* There are no references to add.
+* Use of getwd() has been removed and functions do not write by default or in examples/vignettes/tests in the user's home filespace.
+

inst/example_cohorts/GIBleed_male.json

@@ -0,0 +1,120 @@
+{
+  "ConceptSets": [
+    {
+      "id": 0,
+      "name": "Gastrointestinal hemorrhage",
+      "expression": {
+        "items": [
+          {
+            "concept": {
+              "CONCEPT_CLASS_ID": "Clinical Finding",
+              "CONCEPT_CODE": "74474003",
+              "CONCEPT_ID": 192671,
+              "CONCEPT_NAME": "Gastrointestinal hemorrhage",
+              "DOMAIN_ID": "Condition",
+              "INVALID_REASON": "V",
+              "INVALID_REASON_CAPTION": "Valid",
+              "STANDARD_CONCEPT": "S",
+              "STANDARD_CONCEPT_CAPTION": "Standard",
+              "VOCABULARY_ID": "SNOMED"
+            },
+            "includeDescendants": true
+          }
+        ]
+      }
+    }
+  ],
+  "PrimaryCriteria": {
+    "CriteriaList": [
+      {
+        "ConditionOccurrence": {
+          "CodesetId": 0
+        }
+      }
+    ],
+    "ObservationWindow": {
+      "PriorDays": 0,
+      "PostDays": 0
+    },
+    "PrimaryCriteriaLimit": {
+      "Type": "All"
+    }
+  },
+  "QualifiedLimit": {
+    "Type": "First"
+  },
+  "ExpressionLimit": {
+    "Type": "First"
+  },
+  "InclusionRules": [
+    {
+      "name": "Male",
+      "expression": {
+        "Type": "ALL",
+        "CriteriaList": [],
+        "DemographicCriteriaList": [
+          {
+            "Gender": [
+              {
+                "CONCEPT_CODE": "M",
+                "CONCEPT_ID": 8507,
+                "CONCEPT_NAME": "MALE",
+                "DOMAIN_ID": "Gender",
+                "INVALID_REASON_CAPTION": "Unknown",
+                "STANDARD_CONCEPT_CAPTION": "Unknown",
+                "VOCABULARY_ID": "Gender"
+              }
+            ]
+          }
+        ],
+        "Groups": []
+      }
+    },
+    {
+      "name": "30 days prior observation",
+      "expression": {
+        "Type": "ALL",
+        "CriteriaList": [
+          {
+            "Criteria": {
+              "ObservationPeriod": {}
+            },
+            "StartWindow": {
+              "Start": {
+                "Coeff": -1
+              },
+              "End": {
+                "Days": 30,
+                "Coeff": -1
+              },
+              "UseEventEnd": false
+            },
+            "EndWindow": {
+              "Start": {
+                "Days": 0,
+                "Coeff": 1
+              },
+              "End": {
+                "Coeff": 1
+              },
+              "UseEventEnd": true
+            },
+            "Occurrence": {
+              "Type": 2,
+              "Count": 1
+            }
+          }
+        ],
+        "DemographicCriteriaList": [],
+        "Groups": []
+      }
+    }
+  ],
+  "CensoringCriteria": [],
+  "CollapseSettings": {
+    "CollapseType": "ERA",
+    "EraPad": 0
+  },
+  "CensorWindow": {},
+  "cdmVersionRange": ">=5.0.0"
+}

inst/example_cohorts/GiBleed_default.json

@@ -0,0 +1,57 @@
+{
+  "ConceptSets": [
+    {
+      "id": 0,
+      "name": "gibleed",
+      "expression": {
+        "items": [
+          {
+            "concept": {
+              "CONCEPT_CLASS_ID": "Clinical Finding",
+              "CONCEPT_CODE": "74474003",
+              "CONCEPT_ID": 192671,
+              "CONCEPT_NAME": "Gastrointestinal hemorrhage",
+              "DOMAIN_ID": "Condition",
+              "INVALID_REASON": "V",
+              "INVALID_REASON_CAPTION": "Valid",
+              "STANDARD_CONCEPT": "S",
+              "STANDARD_CONCEPT_CAPTION": "Standard",
+              "VOCABULARY_ID": "SNOMED"
+            },
+            "includeDescendants": false
+          }
+        ]
+      }
+    }
+  ],
+  "PrimaryCriteria": {
+    "CriteriaList": [
+      {
+        "ConditionOccurrence": {
+          "CodesetId": 0
+        }
+      }
+    ],
+    "ObservationWindow": {
+      "PriorDays": 0,
+      "PostDays": 0
+    },
+    "PrimaryCriteriaLimit": {
+      "Type": "First"
+    }
+  },
+  "QualifiedLimit": {
+    "Type": "First"
+  },
+  "ExpressionLimit": {
+    "Type": "First"
+  },
+  "InclusionRules": [],
+  "CensoringCriteria": [],
+  "CollapseSettings": {
+    "CollapseType": "ERA",
+    "EraPad": 0
+  },
+  "CensorWindow": {},
+  "cdmVersionRange": ">=5.0.0"
+}

inst/shiny/global.R

@@ -19,20 +19,24 @@ library(shinyWidgets)
 library(plotly)
 library(tidyr)
 
-source(file.path(getwd(),"scripts", "functions.R"))
+source(here::here("scripts", "functions.R"))
 
-if(file.exists(file.path(getwd(), "data", "appData.RData"))){
-  load(file.path(getwd(),"data", "appData.RData"))
+if(file.exists(here::here("data", "appData.RData"))){
+  cli::cli_inform("Loading existing processed data")
+  load(here::here("data", "appData.RData"))
+  cli::cli_alert_success("Data loaded")
 } else {
-  source(file.path(getwd(),"scripts", "preprocess.R"))
+  cli::cli_inform("Preprocessing data from data/raw")
+  source(here::here("scripts", "preprocess.R"))
+  cli::cli_alert_success("Data processed")
 }
 
 plotComparedLsc <- function(lsc, cohorts, colour = NULL, facet = NULL){
    lsc <- lsc |>  tidy()
   plot_data <- lsc |>
     filter(cohort_name %in% c(cohorts
     )) |>
-    select(database = cdm_name, 
+    select(database = cdm_name,
            cohort_name,
            variable_name,
            time_window = variable_level,
@@ -42,19 +46,9 @@ plotComparedLsc <- function(lsc, cohorts, colour = NULL, facet = NULL){
     pivot_wider(names_from = cohort_name,
                 values_from = percentage)
 
-  # plot <- visOmopResults::scatterPlot(plot_data, 
-  #                             x = cohorts[1],
-  #                             y = cohorts[2],
-  #                             colour = colour, 
-  #                             facet = facet,
-  #                             line = FALSE,
-  #                             point = TRUE, 
-  #                             ribbon = FALSE) +
-  #   ggplot2::geom_abline(slope = 1, intercept = 0, color = "red", linetype = "dashed") +
-  #   ggplot2::theme_bw() 
-
-  plot <- plot_data |>
-    ggplot(aes(text = paste("Concept:", variable_name,
+    plot <- plot_data |>
+    ggplot(aes(text = paste("<br>Database:", cdm_name,
+                            "<br>Concept:", variable_name,
                             "<br>Concept ID:", concept_id,
                             "<br>Time window:", time_window,
                             "<br>Table:", table,