inst/doc/a11yShiny.R

In a11yShiny: Accessibility Enhancements to Popular R Shiny Functions

## ----setup, include = FALSE---------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  eval = FALSE
)

## ----install------------------------------------------------------------------
# # Install from source
# devtools::install()

## ----layout-------------------------------------------------------------------
# library(shiny)
# library(a11yShiny)
# 
# ui <- a11y_fluidPage(
#   title = "My Accessible App",
#   lang = "en",
#   header = tags$header(tags$h1("Dashboard")),
#   nav = tags$nav(tags$a(href = "#", "Home")),
#   footer = tags$footer("Footer content"),
# 
#   # Everything passed via ... goes into <main>
#   a11y_fluidRow(
#     a11y_column(6, tags$p("Left column")),
#     a11y_column(6, tags$p("Right column"))
#   )
# )

## ----action-button------------------------------------------------------------
# # Button with visible label
# a11y_actionButton("go", label = "Submit")
# 
# # Icon-only button -- aria_label is required when label is missing
# a11y_actionButton(
#   "search",
#   icon       = icon("search"),
#   aria_label = "Search"
# )

## ----select-input-------------------------------------------------------------
# a11y_selectInput(
#   inputId = "dataset",
#   label = "Choose a dataset",
#   choices = c("iris", "mtcars", "faithful"),
#   describedby_text = "Select one of the built-in R datasets."
# )

## ----numeric-input------------------------------------------------------------
# a11y_numericInput(
#   inputId = "n",
#   label   = "Number of observations",
#   value   = 100,
#   min     = 1,
#   max     = 1000,
#   step    = 10
# )

## ----text-input---------------------------------------------------------------
# a11y_textInput(
#   inputId     = "name",
#   label       = "Your name",
#   placeholder = "e.g. Jane Doe"
# )

## ----radio-buttons------------------------------------------------------------
# a11y_radioButtons(
#   inputId = "color",
#   label   = "Favourite colour",
#   choices = c("Red", "Green", "Blue")
# )

## ----date-input---------------------------------------------------------------
# a11y_dateInput(
#   inputId  = "start",
#   label    = "Start date",
#   value    = Sys.Date(),
#   language = "en"
# )

## ----text-button-group--------------------------------------------------------
# a11y_textButtonGroup(
#   textId             = "query",
#   buttonId           = "run_query",
#   label              = "Search term",
#   placeholder        = "Enter a keyword",
#   button_icon        = icon("search"),
#   button_aria_label  = "Run search",
#   layout             = "inline"
# )

## ----text-inputs-group--------------------------------------------------------
# a11y_textInputsGroup(
#   groupId = "address",
#   legend = "Postal address",
#   inputs = list(
#     list(inputId = "street", label = "Street"),
#     list(inputId = "city", label = "City"),
#     list(inputId = "zip", label = "ZIP code", width = "120px")
#   )
# )

## ----contrast-toggle----------------------------------------------------------
# a11y_highContrastButton(
#   inputId    = "contrast",
#   label      = "High Contrast",
#   aria_label = "Toggle high-contrast mode"
# )

## ----datatable----------------------------------------------------------------
# server <- function(input, output, session) {
#   output$table <- a11y_renderDataTable(
#     expr = iris,
#     lang = "en"
#   )
# }

## ----line-chart---------------------------------------------------------------
# df <- data.frame(
#   year  = rep(2020:2024, 2),
#   value = c(10, 14, 13, 17, 20, 8, 9, 11, 12, 15),
#   group = rep(c("A", "B"), each = 5)
# )
# 
# a11y_ggplot2_line(
#   data  = df,
#   x     = year,
#   y     = value,
#   group = group,
#   title = "Trend by Group",
#   x     = "Year",
#   y     = "Value"
# )

## ----bar-chart----------------------------------------------------------------
# df <- data.frame(
#   category = c("Alpha", "Beta", "Gamma"),
#   count    = c(23, 17, 31)
# )
# 
# a11y_ggplot2_bar(
#   data  = df,
#   x     = category,
#   y     = count,
#   title = "Counts by Category"
# )

## ----run-demo-----------------------------------------------------------------
# shiny::runApp(system.file("examples/demo", package = "a11yShiny"))

## ----demo-layout--------------------------------------------------------------
# ui <- a11y_fluidPage(
#   lang = "de",
#   title = "Demo",
#   header = tags$header(
#     class = "page-header",
#     tags$h1("Demo Dashboard"),
#     tags$h2("A dashboard with a11yShiny components")
#   ),
#   aside = tags$aside(
#     class = "help-panel",
#     tags$h2("Help"),
#     tags$p("Supplementary information goes here.")
#   ),
#   footer = tags$footer(tags$p("Copyright 2025")),
# 
#   # Everything below becomes <main>
#   a11y_fluidRow(
#     a11y_column(8, tags$p("Main content")),
#     a11y_column(4, a11y_highContrastButton())
#   )
# )

## ----demo-select-std----------------------------------------------------------
# # Standard -- no visible label, no ARIA description
# selectInput("n_breaks", label = NULL, choices = c(10, 20, 35, 50))

## ----demo-select-a11y---------------------------------------------------------
# a11y_selectInput(
#   inputId = "n_breaks_1",
#   label = "Number of bins",
#   choices = c(10, 20, 35, 50),
#   selected = 20,
#   heading_level = 3
# )
# 
# a11y_selectInput(
#   inputId          = "n_breaks_2",
#   label            = "Number of bins",
#   choices          = c(10, 20, 35, 50),
#   selected         = 20,
#   describedby_text = "Select the number of histogram bins."
# )

## ----demo-numeric-std---------------------------------------------------------
# numericInput("seed", label = NULL, value = 123)

## ----demo-numeric-a11y--------------------------------------------------------
# # With auto-generated sr-only description
# a11y_numericInput(
#   inputId          = "seed_3",
#   label            = "Seed",
#   value            = 123,
#   heading_level    = 6,
#   describedby_text = "Choose the seed for the random number generator."
# )
# 
# # Linking to an existing help-text element
# a11y_numericInput(
#   inputId = "seed_1",
#   label = "Seed",
#   value = 123,
#   describedby = "seed_help"
# )

## ----demo-date-std------------------------------------------------------------
# dateInput("mydate", "Choose a date:")

## ----demo-date-a11y-----------------------------------------------------------
# a11y_dateInput(
#   "mydate_acc",
#   "Choose a date:",
#   language      = "de",
#   heading_level = 2
# )

## ----demo-search-std----------------------------------------------------------
# div(
#   textInput("searchbox",
#     label = NULL,
#     placeholder = "Enter your query:", width = "100%"
#   ),
#   actionButton("do_search", label = NULL, icon = icon("search"))
# )

## ----demo-search-a11y---------------------------------------------------------
# a11y_textButtonGroup(
#   textId            = "text-acc",
#   buttonId          = "btn-acc",
#   label             = "Enter your query:",
#   button_icon       = icon("search"),
#   button_aria_label = "Search",
#   layout            = "inline"
# )

## ----demo-address-std---------------------------------------------------------
# div(h3("Address"))
# textInput("adr_street", "Street and number")
# textInput("adr_postcode", "ZIP code")
# textInput("adr_city", "City")
# textInput("adr_country", "Country")

## ----demo-address-a11y--------------------------------------------------------
# a11y_textInputsGroup(
#   groupId = "address_group",
#   legend = "Address",
#   inputs = list(
#     list(inputId = "adr_street_acc", label = "Street and number"),
#     list(inputId = "adr_postcode_acc", label = "ZIP code"),
#     list(inputId = "adr_city_acc", label = "City"),
#     list(inputId = "adr_country_acc", label = "Country")
#   ),
#   describedby_text = "Please enter your full postal address.",
#   legend_heading_level = 3
# )

## ----demo-buttons-std---------------------------------------------------------
# # Icon-only button -- no accessible name
# actionButton("refresh", label = NULL, icon = icon("refresh"))
# 
# # Empty button -- no label, no icon, no aria-label
# actionButton("refresh_0", label = NULL)

## ----demo-buttons-a11y--------------------------------------------------------
# # Visible label + icon
# a11y_actionButton("refresh_1",
#   label = "Refresh",
#   icon = icon("refresh")
# )
# 
# # Icon-only with aria_label
# a11y_actionButton("refresh_2",
#   icon = icon("refresh"),
#   aria_label = "Click to refresh"
# )
# 
# # Both visible label and aria_label
# a11y_actionButton("refresh_3",
#   label = "Refresh",
#   aria_label = "Click to refresh data"
# )

## ----demo-chart-std-----------------------------------------------------------
# # Standard -- insufficient contrast, no shape distinction
# ggplot(df, aes(x = time, y = value, color = group)) +
#   geom_line() +
#   geom_point() +
#   scale_color_manual(
#     values = c("A" = "#A8A8A8", "B" = "#FEF843", "C" = "#6E787F")
#   ) +
#   theme_minimal()

## ----demo-chart-a11y----------------------------------------------------------
# p <- a11y_ggplot2_line(
#   data = df,
#   x = time,
#   y = value,
#   group = group,
#   legend_title = "Group",
#   title = "Simulated time series by group"
# )
# 
# # The result is a regular ggplot2 object -- add layers as usual
# p <- p +
#   ggplot2::geom_hline(yintercept = 0, linetype = "dashed") +
#   ggplot2::labs(x = "Date", y = "Measurement")

## ----demo-table-std-----------------------------------------------------------
# output$tbl <- DT::renderDataTable({
#   DT::datatable(
#     head(iris[, 1:4], 10),
#     filter = "top", selection = "none",
#     options = list(
#       pageLength = 5,
#       dom = "Bfrtip",
#       buttons = c("excel", "copy", "csv", "pdf", "print")
#     )
#   )
# })

## ----demo-table-a11y----------------------------------------------------------
# output$tbl_acc <- a11y_renderDataTable(
#   expr = head(iris[, 1:4], 10),
#   lang = "de",
#   selection = "none",
#   extensions = c("Buttons"),
#   options = list(
#     pageLength = 5,
#     dom        = "Bfrtip",
#     buttons    = c("excel", "csv")
#   )
# )

## ----demo-table-ui------------------------------------------------------------
# div(class = "a11y-dt", dataTableOutput("tbl_acc"))