inst/abcdmetrics/app.R

In ucsd-dsm/abcd-metrics: ABCD Metrics shiny app

source("www/packages.R", local = TRUE)
source("www/theming.R", local = TRUE)
source("www/data.R", local = TRUE)

# Define UI for application that draws a histogram
ui <- page(
  theme = abcd_theme,
  includeCSS("www/styles.css"),
  
  page_navbar(
    title = "ABCD Metrics",
    id = "tabs",
    position = "fixed-top",
    lang = "en",
    window_title = "ABCD Metrics Dashboard",
    collapsible = TRUE, 
    inverse = FALSE,  # important for CSS!
    header = div(class="not_for_prod alert alert-danger", "NOT FOR PRODUCTION"),
    nav("Coordinating Center Overview", value = "cc_overview",
        p("What would people from the coordinating center want to see?"),
        div(id = "header_landing_tab",
            fluidRow(
              column(3,
                     h4("Sites:"),
                     pickerInput("site_selection", choices = study_sites, selected = study_sites,
                                 multiple = TRUE, options = pickerOptions(actionsBox = TRUE, selectAllText = "All Sites", 
                                                                          selectedTextFormat = "count > 20",
                                                                          countSelectedText = "All ABCD Sites")
                     )
              ),
              column(3,
                     h4("Visits:"),
                     pickerInput("timepoint_selection", 
                                 choices = study_timepoints$what, selected = study_timepoints$what,
                                 multiple = TRUE, options = pickerOptions(actionsBox = TRUE, selectAllText = "All Time Points",
                                                                          selectedTextFormat = glue("count > {nrow(study_timepoints) - 1}"),
                                                                          countSelectedText = "All Time Points")
                     )
              ),
              column(3,
                     h4("Status:"),
                     prettySwitch("aggregation_selection", "Aggregate Status", status = "primary", slim = TRUE),
                     pickerInput("status_selection", 
                                 choices = list(
                                   okay = visit_status |> filter(category == "okay") |> pull(status),
                                   warning = visit_status |> filter(category == "warning") |> pull(status),
                                   ko = visit_status |> filter(category == "ko") |> pull(status)
                                 ),
                                 selected = visit_status |> pull(status),
                                 multiple = TRUE, options = pickerOptions(actionsBox = TRUE, selectAllText = "All Status",
                                                                          selectedTextFormat = glue("count > {nrow(visit_status) - 1}"),
                                                                          countSelectedText = "All Status")
                     )
              ),
              column(3,
                     a(img(src = "ABCD_logo.png", style = "height: 55px; position: relative;")),
                     h4("Welcome to ABCD Metrics Dashboard!")
              )
            )
        ),
        
        # ABCD Overall
        highchartOutput("plot_evolution"),
        hr(),
        selectInput("display_table", "Table Shows:", c("Absolute numbers", "Site %", "Difference _ALL SITES_ %")),
        reactableOutput("table_evolution"),
        br()
    ),
    nav("Site Overview", value = "site_overview",
        p("What would people from a site want to see?"),
    ),
    nav("FAQ", value = "faq",
        includeMarkdown("www/faq.md")
    ),
    nav_spacer(),
    # TODO: REMOVE ON PRODUCTION:
    nav_item(actionButton("start_browser", "Debug w/ browser()"))
  )
)

# Define server logic required to draw a histogram
server <- function(input, output, session) {
  # Source files with code to generate outputs
  file_list <- list.files(path = "www/R/outputs", pattern = "*.R", recursive = TRUE)
  for (file in file_list) source(paste0("www/R/outputs/", file), local = TRUE)$value
  
  
  # TODO: REMOVE ON PRODUCTION:
  observe(browser()) |> bindEvent(input$start_browser)
  
  dta_abcd_visit <- reactive(
    mock_data |> 
      filter(site %in% c("_ALL SITES_", input$site_selection)) |> 
      filter(timepoint %in% input$timepoint_selection) |> 
      filter(status %in% input$status_selection)
  )
}

# Run the application 
shinyApp(ui = ui, server = server)