Subtheme functions

DESCRIPTION

@@ -274,6 +274,7 @@ Collate:
     'theme.R'
     'theme-defaults.R'
     'theme-current.R'
+    'theme-sub.R'
     'utilities-break.R'
     'utilities-grid.R'
     'utilities-help.R'

NAMESPACE

@@ -718,6 +718,17 @@ export(theme_linedraw)
 export(theme_minimal)
 export(theme_replace)
 export(theme_set)
+export(theme_sub_axis)
+export(theme_sub_axis_bottom)
+export(theme_sub_axis_left)
+export(theme_sub_axis_right)
+export(theme_sub_axis_top)
+export(theme_sub_axis_x)
+export(theme_sub_axis_y)
+export(theme_sub_legend)
+export(theme_sub_panel)
+export(theme_sub_plot)
+export(theme_sub_strip)
 export(theme_test)
 export(theme_update)
 export(theme_void)

NEWS.md

@@ -1,5 +1,10 @@
 # ggplot2 (development version)
 
+* New function family for setting parts of a theme. For example, you can now use 
+  `theme_sub_axis(line, text, ticks, ticks.length, line)` as a substitute for
+  `theme(axis.line, axis.text, axis.ticks, axis.ticks.length, axis.line)`. This
+  should allow slightly terser and more organised theme declarations 
+  (@teunbrand, #5301).
 * `geom_boxplot()` gains additional arguments to style the colour, linetype and
   linewidths of the box, whiskers, median line and staples (@teunbrand, #5126)
 * (internal) Using `after_scale()` in the `Geom*$default_aes()` field is now

R/theme-sub.R

@@ -0,0 +1,144 @@
+#' Shortcuts for theme settings
+#'
+#' This collection of functions serves as a shortcut for [`theme()`][theme] with
+#' shorter argument names. Besides the shorter arguments, it also helps in
+#' keeping theme declarations more organised.
+#'
+#' @eval subtheme_param_doc()
+#'
+#' @return A `theme`-class object that can be added to a plot.
+#' @name subtheme
+#'
+#' @examples
+#' # A standard plot
+#' p <- ggplot(mtcars, aes(disp, mpg, colour = drat)) +
+#'   geom_point()
+#'
+#' red_text <- element_text(colour = "red")
+#' red_line <- element_line(colour = "red")
+#'
+#' # The theme settings below:
+#' p + theme(
+#'   axis.title.x.bottom = red_text,
+#'   axis.text.x.bottom  = red_text,
+#'   axis.line.x.bottom  = red_line,
+#'   axis.ticks.x.bottom = red_line
+#' )
+#'
+#' # Are equivalent to these less verbose theme settings
+#' p + theme_sub_axis_bottom(
+#'   title = red_text,
+#'   text  = red_text,
+#'   line  = red_line,
+#'   ticks = red_line
+#' )
+NULL
+
+subtheme <- function(elements, prefix = "", suffix = "", call = caller_env()) {
+  if (length(elements) < 1) {
+    return(theme())
+  }
+  names(elements) <- paste0(prefix, names(elements), suffix)
+
+  extra <- setdiff(names(elements), names(get_element_tree()))
+  if (length(extra) > 0) {
+    cli::cli_warn(
+      "Ignoring unknown {.fn theme} element{?s}: {.and {.field {extra}}}.",
+      call = call
+    )
+    elements <- elements[setdiff(names(elements), extra)]
+  }
+
+  exec(theme, !!!elements)
+}
+
+#' @export
+#' @describeIn subtheme Theme specification for all axes.
+theme_sub_axis <- function(title, text, ticks, ticks.length, line) {
+  subtheme(find_args(), "axis.")
+}
+
+#' @export
+#' @describeIn subtheme Theme specification for both x axes.
+theme_sub_axis_x <- function(title, text, ticks, ticks.length, line) {
+  subtheme(find_args(), "axis.", ".x")
+}
+
+#' @export
+#' @describeIn subtheme Theme specification for both y axes.
+theme_sub_axis_y <- function(title, text, ticks, ticks.length, line) {
+  subtheme(find_args(), "axis.", ".y")
+}
+
+#' @export
+#' @describeIn subtheme Theme specification for the bottom x axis.
+theme_sub_axis_bottom <- function(title, text, ticks, ticks.length, line) {
+  subtheme(find_args(), "axis.", ".x.bottom")
+}
+
+#' @export
+#' @describeIn subtheme Theme specification for the top x axis.
+theme_sub_axis_top <- function(title, text, ticks, ticks.length, line) {
+  subtheme(find_args(), "axis.", ".x.top")
+}
+
+#' @export
+#' @describeIn subtheme Theme specification for the left y axis.
+theme_sub_axis_left <- function(title, text, ticks, ticks.length, line) {
+  subtheme(find_args(), "axis.", ".y.left")
+}
+
+#' @export
+#' @describeIn subtheme Theme specification for the right y axis.
+theme_sub_axis_right <- function(title, text, ticks, ticks.length, line) {
+  subtheme(find_args(), "axis.", ".y.right")
+}
+
+#' @export
+#' @describeIn subtheme Theme specification for the legend.
+theme_sub_legend <- function(background, margin, spacing, spacing.x, spacing.y,
+                             key, key.size, key.height, key.width, text, title,
+                             position, direction, justification, box, box.just,
+                             box.margin, box.background, box.spacing) {
+  subtheme(find_args(), "legend.")
+}
+
+#' @export
+#' @describeIn subtheme Theme specification for the panels.
+theme_sub_panel <- function(background, border, spacing, spacing.x, spacing.y,
+                            grid, grid.major, grid.minor, grid.major.x,
+                            grid.major.y, grid.minor.x, grid.minor.y, ontop) {
+  subtheme(find_args(), "panel.")
+}
+
+#' @export
+#' @describeIn subtheme Theme specification for the whole plot.
+theme_sub_plot <- function(background, title, title.position, subtitle, caption,
+                           caption.position, tag, tag.position, tag.location,
+                           margin) {
+  subtheme(find_args(), "plot.")
+}
+
+#' @export
+#' @describeIn subtheme Theme specification for facet strips.
+theme_sub_strip <- function(background, background.x, background.y, clip,
+                            placement, text, text.x, text.x.bottom, text.x.top,
+                            text.y, text.y.left, text.y.right,
+                            switch.pad.grid, switch.pad.wrap) {
+  subtheme(find_args(), "strip.")
+}
+
+subtheme_param_doc <- function() {
+  funs <- list(
+    theme_sub_axis, theme_sub_axis_x, theme_sub_axis_y, theme_sub_axis_bottom,
+    theme_sub_axis_top, theme_sub_axis_left, theme_sub_axis_right, theme_sub_legend,
+    theme_sub_panel, theme_sub_plot, theme_sub_strip
+  )
+  args <- sort(unique(unlist(lapply(funs, fn_fmls_names), use.names = FALSE)))
+  paste0(
+    "@param ",
+    paste0(args, collapse = ","),
+    " Arguments that are renamed and passed on to ",
+    "\\code{\\link[=theme]{theme()}}."
+  )
+}

_pkgdown.yml

@@ -185,6 +185,7 @@ reference:
   - theme
   - theme_bw
   - theme_update
+  - subtheme
   - element_line
   - margin
 

tests/testthat/_snaps/theme.md

@@ -77,6 +77,10 @@
     `plot.tag.position` must be one of "topleft", "top", "topright", "left", "right", "bottomleft", "bottom", or "bottomright", not "test".
     i Did you mean "left"?
 
+# subtheme functions rename arguments as intended
+
+    Ignoring unknown `theme()` elements: foo and bar.
+
 # Theme validation behaves as expected
 
     The `aspect.ratio` theme element must be a <numeric/integer> object.

tests/testthat/test-theme.R

@@ -510,6 +510,32 @@ test_that("Theme elements are checked during build", {
   expect_snapshot_error(ggplotGrob(p))
 })
 
+test_that("subtheme functions rename arguments as intended", {
+
+  line <- element_line(colour = "red")
+  rect <- element_rect(colour = "red")
+
+  expect_equal(theme_sub_axis(ticks = line),        theme(axis.ticks = line))
+  expect_equal(theme_sub_axis_x(ticks = line),      theme(axis.ticks.x = line))
+  expect_equal(theme_sub_axis_y(ticks = line),      theme(axis.ticks.y = line))
+  expect_equal(theme_sub_axis_top(ticks = line),    theme(axis.ticks.x.top = line))
+  expect_equal(theme_sub_axis_bottom(ticks = line), theme(axis.ticks.x.bottom = line))
+  expect_equal(theme_sub_axis_left(ticks = line),   theme(axis.ticks.y.left = line))
+  expect_equal(theme_sub_axis_right(ticks = line),  theme(axis.ticks.y.right = line))
+  expect_equal(theme_sub_legend(key = rect),        theme(legend.key = rect))
+  expect_equal(theme_sub_panel(border = rect),      theme(panel.border = rect))
+  expect_equal(theme_sub_plot(background = rect),   theme(plot.background = rect))
+  expect_equal(theme_sub_strip(background = rect),  theme(strip.background = rect))
+
+  # Test rejection of unknown theme elements
+  expect_snapshot_warning(
+    expect_equal(
+      subtheme(list(foo = 1, bar = 2, axis.line = line)),
+      theme(axis.line = line)
+    )
+  )
+})
+
 test_that("Theme validation behaves as expected", {
   tree <- get_element_tree()
   expect_silent(validate_element(1,  "aspect.ratio", tree))