params <-
list(family = "red", preset = "study", base_size = 13L, content_width = 80L,
style = "minimal")
## ----setup, include=FALSE-----------------------------------------------------
knitr::opts_chunk$set(
collapse = TRUE, comment = "#>", fig.align = "center", fig.retina = 2,
out.width = "100%", fig.width = 7, fig.asp = 0.618, message = FALSE, warning = FALSE
)
set.seed(123)
oldopt <- options(pillar.sigfig = 7, width = 80)
`%||%` <- function(a, b) if (is.null(a)) b else a
library(ggplot2)
if (requireNamespace("ggplot2", quietly = TRUE) && requireNamespace("albersdown", quietly = TRUE)) {
oldtheme <- ggplot2::theme_set(albersdown::theme_albers(
family = params$family,
preset = params$preset,
base_size = params$base_size
))
}
## ----albers-family, echo=FALSE, results='asis'--------------------------------
cat(sprintf('', params$family))
## ----albers-preset, echo=FALSE, results='asis'--------------------------------
cat(sprintf('', params$preset))
## ----albers-style, echo=FALSE, results='asis'---------------------------------
style_class <- switch(
tolower(params$style %||% "balanced"),
minimal = "style-minimal",
assertive = "style-assertive",
balanced = ""
)
if (nzchar(style_class)) {
cat(sprintf('', style_class))
}
## ----content-width, echo=FALSE, results='asis'--------------------------------
cat(sprintf('', params$content_width))
## ----syntax-demo--------------------------------------------------------------
fit <- lm(mpg ~ wt + hp, data = mtcars)
coef(summary(fit))
## ----contrast-example---------------------------------------------------------
contrast_ratio <- function(fg, bg) {
to_rgb <- function(x) as.numeric(grDevices::col2rgb(x)) / 255
to_lin <- function(u) ifelse(u <= 0.03928, u / 12.92, ((u + 0.055) / 1.055)^2.4)
luma <- function(x) {
rgb <- to_rgb(x); lin <- to_lin(rgb)
0.2126 * lin[1] + 0.7152 * lin[2] + 0.0722 * lin[3]
}
l1 <- luma(fg); l2 <- luma(bg)
if (l1 < l2) { tmp <- l1; l1 <- l2; l2 <- tmp }
(l1 + 0.05) / (l2 + 0.05)
}
ratio_structural <- contrast_ratio("#C22B23", "#e6e9ed")
ratio_adobe <- contrast_ratio("#C22B23", "#ece9e7")
stopifnot(ratio_structural >= 4.5, ratio_adobe >= 4.5)
data.frame(
context = c("structural bg", "adobe bg"),
ratio = c(ratio_structural, ratio_adobe)
)
## ----img-seq, fig.height=3.2--------------------------------------------------
mtcars |>
ggplot(aes(wt, mpg, colour = hp)) +
geom_point(size = 2.2) +
labs(title = "Image-derived sequential (lapis)") +
albersdown::scale_color_albers_img(
"lapis",
discrete = FALSE,
breaks = c(100, 150, 200, 250, 300)
) +
ggplot2::guides(
colour = ggplot2::guide_colorbar(
title.position = "top",
barheight = grid::unit(70, "pt"),
barwidth = grid::unit(10, "pt")
)
) +
ggplot2::theme(legend.position = "right")
## ----img-div, fig.height=3.2--------------------------------------------------
df <- transform(datasets::faithful, centered = waiting - mean(waiting))
ggplot(df, aes(eruptions, centered, colour = centered)) +
geom_point(alpha = 0.9) +
labs(title = "Image-derived diverging (red <-> teal)") +
albersdown::scale_color_albers_img_red_teal(neutral = "#e5e7eb")
## -----------------------------------------------------------------------------
knitr::kable(head(mtcars[, 1:5]), format = "html")
## -----------------------------------------------------------------------------
mtcars$grp <- ifelse(mtcars$cyl == 6, "highlight", "other")
mtcars$grp <- factor(mtcars$grp, levels = c("other", "highlight"))
ggplot(mtcars, aes(wt, mpg, color = grp)) +
geom_point(size = 2.2) +
albersdown::scale_color_albers_highlight(
family = params$family,
tone = "A700",
highlight = "highlight",
other_name = "other"
) +
labs(title = "One highlighted series; others neutral",
subtitle = "A700 draws the eye; gray recedes",
x = "Weight (1000 lbs)", y = "MPG")
## ----cleanup, include=FALSE---------------------------------------------------
options(oldopt)
if (exists("oldtheme")) ggplot2::theme_set(oldtheme)