Develop

.Rbuildignore

@@ -10,3 +10,4 @@
 ^LICENSE\.md$
 ^\.github$
 ^README\.Rmd$
+^rsconnect$

.gitignore

@@ -2,12 +2,11 @@
 .Rhistory
 .RData
 .Ruserdata
-
 errorReport*
 Results/*
-
 .DS_Store
 CodeToRunSynthea.R
 CodeToRunSnowflake.R
 CodeToRunIPCI.R
-errorReportSql.txt
+errorReportSql.txt
+rsconnect

DESCRIPTION

@@ -13,13 +13,20 @@ Imports:
     dplyr,
     magrittr,
     readr,
-    TreatmentPatterns (>= 2.6.0),
+    TreatmentPatterns (>= 2.5.2),
     CohortDiagnostics,
     CirceR,
-    CohortGenerator
+    CohortGenerator,
+    shiny,
+    shinythemes,
+    shinydashboard,
+    shinycssloaders,
+    shinyWidgets,
+    here,
+    DT,
+    stringr
 Suggests: 
     testthat (>= 3.0.0),
-    here,
     rmarkdown,
     checkmate,
     SqlRender,

NAMESPACE

@@ -2,17 +2,29 @@
 
 export("%>%")
 export(createCohorts)
+export(runShinyAlopecia)
 export(runStudy)
 export(runTreatmentPatterns)
 import(TreatmentPatterns)
 import(dplyr)
+import(here)
+import(shinyWidgets)
+import(shinycssloaders)
+import(shinydashboard)
+import(shinythemes)
 importFrom(CirceR,buildCohortQuery)
 importFrom(CirceR,cohortExpressionFromJson)
 importFrom(CohortDiagnostics,executeDiagnostics)
 importFrom(CohortGenerator,createCohortTables)
 importFrom(CohortGenerator,generateCohortSet)
 importFrom(CohortGenerator,getCohortCounts)
 importFrom(CohortGenerator,getCohortTableNames)
+importFrom(DT,dataTableOutput)
+importFrom(DT,renderDataTable)
 importFrom(magrittr,"%>%")
 importFrom(readr,read_csv)
 importFrom(readr,write_csv)
+importFrom(shiny,h4)
+importFrom(shiny,shinyApp)
+importFrom(shiny,uiOutput)
+importFrom(stringr,str_detect)

R/globals.R

@@ -13,4 +13,14 @@ utils::globalVariables(c('sessionInfo',
                          'cohortSubjects',
                          'cohortId',
                          'cohortName',
-                         'cohortId'))
+                         'cohortId',
+                         'age',
+                         'cdmSourceName',
+                         'indexYear',
+                         'sex',
+                         'targetCohort',
+                         'reactive',
+                         'renderUI',
+                         'tabPanel',
+                         'tagList',
+                         'tabsetPanel'))

R/runShinyAlopecia.R

@@ -0,0 +1,142 @@
+#' `runAlopeciaShiny()` launches an app to visualise TreatmentPatterns results for the alopecia study.
+#' 
+#' @param resultsFolder Define the results folder path in character.
+#' 
+#' @import shinythemes shinydashboard shinycssloaders shinyWidgets TreatmentPatterns here
+#' @importFrom readr read_csv
+#' @importFrom DT dataTableOutput renderDataTable
+#' @importFrom stringr str_detect
+#' @importFrom shiny shinyApp h4 uiOutput
+#' @export
+runShinyAlopecia <- function(resultsFolder = here::here("results")) {
+  ui <- dashboardPage(
+    dashboardHeader(title = "Menu"),
+    dashboardSidebar(
+      sidebarMenu(
+        menuItem(
+          text = "Home",
+          tabName = "home"
+        ),
+        menuItem(
+          text = "TreatmentPathways",
+          tabName = "data"
+          )
+        )
+      ),
+    dashboardBody(
+      tabItems(
+        tabItem(
+          tabName = "home",
+          h4("Analytic software to perform large-scale distributed analysis of patients with Alopecia as part of the EHDEN study-athon.")
+        ),
+        tabItem(
+          tabName = "data",
+          uiOutput("dataTable")
+        )
+      )
+    )
+  )
+
+  server <- function(input, output, session) {
+    ## TreatmentPatterns ----
+    resultsPathways <- reactive({
+      databases <- list.files(resultsFolder, full.names = TRUE)
+      resultsPathways <- list()
+      for (i in seq(1:length(databases))) {
+        # i <- 1
+        targetCohorts <- list.files(databases[i], full.names = TRUE)
+        targetCohortNumber <- list.files(databases[i])
+        for (v in seq(1:length(targetCohorts))) {
+          # v <- 1
+          pathwaysFiles <- list.files(targetCohorts[v], full.names = TRUE)
+          file_metaData <- pathwaysFiles[stringr::str_detect(pathwaysFiles, "metadata")]
+          cdm_name <- readr::read_csv(file_metaData, show_col_types = FALSE) %>%
+            pull(cdmSourceName)
+          file_TreatmentPathways <- pathwaysFiles[stringr::str_detect(pathwaysFiles, "treatmentPathways")]
+          resultsPathways <- bind_rows(resultsPathways, readr::read_csv(file_TreatmentPathways, show_col_types = FALSE) %>%
+            mutate(cdm_name = cdm_name,
+                   targetCohort = targetCohortNumber[v]))
+        }
+      }
+      return(resultsPathways)
+    })
+
+    output$dataTable <- renderUI({
+      tagList(
+        pickerInput(
+          inputId = "dataDatabase",
+          label = "Data partner",
+          choices = unique(resultsPathways()$cdm_name),
+          selected = unique(resultsPathways()$cdm_name)[1],
+          multiple = FALSE
+        ),
+        pickerInput(
+          inputId = "dataTargetCohort",
+          label = "Target Cohort",
+          choices = unique(resultsPathways()$targetCohort),
+          selected = unique(resultsPathways()$targetCohort)[1],
+          multiple = FALSE
+        ),
+        pickerInput(
+          inputId = "dataSex",
+          label = "Sex",
+          choices = unique(resultsPathways()$sex),
+          selected = unique(resultsPathways()$sex)[1],
+          multiple = FALSE
+        ),
+        pickerInput(
+          inputId = "dataAge",
+          label = "Age",
+          choices = unique(resultsPathways()$age),
+          selected = unique(resultsPathways()$age)[1],
+          multiple = FALSE
+        ),
+        pickerInput(
+          inputId = "dataIndex",
+          label = "Index year",
+          choices = unique(resultsPathways()$indexYear),
+          selected = unique(resultsPathways()$indexYear)[1],
+          multiple = FALSE
+        ),
+        tabsetPanel(
+          type = "tabs",
+          tabPanel(
+            "Data",
+            DT::dataTableOutput(outputId = "treatmentPathways")
+          ),
+          tabPanel(
+            "Sunburst Plot",
+            uiOutput(outputId = "sunburstPlot")
+          )
+          # ,
+          # tabPanel(
+          #   "Sankey Diagram",
+          #   uiOutput(outputId = "sankeyDiagram")
+          # )
+        )
+      )
+    })
+
+    pathwaysData <- reactive({
+      resultsPathways() %>%
+        filter(cdm_name == input$dataDatabase,
+               targetCohort == input$dataTargetCohort,
+               sex == input$dataSex,
+               age == input$dataAge,
+               indexYear == input$dataIndex)
+    })
+
+    output$treatmentPathways <- DT::renderDataTable(pathwaysData())
+
+    output$sunburstPlot <- renderUI({
+      TreatmentPatterns::createSunburstPlot2(treatmentPathways = pathwaysData(),
+                                             groupCombinations = TRUE)
+    })
+
+    # output$sankeyDiagram <- renderUI({
+    #   TreatmentPatterns::createSankeyDiagram2(treatmentPathways = pathwaysData(),
+    #                                           groupCombinations = TRUE)
+    # })
+  }
+  shinyApp(ui, server)
+}