## ----include = FALSE---------------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>", warning = FALSE, message = FALSE, out.width = "95%", # figures occupy ~95% of document width out.height = "auto", dpi = 320, # ensure figure quality fig.width = 6, # default aspect ratio (can be overridden per-figure) fig.height = 3 ) options(rmarkdown.html_vignette.check_title = FALSE) ## ----------------------------------------------------------------------------- library(shiny) library(bslib) library(sortable) library(shinyWidgets) library(gt) library(DT) library(reactable) library(plotly) library(dplyr) library(visOmopResults) library(IncidencePrevalence) library(CohortCharacteristics) library(shinycssloaders) # Mock results in visOmopResults data <- visOmopResults::data # Remove global options (just in case we have them from previous work) setGlobalPlotOptions(style = NULL, type = NULL) setGlobalTableOptions(style = NULL, type = NULL) ## ----eval=FALSE--------------------------------------------------------------- # ui <- bslib::page_navbar( # title = "visOmopResults for Shiny", # window_title = "visOmopResults • Shiny", # collapsible = TRUE, # # Baseline Characteristics (GT table) # bslib::nav_panel( # title = "Baseline Characteristics", # icon = icon("users-gear"), # bslib::layout_sidebar( # sidebar = bslib::sidebar( # title = "Filters", # shinyWidgets::pickerInput( # inputId = "summarise_characteristics_sex", # label = "Sex", # choices = c("overall", "Male", "Female"), # selected = "overall", # multiple = TRUE # ), # width = 320, # position = "left", # open = TRUE # ), # bslib::card( # full_screen = TRUE, # bslib::card_header("Table layout"), # bslib::layout_sidebar( # sidebar = bslib::sidebar( # title = "Arrange columns", # sortable::bucket_list( # header = NULL, # group_name = "col-buckets", # orientation = "horizontal", # add_rank_list( # text = "None", # labels = c("variable_name", "variable_level", "estimate_name"), # input_id = "summarise_characteristics_table_none" # ), # add_rank_list( # text = "Header", # labels = c("sex"), # input_id = "summarise_characteristics_table_header" # ), # add_rank_list( # text = "Group columns", # labels = c("cdm_name", "cohort_name"), # input_id = "summarise_characteristics_table_group_column" # ), # add_rank_list( # text = "Hide", # labels = "table_name", # input_id = "summarise_characteristics_table_hide" # ) # ), # position = "right", # width = 400, # open = FALSE # ), # # GT output # gt::gt_output("summarise_characteristics_table") |> # shinycssloaders::withSpinner(type = 4) # ) # ) # ) # ), # # Large Scale Characterisation (DT / reactable) # bslib::nav_panel( # title = "Large Scale Characterisation", # icon = icon("table"), # bslib::layout_sidebar( # sidebar = bslib::sidebar( # # title = "Display options", # shinyWidgets::pickerInput( # inputId = "large_scale_sex", # label = "Sex", # choices = c("overall", "Male", "Female"), # selected = "overall", # multiple = TRUE # ), # radioButtons( # "large_engine", # "Renderer", # choices = c("DT", "reactable"), # inline = TRUE # ), # sortable::bucket_list( # header = NULL, # group_name = "col-buckets", # orientation = "horizontal", # add_rank_list( # text = "None", # labels = c("variable_name", "variable_level", "estimate_name"), # input_id = "large_scale_none" # ), # add_rank_list( # text = "Group columns", # labels = c("cdm_name", "cohort_name"), # input_id = "large_scale_group_column" # ), # add_rank_list( # text = "Hide", # labels = character(), # input_id = "large_scale_hide" # ) # ), # width = 320 # ), # bslib::card( # full_screen = TRUE, # bslib::card_header("Cohort characteristics (large-scale)"), # conditionalPanel( # "input.large_engine == 'DT'", # DTOutput("large_dt") |> shinycssloaders::withSpinner(type = 4) # ), # conditionalPanel( # "input.large_engine == 'reactable'", # reactableOutput("large_reactable") |> shinycssloaders::withSpinner(type = 4) # ) # ) # ) # ), # # Incidence (ggplot → plotly) # bslib::nav_panel( # title = "Incidence", # icon = icon("chart-line"), # bslib::layout_sidebar( # sidebar = bslib::sidebar( # title = "Plot options", # shinyWidgets::pickerInput( # "incidence_sex", # "Sex strata", # choices = c("overall", "Male", "Female"), # selected = "overall", # multiple = TRUE # ), # shinyWidgets::pickerInput( # inputId = "facet", # label = "Facet", # selected = "sex", # multiple = TRUE, # choices = c("cdm_name", "incidence_start_date", "sex", "outcome_cohort_name"), # ), # shinyWidgets::pickerInput( # inputId = "colour", # label = "Colour", # selected = "outcome_cohort_name", # multiple = TRUE, # choices = c("cdm_name", "incidence_start_date", "sex", "outcome_cohort_name") # ), # checkboxInput("inc_ribbon", "Show ribbon (CI)", TRUE), # checkboxInput("interactive", "Interactive Plot", TRUE), # width = 320 # ), # bslib::card( # full_screen = TRUE, # bslib::card_header("Incidence over time"), # uiOutput("incidence_plot", height = "520px") |> shinycssloaders::withSpinner(type = 4) # ) # ) # ) # ) ## ----------------------------------------------------------------------------- data$large_scale_characteristics ## ----eval=FALSE--------------------------------------------------------------- # server <- function(input, output, session) { # # Baseline (GT) # output$summarise_characteristics_table <- gt::render_gt({ # data$summarised_characteristics |> # # filter results by sex # filterStrata(sex %in% input$summarise_characteristics_sex) |> # # create GT table # CohortCharacteristics::tableCharacteristics( # header = input$summarise_characteristics_table_header, # groupColumn = input$summarise_characteristics_table_group_column, # hide = input$summarise_characteristics_table_hide, # type = "gt" # ) # }) # # # Large scale characteristics # getLargeScaleResults <- reactive({ # data$large_scale_characteristics |> # filter(.data$sex %in% input$large_scale_sex) # }) # # To render as DT # output$large_dt <- renderDT({ # getLargeScaleResults() |> # visTable( # hide = input$large_scale_hide, # groupColumn = input$large_scale_group_column, # type = "datatable", # style = list( # filter = "top", # searchHighlight = TRUE, # rownames = FALSE # ) # ) # }) # # To render as reactable # output$large_reactable <- reactable::renderReactable({ # getLargeScaleResults() |> # visTable( # hide = input$large_scale_hide, # groupColumn = input$large_scale_group_column, # type = "reactable", # style = "default" # ) # }) # # # Incidence # getIncidencePlot <- reactive({ # data$incidence |> # filterStrata(sex %in% input$incidence_sex) |> # plotIncidence( # colour = input$colour, # facet = input$facet, # ribbon = input$inc_ribbon # ) + # theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1)) # }) # output$incidence_plot <- renderUI({ # plt <- getIncidencePlot() # if (input$interactive) { # ggplotly(plt) # } else { # renderPlot(plt) # } # }) # } ## ----eval=FALSE--------------------------------------------------------------- # shinyApp(ui, server)