Merge pull request #100 from OHDSI/internal_shiny

shiny in inst
OHDSI · Nov 14, 2024 · 9c969c1 · 9c969c1
2 parents a06ada1 + 2e84b9a
commit 9c969c1
Show file tree

Hide file tree

Showing 19 changed files with 3,520 additions and 117 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -23,17 +23,25 @@ Suggests:
     gt,
     omock,
     OmopSketch,
-    OmopViewer,
     testthat (>= 3.0.0),
     knitr,
+    visOmopResults,
+    glue,
     RPostgres,
     PatientProfiles,
     ggplot2,
     ggpubr, 
     stringr,
     shiny,
     DiagrammeR,
-    sortable
+    sortable,
+    shinycssloaders,
+    here,
+    DT,
+    bslib,
+    shinyWidgets,
+    plotly,
+    tidyr
 Config/testthat/edition: 3
 RoxygenNote: 7.3.2
 Imports: 
@@ -42,15 +50,12 @@ Imports:
     CohortConstructor,
     cli,
     dplyr,
-    here,
     IncidencePrevalence (>= 0.8.0),
     omopgenerics,
     magrittr,
     purrr,
-    rmarkdown,
     rlang,
-    vctrs,
-    visOmopResults,
-    glue
+    usethis,
+    vctrs
 URL: https://ohdsi.github.io/PhenotypeR/
 VignetteBuilder: knitr
diff --git a/R/shinyDiagnostics.R b/R/shinyDiagnostics.R
@@ -13,6 +13,8 @@
 #'
 #' @inheritParams resultDoc
 #' @inheritParams directoryDoc
+#' @param open If TRUE, the shiny app will be launched in a new session. If
+#' FALSE, the shiny app will be created but not launched.
 #'
 #' @return A shiny app
 #' @export
@@ -50,111 +52,23 @@
 #'   shinyDiagnostics(my_result_cohort_diag, here::here())
 #' }
 shinyDiagnostics <- function(result,
-                             directory){
+                             directory,
+                             open = rlang::is_interactive()){
 
-  rlang::check_installed("OmopViewer")
+  file.copy(from = system.file("shiny",
+                               package = "PhenotypeR"),
+            to = directory,
+            recursive = TRUE,
+            overwrite = TRUE)
 
-  result |>
-    OmopViewer::exportStaticApp(
-      directory = directory,
-      # background = getBackground(result),
-      summary = TRUE,
-      panels = list(
-                   "Database details" = c("Snapshot"= "summarise_omop_snapshot",
-                                          "Observation periods"= "summarise_observation_period"),
-                   "Codelist diagnostics" = c(
-                     "Achilles code use" = "achilles_code_use",
-                     "Cohort code use" = "cohort_code_use",
-                     "Orphan code use" = "orphan_code_use"),
-                   "Cohort diagnostics" = c(
-                     "Cohort characteristics" = "summarise_characteristics",
-                     "Cohort attrition" = "summarise_cohort_attrition",
-                     "Cohort overlap" = "summarise_cohort_overlap",
-                     "Cohort timing" = "summarise_cohort_timing"),
-                   "Matched diagnostics" = c(
-                     "Large scale characteristics" = "summarise_large_scale_characteristics"),
-                   "Population diagnostics" = c(
-                     "Incidence" = "incidence",
-                     "Incidence attrition" = "incidence_attrition",
-                     "Prevalence" = "prevalence",
-                     "Prevalence attrition" = "prevalence_attrition")
-                   )
-    )
-
- # replace md background file
- file.copy(from = system.file("extdata",
-                                  "background.md",
-                                  package = "PhenotypeR"),
-               to = file.path(directory, "shiny",
-                              "background.md"),
-               overwrite = TRUE)
-
-}
-
-getBackground <- function(result) {
-
-  cohorts <- result |>
-    visOmopResults::filterSettings(.data$table_name == "my_cohort") |>
-    dplyr::distinct(.data$group_name, .data$group_level) |>
-    visOmopResults::splitGroup()
-
-  if ("cohort_name" %in% colnames(cohorts)) {
-    cohorts <- c(
-      "title" = "**Cohorts**",
-      "body" = "The diagnostic results cover the following cohorts: {paste0(unique(cohorts$cohort_name), collapse = ', ')}" |> glue::glue()
-    )
-  } else {
-    cohorts <- character()
-  }
-
-  codelists <- result |>
-    visOmopResults::filterSettings(.data$result_type == "cohort_code_use") |>
-    dplyr::distinct(.data$group_name, .data$group_level) |>
-    visOmopResults::splitGroup()
-
-  if ("codelist_name" %in% colnames(codelists)) {
-    codelists <- c(
-      "title" = "**Codelists**",
-      "body" = "Diagnostics have been generated for these codelists: {paste0(unique(codelists$codelist_name), collapse = ', ')}" |> glue::glue()
-    )
-  } else {
-    codelists <- character()
+  omopgenerics::exportSummarisedResult(result,
+                                       fileName = "result.csv",
+                                       path = file.path(directory, "shiny", "data", "raw"))
+  # shiny::shinyAppDir(file.path(directory, "shiny"))
+  if (isTRUE(open)) {
+  usethis::proj_activate(directory)
   }
 
-  databases <- result |>
-    dplyr::filter(!is.na(.data$cdm_name)) |>
-    dplyr::pull("cdm_name") |>
-    unique()
-
-  if (length(databases) > 0) {
-    databases <- c(
-      "title" = "**Databases**",
-      "body" = "The results are based on data from the following databases: {paste0(databases, collapse = ', ')}" |> glue::glue()
-    )
-  } else {
-    databases <- character()
-  }
-
-  resTypes <- settings(result) |>
-    dplyr::filter(!is.na(.data$result_type)) |>
-    dplyr::pull("result_type") |>
-    unique()
-
-  if (length(resTypes) > 0) {
-    resTypes <- c(
-      "title" = "**Results**",
-      "body" = "The following results are available: {paste0(resTypes, collapse = ', ')}" |> glue::glue()
-    )
-  } else {
-    resTypes <- character()
-  }
+  return(invisible())
 
-  c(
-    "header" = "PhenotypeR Diagnostics",
-    cohorts,
-    codelists,
-    databases,
-    resTypes,
-    "footer" = "This Shiny App presents results generated using the [PhenotypeR](https://ohdsi.github.io/PhenotypeR/) package (version {as.character(utils::packageVersion('PhenotypeR'))})." |> glue::glue()
-  )
 }
diff --git a/inst/extdata/background.md b/inst/extdata/background.md
diff --git a/inst/shiny/background.md b/inst/shiny/background.md
@@ -0,0 +1,19 @@
+This shiny app presents the results from PhenotypeR
+
+The PhenotypeR package helps us to assess the research-readiness of a set of cohorts we have defined. This assessment includes:  
+
+- ___Database diagnostics___ which help us to better understand the database in which they have been created. This includes information about the size of the data, the time period covered, the number of people in the data as a whole. More granular information that may influence analytic decisions, such as the number of observation periods per person, is also described.  
+- ___Codelist diagnostics___ which help to answer questions like what concepts from our codelist are used in the database? What concepts were present led to individuals' entry in the cohort? Are there any concepts being used in the database that we didn't include in our codelist but maybe we should have?  
+- ___Cohort diagnostics___ which help to answer questions like how many individuals did we include in our cohort and how many were excluded because of our inclusion criteria? If we have multiple cohorts, is there overlap between them and when do people enter one cohort relative to another? What is the incidence of cohort entry and what is the prevalence of the cohort in the database?  
+- ___Matched diagnostics___ which compares our study cohorts to the overall population in the database. By matching people in the cohorts to people with a similar age and sex in the database we can see how our cohorts differ from the general database population.  
+- ___Population diagnostics___ which estimates the frequency of our study cohorts in the database in terms of their incidence rates and prevalence..
+
+<div style="display: flex; align-items: center; justify-content: flex-end; gap: 10px;">
+    <a href="https://github.com/OHDSI/PhenotypeR" target="_blank">
+        <img src="phenotyper_logo.png" alt="PhenotypeR Logo" style="width: 100px;">
+    </a>
+    <a href="https://github.com/OHDSI/PhenotypeR" target="_blank">
+        <img src="ohdsi_logo.svg" alt="OHDSI Logo" style="width: 100px;">
+    </a>
+</div>
+
diff --git a/inst/shiny/data/raw/readme.md b/inst/shiny/data/raw/readme.md
diff --git a/inst/shiny/data/readme.md b/inst/shiny/data/readme.md
diff --git a/inst/shiny/functions.R b/inst/shiny/functions.R
@@ -0,0 +1,2 @@
+
+
diff --git a/inst/shiny/global.R b/inst/shiny/global.R
@@ -0,0 +1,52 @@
+library(bslib)
+library(CodelistGenerator)
+library(CohortCharacteristics)
+library(DiagrammeR)
+library(dplyr)
+library(DT)
+library(ggplot2)
+library(gt)
+library(here)
+library(IncidencePrevalence)
+library(OmopSketch)
+library(readr)
+library(shiny)
+library(sortable)
+library(visOmopResults)
+library(shinycssloaders)
+library(shinyWidgets)
+library(plotly)
+library(tidyr)
+
+source(file.path(getwd(),"scripts", "functions.R"))
+
+if(file.exists(file.path(getwd(), "data", "appData.RData"))){
+  load(file.path(getwd(),"data", "appData.RData"))
+} else {
+  source(file.path(getwd(),"scripts", "preprocess.R"))
+}
+
+plotComparedLsc <- function(lsc, cohorts){
+  lsc <- lsc |>  tidy()
+  plot_data <- lsc |>
+    filter(cohort_name %in% c(cohorts
+    )) |>
+    select(cohort_name,
+           variable_name,
+           variable_level,
+           percentage) |>
+    pivot_wider(names_from = cohort_name,
+                       values_from = percentage)
+
+  plot <- plot_data |>
+    ggplot(aes(text = paste("Label:", variable_name,
+                            "<br>Group:", variable_level))) +
+    geom_point(aes(x = !!sym(cohorts[1]),
+                   y = !!sym(cohorts[2]))) +
+    geom_abline(slope = 1, intercept = 0,
+                color = "red", linetype = "dashed") +
+    theme_bw()
+
+  ggplotly(plot)
+
+}