theme helper functions

five sets of theme helpers for seven plotting and table packages

Author: gordonwoodhull

DESCRIPTION

@@ -29,9 +29,19 @@ Imports:
     yaml
 Suggests: 
     curl,
+    flextable,
+    ggiraph,
+    ggplot2,
+    gt,
+    heatmaply,
     knitr,
+    palmerpenguins,
+    patchwork,
+    plotly,
     rsconnect (>= 0.8.26),
     testthat (>= 3.1.7),
+    thematic,
+    tidyverse,
     withr,
     xfun
 VignetteBuilder: 

R/theme.R

@@ -0,0 +1,128 @@
+#' Create a theme for a plotting or table package
+#'
+#' Create a theme using background and foreground colors (`theme_colors_*`) or
+#' using a **brand.yml** file (`theme_brand_*`).
+#'
+#' The use of the theme will depend on the package. See the vignettes for
+#' usage examples.
+#'
+#' @param bg The background color
+#' @param fg The foreground color
+#' @param brand_yml The path to a brand.yml file
+
+
+#' @rdname theme_helpers
+#'
+#' @export
+theme_colors_flextable <- function(bg, fg) {
+  (function(x) {
+    if (!inherits(x, "flextable")) {
+      stop("theme_colors_flextable only supports flextable objects.")
+    }
+    x <- flextable::bg(x, bg = bg, part = "all")
+    x <- flextable::color(x, color = fg, part = "all")
+    flextable::autofit(x)
+  })
+}
+
+#' @rdname theme_helpers
+#'
+#' @export
+theme_brand_flextable <- function(brand_yml) {
+  brand <- yaml::yaml.load_file(brand_yml)
+  theme_colors_flextable(brand$color$background, brand$color$foreground)
+}
+
+
+#' @rdname theme_helpers
+#'
+#' @export
+theme_colors_ggplot <- function(bg, fg) {
+  if (!requireNamespace("ggplot2", quietly = TRUE)) {
+    return(NULL)
+  }
+  ggplot2::`%+%`(ggplot2::theme_minimal(base_size = 11),
+    ggplot2::theme(
+      panel.border = ggplot2::element_blank(),
+      panel.grid.major.y = ggplot2::element_blank(),
+      panel.grid.minor.y = ggplot2::element_blank(),
+      panel.grid.major.x = ggplot2::element_blank(),
+      panel.grid.minor.x = ggplot2::element_blank(),
+      text = ggplot2::element_text(colour = fg),
+      axis.text = ggplot2::element_text(colour = fg),
+      rect = ggplot2::element_rect(colour = bg, fill = bg),
+      plot.background = ggplot2::element_rect(fill = bg, colour = NA),
+      axis.line = ggplot2::element_line(colour = fg),
+      axis.ticks = ggplot2::element_line(colour = fg)
+    ))
+}
+
+#' @rdname theme_helpers
+#'
+#' @export
+theme_brand_ggplot <- function(brand_yml) {
+  brand <- yaml::yaml.load_file(brand_yml)
+  theme_colors_ggplot(brand$color$background, brand$color$foreground)
+}
+
+
+#' @rdname theme_helpers
+#'
+#' @export
+theme_colors_gt <- function(bg, fg) {
+  (function(table) {
+    table |>
+      gt::tab_options(
+        table.background.color = bg,
+        table.font.color = fg,
+      )
+  })
+}
+
+#' @rdname theme_helpers
+#'
+#' @export
+theme_brand_gt <- function(brand_yml) {
+  brand <- yaml::yaml.load_file(brand_yml)
+  theme_colors_gt(brand$color$background, brand$color$foreground)
+}
+
+#' @rdname theme_helpers
+#'
+#' @export
+theme_colors_plotly <- function(bg, fg) {
+  (function(plot) {
+    plot |> plotly::layout(paper_bgcolor = bg,
+      plot_bgcolor = bg,
+      font = list(color = fg)
+    )
+  })
+}
+
+#' @rdname theme_helpers
+#'
+#' @export
+theme_brand_plotly <- function(brand_yml) {
+  brand <- yaml::yaml.load_file(brand_yml)
+  theme_colors_plotly(brand$color$background, brand$color$foreground)
+}
+
+
+#' @rdname theme_helpers
+#'
+#' @export
+theme_colors_thematic <- function(bg, fg) {
+  (function() {
+    thematic::thematic_rmd(
+      bg = bg,
+      fg = fg,
+  )})
+}
+
+#' @rdname theme_helpers
+#'
+#' @export
+theme_brand_thematic <- function(brand_yml) {
+  brand <- yaml::yaml.load_file(brand_yml)
+  theme_colors_thematic(brand$color$background, brand$color$foreground)
+}

_pkgdown.yml

@@ -45,3 +45,10 @@ reference:
   - is_using_quarto
   - quarto_binary_sitrep
 
+- title: "Theme Helpers"
+  desc: >
+    These simple helper functions adapt plotting and table packages to use background and
+    foreground colors, or brand.yml colors.
+  contents:
+    - starts_with("theme_colors")
+    - starts_with("theme_brand")

tests/testthat/test-theme.R

@@ -0,0 +1,56 @@
+
+test_that("render flextable", {
+  skip_if_no_quarto()
+  quarto_render("theme/flextable.qmd", quiet = TRUE)
+  expect_true(file.exists("theme/flextable.html"))
+  unlink("theme/flextable.html")
+})
+
+
+test_that("render ggiraph", {
+  skip_if_no_quarto()
+  quarto_render("theme/ggiraph.qmd", quiet = TRUE)
+  expect_true(file.exists("theme/ggiraph.html"))
+  unlink("theme/ggiraph.html")
+})
+
+
+test_that("render ggplot", {
+  skip_if_no_quarto()
+  quarto_render("theme/ggplot.qmd", quiet = TRUE)
+  expect_true(file.exists("theme/ggplot.html"))
+  unlink("theme/ggplot.html")
+})
+
+
+test_that("render gt", {
+  skip_if_no_quarto()
+  quarto_render("theme/gt.qmd", quiet = TRUE)
+  expect_true(file.exists("theme/gt.html"))
+  unlink("theme/gt.html")
+})
+
+
+test_that("render heatmaply", {
+  skip_if_no_quarto()
+  quarto_render("theme/heatmaply.qmd", quiet = TRUE)
+  expect_true(file.exists("theme/heatmaply.html"))
+  unlink("theme/heatmaply.html")
+})
+
+
+test_that("render plotly-r", {
+  skip_if_no_quarto()
+  quarto_render("theme/plotly-r.qmd", quiet = TRUE)
+  expect_true(file.exists("theme/plotly-r.html"))
+  unlink("theme/plotly-r.html")
+})
+
+
+test_that("render thematic", {
+  skip_if_no_quarto()
+  quarto_render("theme/thematic.qmd", quiet = TRUE)
+  expect_true(file.exists("theme/thematic.html"))
+  unlink("theme/thematic.html")
+})
+

tests/testthat/theme/.gitignore

@@ -0,0 +1 @@
+/.quarto/

tests/testthat/theme/flextable.qmd

@@ -0,0 +1,40 @@
+---
+title: "knitr dark mode - flextable"
+brand:
+  light: united-brand.yml
+  dark: slate-brand.yml
+execute:
+  echo: false
+  warning: false
+---
+
+```{r}
+#| echo: false
+#| warning: false
+library(flextable)
+library(quarto)
+
+united_theme <- theme_brand_flextable('united-brand.yml')
+slate_theme <- theme_brand_flextable('slate-brand.yml')
+```
+
+```{r}
+#| renderings: [light, dark]
+
+ft <- flextable(airquality[ sample.int(10),])
+ft <- add_header_row(ft,
+  colwidths = c(4, 2),
+  values = c("Air quality", "Time")
+)
+ft <- theme_vanilla(ft)
+ft <- add_footer_lines(ft, "Daily air quality measurements in New York, May to September 1973.")
+ft <- color(ft, part = "footer", color = "#666666")
+ft <- set_caption(ft, caption = "New York Air Quality Measurements")
+
+ft |> united_theme()
+ft |> slate_theme()
+```
+
+Here's a [link](https://example.com).
+
+{{< lipsum 2 >}}

tests/testthat/theme/ggiraph.qmd

@@ -0,0 +1,27 @@
+---
+title: "dark mode - ggiraph"
+brand:
+  light: united-brand.yml
+  dark: slate-brand.yml
+---
+
+```{r}
+#| echo: false
+#| warning: false
+library(quarto)
+library(ggplot2)
+library(ggiraph)
+
+united_theme <- theme_brand_ggplot("united-brand.yml")
+slate_theme <- theme_brand_ggplot("slate-brand.yml")
+```
+
+```{r}
+#| renderings: [light, dark]
+cars <- ggplot(mtcars, aes(mpg, wt)) +
+  geom_point_interactive(aes(colour = factor(cyl), tooltip = rownames(mtcars))) +
+  scale_colour_manual(values = c("darkorange", "purple", "cyan4"))
+
+girafe(ggobj = cars + united_theme)
+girafe(ggobj = cars + slate_theme)
+```

tests/testthat/theme/ggplot.qmd

@@ -0,0 +1,27 @@
+---
+title: "knitr dark mode - ggplot"
+brand:
+  light: united-brand.yml
+  dark: slate-brand.yml
+---
+``
+
+```{r}
+#| echo: false
+#| warning: false
+library(quarto)
+library(ggplot2)
+
+united_theme <- theme_brand_ggplot("united-brand.yml")
+slate_theme <- theme_brand_ggplot("slate-brand.yml")
+```
+
+```{r}
+#| renderings: [light, dark]
+cars <- ggplot(mtcars, aes(mpg, wt)) +
+  geom_point(aes(colour = factor(cyl))) +
+  scale_colour_manual(values = c("darkorange", "purple", "cyan4"))
+
+cars + united_theme
+cars + slate_theme
+```