tests/testthat/test-a11y_plots.R

In a11yShiny: Accessibility Enhancements to Popular R Shiny Functions

# ===========================================================================
# Tests for a11y_ggplot2_line and a11y_ggplot2_bar
# ===========================================================================

# --- a11y_ggplot2_line: basic -----------------------------------------------

test_that("a11y_ggplot2_line returns a ggplot object", {
  df <- data.frame(year = 2020:2024, value = c(10, 14, 13, 17, 20))
  p <- a11y_ggplot2_line(data = df, x = year, y = value)
  expect_s3_class(p, "ggplot")
})

test_that("a11y_ggplot2_line returns a ggplot with grouped data", {
  df <- data.frame(
    year  = rep(2020:2024, 2),
    value = c(10, 14, 13, 17, 20, 8, 9, 11, 12, 15),
    grp   = rep(c("A", "B"), each = 5)
  )
  p <- a11y_ggplot2_line(data = df, x = year, y = value, group = grp)
  expect_s3_class(p, "ggplot")
})

# --- a11y_ggplot2_line: accessible color palette ----------------------------

test_that("a11y_ggplot2_line uses default color palette without warning", {
  df <- data.frame(year = 2020:2024, value = c(10, 14, 13, 17, 20))
  expect_no_warning(
    p <- a11y_ggplot2_line(data = df, x = year, y = value)
  )
})

test_that("a11y_ggplot2_line warns when custom accessible_colors provided", {
  df <- data.frame(year = 2020:2024, value = c(10, 14, 13, 17, 20))
  expect_warning(
    a11y_ggplot2_line(
      data = df, x = year, y = value,
      accessible_colors = c("#FF0000", "#00FF00")
    ),
    "overriding the accessible_colors"
  )
})

# --- a11y_ggplot2_line: marker shapes ---------------------------------------

test_that("a11y_ggplot2_line uses default marker shapes", {
  df <- data.frame(year = 2020:2024, value = c(10, 14, 13, 17, 20))
  p <- a11y_ggplot2_line(data = df, x = year, y = value)
  # Check that geom_point is included (has point layer)
  layer_classes <- vapply(p$layers, function(l) class(l$geom)[1], character(1))
  expect_true("GeomPoint" %in% layer_classes)
})

test_that("a11y_ggplot2_line includes geom_line layer", {
  df <- data.frame(year = 2020:2024, value = c(10, 14, 13, 17, 20))
  p <- a11y_ggplot2_line(data = df, x = year, y = value)
  layer_classes <- vapply(p$layers, function(l) class(l$geom)[1], character(1))
  expect_true("GeomLine" %in% layer_classes)
})

# --- a11y_ggplot2_line: labs passthrough ------------------------------------

test_that("a11y_ggplot2_line passes labs arguments", {
  df <- data.frame(year = 2020:2024, value = c(10, 14, 13, 17, 20))
  p <- a11y_ggplot2_line(data = df, x = year, y = value, title = "My Title")
  expect_equal(p$labels$title, "My Title")
})

# --- a11y_ggplot2_line: custom parameters -----------------------------------

test_that("a11y_ggplot2_line accepts custom line_width and marker_size", {
  df <- data.frame(year = 2020:2024, value = c(10, 14, 13, 17, 20))
  expect_no_error(
    a11y_ggplot2_line(
      data = df, x = year, y = value,
      line_width = 2, marker_size = 4
    )
  )
})

test_that("a11y_ggplot2_line accepts legend_title", {
  df <- data.frame(
    year  = rep(2020:2024, 2),
    value = c(10, 14, 13, 17, 20, 8, 9, 11, 12, 15),
    grp   = rep(c("A", "B"), each = 5)
  )
  p <- a11y_ggplot2_line(
    data = df, x = year, y = value, group = grp,
    legend_title = "Category"
  )
  expect_s3_class(p, "ggplot")
})

# ===========================================================================
# a11y_ggplot2_bar
# ===========================================================================

# --- a11y_ggplot2_bar: basic ------------------------------------------------

test_that("a11y_ggplot2_bar returns a ggplot object", {
  df <- data.frame(
    category = c("Alpha", "Beta", "Gamma"),
    count = c(23, 17, 31)
  )
  p <- a11y_ggplot2_bar(data = df, x = category, y = count)
  expect_s3_class(p, "ggplot")
})

# --- a11y_ggplot2_bar: accessible color palette -----------------------------

test_that("a11y_ggplot2_bar uses default color palette without warning", {
  df <- data.frame(
    category = c("Alpha", "Beta"),
    count = c(10, 20)
  )
  expect_no_warning(
    p <- a11y_ggplot2_bar(data = df, x = category, y = count)
  )
})

test_that("a11y_ggplot2_bar warns when custom accessible_colors provided", {
  df <- data.frame(
    category = c("Alpha", "Beta"),
    count = c(10, 20)
  )
  expect_warning(
    a11y_ggplot2_bar(
      data = df, x = category, y = count,
      accessible_colors = c("#FF0000", "#00FF00")
    ),
    "overriding the accessible_colors"
  )
})

# --- a11y_ggplot2_bar: bar layer --------------------------------------------

test_that("a11y_ggplot2_bar includes GeomBar layer", {
  df <- data.frame(
    category = c("Alpha", "Beta"),
    count = c(10, 20)
  )
  p <- a11y_ggplot2_bar(data = df, x = category, y = count)
  layer_classes <- vapply(p$layers, function(l) class(l$geom)[1], character(1))
  # geom_bar with stat="identity" uses GeomBar (or GeomCol)
  expect_true(any(grepl("Geom(Bar|Col)", layer_classes)))
})

# --- a11y_ggplot2_bar: labs passthrough -------------------------------------

test_that("a11y_ggplot2_bar passes labs arguments", {
  df <- data.frame(
    category = c("Alpha", "Beta"),
    count = c(10, 20)
  )
  p <- a11y_ggplot2_bar(data = df, x = category, y = count, title = "My Bar Chart")
  expect_equal(p$labels$title, "My Bar Chart")
})

# --- a11y_ggplot2_bar: custom parameters ------------------------------------

test_that("a11y_ggplot2_bar accepts custom bar_width", {
  df <- data.frame(
    category = c("Alpha", "Beta"),
    count = c(10, 20)
  )
  expect_no_error(
    a11y_ggplot2_bar(data = df, x = category, y = count, bar_width = 0.5)
  )
})

test_that("a11y_ggplot2_bar accepts custom border_color", {
  df <- data.frame(
    category = c("Alpha", "Beta"),
    count = c(10, 20)
  )
  expect_no_error(
    a11y_ggplot2_bar(data = df, x = category, y = count, border_color = "#FF0000")
  )
})

test_that("a11y_ggplot2_bar accepts legend_title", {
  df <- data.frame(
    category = c("Alpha", "Beta"),
    count = c(10, 20)
  )
  p <- a11y_ggplot2_bar(
    data = df, x = category, y = count,
    legend_title = "Category"
  )
  expect_s3_class(p, "ggplot")
})

# --- a11y_ggplot2_bar: uses minimal theme -----------------------------------

test_that("a11y_ggplot2_bar uses theme_minimal", {
  df <- data.frame(
    category = c("Alpha", "Beta"),
    count = c(10, 20)
  )
  p <- a11y_ggplot2_bar(data = df, x = category, y = count)
  # Check that the plot has a theme
  expect_true(!is.null(p$theme))
})