From 05d880ca7fc10e668ba7288dc9b2c2e6c442c080 Mon Sep 17 00:00:00 2001 From: Cesar Barboza Date: Tue, 21 Nov 2023 01:05:11 +0100 Subject: [PATCH 1/2] shiny Alopecia only sunburst --- DESCRIPTION | 9 ++- NAMESPACE | 7 ++ R/runShinyAlopecia.R | 137 ++++++++++++++++++++++++++++++++++++++++ man/runShinyAlopecia.Rd | 11 ++++ 4 files changed, 162 insertions(+), 2 deletions(-) create mode 100644 R/runShinyAlopecia.R create mode 100644 man/runShinyAlopecia.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 76e296c..cc1aa54 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -13,10 +13,15 @@ Imports: dplyr, magrittr, readr, - TreatmentPatterns (>= 2.6.0), + TreatmentPatterns (>= 2.5.2), CohortDiagnostics, CirceR, - CohortGenerator + CohortGenerator, + shiny, + shinythemes, + shinydashboard, + shinycssloaders, + shinyWidgets Suggests: testthat (>= 3.0.0), here, diff --git a/NAMESPACE b/NAMESPACE index ce85928..e84681d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,10 +2,17 @@ export("%>%") export(createCohorts) +export(runShinyAlopecia) export(runStudy) export(runTreatmentPatterns) import(TreatmentPatterns) import(dplyr) +import(here) +import(shiny) +import(shinyWidgets) +import(shinycssloaders) +import(shinydashboard) +import(shinythemes) importFrom(CirceR,buildCohortQuery) importFrom(CirceR,cohortExpressionFromJson) importFrom(CohortDiagnostics,executeDiagnostics) diff --git a/R/runShinyAlopecia.R b/R/runShinyAlopecia.R new file mode 100644 index 0000000..717d46d --- /dev/null +++ b/R/runShinyAlopecia.R @@ -0,0 +1,137 @@ +#' `runAlopeciaShiny()` launches an app to visualise TreatmentPatterns results for the alopecia study. +#' +#' @import shiny shinythemes shinydashboard shinycssloaders shinyWidgets TreatmentPatterns here +#' @importFrom readr read_csv +#' @export +runShinyAlopecia <- function() { + 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(here::here("results"), 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) +} \ No newline at end of file diff --git a/man/runShinyAlopecia.Rd b/man/runShinyAlopecia.Rd new file mode 100644 index 0000000..0af2a71 --- /dev/null +++ b/man/runShinyAlopecia.Rd @@ -0,0 +1,11 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/runShiny.R +\name{runShinyAlopecia} +\alias{runShinyAlopecia} +\title{`runAlopeciaShiny()` launches an app to visualise TreatmentPatterns results for the alopecia study.} +\usage{ +runShinyAlopecia() +} +\description{ +`runAlopeciaShiny()` launches an app to visualise TreatmentPatterns results for the alopecia study. +} From a76ce018778a343828ab03ef72c859a119ace94f Mon Sep 17 00:00:00 2001 From: Cesar Barboza Date: Tue, 21 Nov 2023 09:24:18 +0100 Subject: [PATCH 2/2] resultsFolder --- .gitignore | 5 ++--- R/runShinyAlopecia.R | 4 ++-- 2 files changed, 4 insertions(+), 5 deletions(-) diff --git a/.gitignore b/.gitignore index 8f3679d..8ab0b84 100644 --- a/.gitignore +++ b/.gitignore @@ -2,12 +2,11 @@ .Rhistory .RData .Ruserdata - errorReport* Results/* - .DS_Store CodeToRunSynthea.R CodeToRunSnowflake.R CodeToRunIPCI.R -errorReportSql.txt \ No newline at end of file +errorReportSql.txt +rsconnect diff --git a/R/runShinyAlopecia.R b/R/runShinyAlopecia.R index 717d46d..caaf0f8 100644 --- a/R/runShinyAlopecia.R +++ b/R/runShinyAlopecia.R @@ -3,7 +3,7 @@ #' @import shiny shinythemes shinydashboard shinycssloaders shinyWidgets TreatmentPatterns here #' @importFrom readr read_csv #' @export -runShinyAlopecia <- function() { +runShinyAlopecia <- function(resultsFolder = here::here("results")) { ui <- dashboardPage( dashboardHeader(title = "Menu"), dashboardSidebar( @@ -35,7 +35,7 @@ runShinyAlopecia <- function() { server <- function(input, output, session) { ## TreatmentPatterns ---- resultsPathways <- reactive({ - databases <- list.files(here::here("results"), full.names = TRUE) + databases <- list.files(resultsFolder, full.names = TRUE) resultsPathways <- list() for (i in seq(1:length(databases))) { # i <- 1