Skip to content

Commit

Permalink
Merge pull request #11 from ohdsi-studies/develop
Browse files Browse the repository at this point in the history
added shiny, hot fix for cohort 100 error
  • Loading branch information
rossdwilliams committed Nov 21, 2023
2 parents e1902fe + 57d2a13 commit 2e3236a
Show file tree
Hide file tree
Showing 8 changed files with 195 additions and 9 deletions.
1 change: 1 addition & 0 deletions .Rbuildignore
Expand Up @@ -10,3 +10,4 @@
^LICENSE\.md$
^\.github$
^README\.Rmd$
^rsconnect$
5 changes: 2 additions & 3 deletions .gitignore
Expand Up @@ -2,12 +2,11 @@
.Rhistory
.RData
.Ruserdata

errorReport*
Results/*

.DS_Store
CodeToRunSynthea.R
CodeToRunSnowflake.R
CodeToRunIPCI.R
errorReportSql.txt
errorReportSql.txt
rsconnect
16 changes: 12 additions & 4 deletions DESCRIPTION
@@ -1,6 +1,7 @@
Package: EhdenAlopecia
Title: Analytic software to perform large-scale distributed analysis of patients with Alopecia as part of the EHDEN study-athon
Version: 1.2.0
Version: 1.2.1

Authors@R: person("Ross", "Williams", , "r.williams@derasmusmc.nl", role = c("aut", "cre"))
Description: This package creates the cohorts for this EHDEN Alopecia study study. Based on this cohort diagnostics, incidence and prevalence rates and treatment patterns are analysis are performed.
License: Apache License (>= 2)
Expand All @@ -13,13 +14,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,
Expand Down
12 changes: 12 additions & 0 deletions NAMESPACE
Expand Up @@ -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)
12 changes: 11 additions & 1 deletion R/globals.R
Expand Up @@ -13,4 +13,14 @@ utils::globalVariables(c('sessionInfo',
'cohortSubjects',
'cohortId',
'cohortName',
'cohortId'))
'cohortId',
'age',
'cdmSourceName',
'indexYear',
'sex',
'targetCohort',
'reactive',
'renderUI',
'tabPanel',
'tagList',
'tabsetPanel'))
142 changes: 142 additions & 0 deletions 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)
}
2 changes: 1 addition & 1 deletion R/runStudy.R
Expand Up @@ -70,7 +70,7 @@ runStudy <- function(connectionDetails,
targetCohorts <- readr::read_csv(file.path(outputFolder, "cohortsGenerated.csv")) %>%
filter(cohortId <= 100)
eventCohorts <- readr::read_csv(file.path(outputFolder, "cohortsGenerated.csv")) %>%
filter(between(cohortId, 100, 114))
filter(between(cohortId, 101, 114))
for (i in seq(1:length(targetCohorts$cohortId))) {
outputSubDir <- file.path(outputFolder, 'treatmentPatterns', targetCohorts[i,]$cohortId)
if (!dir.exists(outputSubDir)) {
Expand Down
14 changes: 14 additions & 0 deletions man/runShinyAlopecia.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

0 comments on commit 2e3236a

Please sign in to comment.