ggtintshade uses a
bit of a hack to let two aesthetics interact. The default
ggplot2 API deliberately keeps aesthetics independent, and
for the most part that makes sense. Here, though, we want
color (a hue) and tintshade (a lightness) to
interact: the tint of each point depends on both its color group and its
tintshade value.
The hack has two parts:
ggproto object, so there is no shared or global state.use_defaults. This is a
late step in ggplot_build() where the mapped colors and the
mapped tintshade values are finally available side by side. There we
compute each point’s tint, recolor the points, and record the final
color in the cache keyed by its tintshade value. The guide later reads
those colors back when it draws the legend.This vignette rebuilds the following plot using a stripped-down
geom_point_tintshadedemo to show the general mechanism.
library(ggplot2)
library(ggtintshade)
metab_data <- data.frame(
metab = rep(c("Alanine", "Threonine", "Glycine",
"Glycine betaine", "Proline betaine", "Carnitine",
"DMSP", "DMS-Ac", "Isethionate"), 3),
metab_group = rep(rep(c("Amino acid", "Betaine", "Sulfur"), each = 3), 3),
tripl = rep(c("A", "B", "C"), each = 9),
area = runif(27)
)
ggplot(metab_data) +
aes(x = tripl, y = area, color = metab_group, tintshade = metab) +
geom_point_tintshade(size = 4)Initialise the cache in the geom constructor so each layer gets its
own — no shared or global state to worry about. The environment is
attached to a per-layer ggproto instance.
geom_point_tintshadedemo <- function(mapping = NULL, data = NULL, ..., size = NULL) {
cache <- new.env(parent = emptyenv())
cache$lookup <- character(0)
geom <- ggproto(NULL, GeomPointTintshadeDemo, tintshade_cache = cache)
layer(
geom = geom, mapping = mapping, data = data,
stat = "identity", position = "identity",
params = list(size = size, ...)
)
}use_defaultsuse_defaults() is called (at least) twice during
ggplot_build(): once for the panel data and once for the
legend key. We only want to touch the panel data, so we skip the legend
key. The legend has an .id column, which the panel data
does not, so we use that to disambiguate them.
Inside, we rank each point’s tintshade value within its color group,
spread those ranks across the tintshade range, and feed the result to
colorspace::lighten() (positive lightens, negative
darkens). We overwrite data$colour with the tint and record
it in the cache under its numeric tintshade value, for the guide to
recall later.
# Rank tintshade values within each color group and spread over the range.
local_tint <- function(color, tintshade) {
ave(tintshade, color, FUN = function(v) {
ranks <- match(v, sort(unique(v)))
scales::rescale(ranks, to = range(tintshade))
})
}
GeomPointTintshadeDemo <- ggproto("GeomPointTintshadeDemo", GeomPoint,
tintshade_cache = NULL, # supplied by the constructor
use_defaults = function(self, data, params = list(), ...) {
data <- ggproto_parent(GeomPoint, self)$use_defaults(data, params, ...)
if (!is.null(self$tintshade_cache) && is.null(data$.id) && !is.null(data$tintshadedemo)) {
t <- local_tint(data$colour, data$tintshadedemo)
data$colour <- colorspace::lighten(data$colour, 2 * t - 1) # 0.5 -> no change
self$tintshade_cache$lookup[sprintf("%.10f", data$tintshadedemo)] <- data$colour
}
data
}
)
GeomPointTintshadeDemo$default_aes$tintshadedemo <- NA # register the new aesthetic
scale_tintshadedemo_discrete <- function(..., range = c(0.2, 0.8)) {
discrete_scale("tintshadedemo", palette = function(n) seq(range[1], range[2], length.out = n))
}With just this, the panel is correctly tinted but the legend is incorrect because we haven’t yet defined the guide so it defaults to the solid black entries.
ggplot(metab_data) +
aes(x = tripl, y = area, color = metab_group, tintshadedemo = metab) +
geom_point_tintshadedemo(size = 4)The guide has two parts. In get_layer_key() we grab the
layer’s cache and stash it on the guide’s params. In
draw(), which runs after the build has filled the cache, we
look up each key’s tintshade value and recolor it. We also redefine the
default scale (constructed from the aesthetic name) to use the new
guide.
GuideTintshadeDemo <- ggproto("GuideTintshadeDemo", GuideLegend,
get_layer_key = function(self, params, layers, data, theme = NULL) {
params <- ggproto_parent(GuideLegend, self)$get_layer_key(params, layers, data, theme)
params$tintshade_cache <- layers[[1]]$geom$tintshade_cache
params
},
draw = function(self, theme, position = NULL, direction = NULL, params = self$params) {
keys <- params$decor[[1]]$data
params$decor[[1]]$data$colour <-
params$tintshade_cache$lookup[sprintf("%.10f", keys$tintshadedemo)]
ggproto_parent(GuideLegend, self)$draw(theme, position, direction, params)
}
)
guide_tintshadedemo <- function(...) {
new_guide(..., available_aes = "tintshadedemo", super = GuideTintshadeDemo)
}
scale_tintshadedemo_discrete <- function(..., range = c(0.2, 0.8)) {
discrete_scale("tintshadedemo", palette = function(n) seq(range[1], range[2], length.out = n),
guide = guide_tintshadedemo())
}And we have our expected behavior.
ggplot(metab_data) +
aes(x = tripl, y = area, color = metab_group, tintshadedemo = metab) +
geom_point_tintshadedemo(size = 4)The real package generalizes this in a few ways and adds some additional functionality but the two-part hack is the one shown here.
Vignette last built on 2026-07-23