a04_shiny_apps.R
In visOmopResults: Graphs and Tables for OMOP Results

## ----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)