custom `geom_` with two different styles for plotting - r

Question

My goal is to write a custom geom_ method that calculates and plots, e.g., confidence intervals and these should be plotted either as polygons or as lines. The question now is, where to check which "style" should be plotted?
So far I have tried out three different approaches,
(i) write two different geom_/stat_ for line and polygon style plots,
(ii) write a single geom_/stat_ which uses a custom GeomMethod,
(iii) write a single geom_/stat_ which uses either GeomPolygon or GeomLine.
In my opinion, to sum up
(i) is more or less straightforward but only bypasses the problem,
(ii) works when you use either GeomPath$draw_panel() or GeomPolygon$draw_panel() depending on an extra parameter style. But here I can't work it out to set default_aes depending also on the extra argument style. Compare also the answer here.
(iii) works when calling geom_ but fails for calling stat_ as the name matching within ggplot2 fails. See minimal example below.
Setting up the methods of approach (iii):
geom_my_confint <- function(mapping = NULL, data = NULL, stat = "my_confint",
position = "identity", na.rm = FALSE,
show.legend = NA, inherit.aes = TRUE,
style = c("polygon", "line"), ...) {
style <- match.arg(style)
ggplot2::layer(
geom = if (style == "line") GeomPath else GeomPolygon,
mapping = mapping,
data = data,
stat = stat,
position = position,
show.legend = show.legend,
inherit.aes = inherit.aes,
params = list(
na.rm = na.rm,
style = style,
...
)
)
}
stat_my_confint <- function(mapping = NULL, data = NULL, geom = "my_confint",
position = "identity", na.rm = FALSE,
show.legend = NA, inherit.aes = TRUE,
style = c("polygon", "line"), ...) {
style <- match.arg(style)
ggplot2::layer(
geom = geom,
stat = StatMyConfint,
data = data,
mapping = mapping,
position = position,
show.legend = show.legend,
inherit.aes = inherit.aes,
params = list(
na.rm = na.rm,
style = style,
...
)
)
}
StatMyConfint <- ggplot2::ggproto("StatMyConfint", ggplot2::Stat,
compute_group = function(data, scales, style) {
if (style == "polygon") {
nd <- data.frame(
x = c(data$x, rev(data$x)),
y = c(data$y - 1, rev(data$y) + 1)
)
nd
} else {
nd <- data.frame(
x = rep(data$x, 2),
y = c(data$y - 1, data$y + 1),
group = c(rep(1, 5), rep(2, 5))
)
nd
}
},
required_aes = c("x", "y")
)
Trying out the methods of approach (iii):
library("ggplot2")
d <- data.frame(
x = seq(1, 5),
y = seq(1, 5)
)
ggplot(d, aes(x = x, y = y)) + geom_line() + geom_my_confint(style = "polygon", alpha = 0.2)
ggplot(d, aes(x = x, y = y)) + geom_line() + geom_my_confint(style = "line", linetype = 2)
This works well so far. However when calling the stat_ there is an error in ggplot2:::check_subclass because there is no GeomMyConfint method.
ggplot(d, aes(x = x, y = y)) + geom_line() + stat_my_confint()
# Error: Can't find `geom` called 'my_confint'
Any solutions or suggestions for alternative approaches?

Answer 1

The following isn't very elegant but seems to work. Let's define the following constructor, wherein the geom is set to GeomMyConfint, which we'll define further down.
geom_my_confint <- function(mapping = NULL, data = NULL, stat = "my_confint",
position = "identity", na.rm = FALSE,
show.legend = NA, inherit.aes = TRUE,
style = c("polygon", "line"), ...) {
style <- match.arg(style)
ggplot2::layer(
geom = GeomMyConfint,
mapping = mapping,
data = data,
stat = stat,
position = position,
show.legend = show.legend,
inherit.aes = inherit.aes,
params = list(
na.rm = na.rm,
style = style,
...
)
)
}
Below is the paired ggproto class. I've amended the use_defaults method to replace a defaulted colour by some text. Then later, the draw_panel() method chooses the actual default to replace the text we've inserted earlier, depending on the style argument.
GeomMyConfint <- ggproto(
"GeomMyConfint", GeomPolygon,
# Tag colour if it has been defaulted
use_defaults = function(self, data, params = list(), modifiers = aes()) {
has_colour <- "colour" %in% names(data) || "colour" %in% names(params)
data <- ggproto_parent(GeomPolygon, self)$use_defaults(
data, params, modifiers
)
if (!has_colour) {
data$colour <- "default_colour"
}
data
},
# Resolve colour defaults here
draw_panel = function(
data, panel_params, coord,
# Polygon arguments
rule = "evenodd",
# Line arguments
lineend = "butt", linejoin = "round", linemitre = 10,
na.rm = FALSE, arrow = NULL,
# Switch argument
style = "polygon")
{
if (style == "polygon") {
data$colour[data$colour == "default_colour"] <- NA
GeomPolygon$draw_panel(data, panel_params, coord, rule)
} else {
data$colour[data$colour == "default_colour"] <- "black"
GeomPath$draw_panel(data, panel_params, coord,
arrow, lineend, linejoin, linemitre, na.rm)
}
}
)
Then then works with the rest of the functions from your example.
A more elegant method might be to use the vctrs package to define a custom S3 class for defaulted values that is easy to recognise, but I haven't seen people trying to use aes(colour = I("default_colour")) before, so you're probably safe aside from this one single edge case.

Answer 2

Based on #teunbrand's answer and how geom_sf() is implemented, I came up with the following solution supporting approach (ii):
geom_my_confint <- function(mapping = NULL, data = NULL, stat = "my_confint",
position = "identity", na.rm = FALSE,
show.legend = NA, inherit.aes = TRUE,
type = c("polygon", "line"), ...) {
type <- match.arg(type)
ggplot2::layer(
geom = GeomMyConfint,
mapping = mapping,
data = data,
stat = stat,
position = position,
show.legend = show.legend,
inherit.aes = inherit.aes,
params = list(
na.rm = na.rm,
type = type,
...
)
)
}
GeomMyConfint <- ggplot2::ggproto("GeomMyConfint", ggplot2::Geom,
## Setting up all defaults needed for `GeomPolygon` and `GeomPath`
default_aes = ggplot2::aes(
colour = NA,
fill = NA,
size = NA,
linetype = NA,
alpha = NA,
subgroup = NULL
),
draw_panel = function(data, panel_params, coord,
rule = "evenodd", # polygon arguments
lineend = "butt", linejoin = "round", # line arguments
linemitre = 10, na.rm = FALSE, arrow = NULL, # line arguments
type = c("polygon", "line")) {
type <- match.arg(type)
## Swap NAs in `default_aes` with own defaults
data <- my_modify_list(data, my_default_aesthetics(type), force = FALSE)
if (type == "polygon") {
GeomPolygon$draw_panel(data, panel_params, coord, rule)
} else {
GeomPath$draw_panel(data, panel_params, coord,
arrow, lineend, linejoin, linemitre, na.rm)
}
},
draw_key = function(data, params, size) {
## Swap NAs in `default_aes` with own defaults
data <- my_modify_list(data, my_default_aesthetics(params$type), force = FALSE)
if (params$type == "polygon") {
draw_key_polygon(data, params, size)
} else {
draw_key_path(data, params, size)
}
}
)
## Helper function inspired by internal from `ggplot2` defined in `performance.R`
my_modify_list <- function(old, new, force = FALSE) {
if (force) {
for (i in names(new)) old[[i]] <- new[[i]]
} else {
for (i in names(new)) old[[i]] <- if (all(is.na(old[[i]]))) new[[i]] else old[[i]]
}
old
}
## Helper function inspired by internal from `ggplot2` defined in `geom-sf.R`
my_default_aesthetics <- function(type) {
if (type == "line") {
my_modify_list(GeomPath$default_aes, list(colour = "red", linetype = 2), force = TRUE)
} else {
my_modify_list(GeomPolygon$default_aes, list(fill = "red", alpha = 0.2), force = TRUE)
}
}
I've kept the stat_my_confint() and StatMyConfint() from above unchanged (only the argument style is now called type according to the naming w/i geom_sf()):
stat_my_confint <- function(mapping = NULL, data = NULL, geom = "my_confint",
position = "identity", na.rm = FALSE,
show.legend = NA, inherit.aes = TRUE,
type = c("polygon", "line"), ...) {
type <- match.arg(type)
ggplot2::layer(
geom = geom,
stat = StatMyConfint,
data = data,
mapping = mapping,
position = position,
show.legend = show.legend,
inherit.aes = inherit.aes,
params = list(
na.rm = na.rm,
type = type,
...
)
)
}
StatMyConfint <- ggplot2::ggproto("StatMyConfint", ggplot2::Stat,
compute_group = function(data, scales, type) {
if (type == "polygon") {
nd <- data.frame(
x = c(data$x, rev(data$x)),
y = c(data$y - 1, rev(data$y) + 1)
)
nd
} else {
nd <- data.frame(
x = rep(data$x, 2),
y = c(data$y - 1, data$y + 1),
group = c(rep(1, 5), rep(2, 5))
)
nd
}
},
required_aes = c("x", "y")
)
Now the examples from above work fine:
library("ggplot2")
d1 <- data.frame(
x = seq(1, 5),
y = seq(1, 5)
)
ggplot(d1, aes(x = x, y = y)) + geom_line() + geom_my_confint()
ggplot(d1, aes(x = x, y = y)) + geom_line() + geom_my_confint(type = "line")
ggplot(d1, aes(x = x, y = y)) + geom_line() + geom_my_confint(type = "polygon", alpha = 0.8)
ggplot(d1, aes(x = x, y = y)) + geom_line() + geom_my_confint(type = "line", linetype = 4, colour = "red")
ggplot(d1, aes(x = x, y = y)) + geom_line() + stat_my_confint()
ggplot(d1, aes(x = x, y = y)) + geom_line() + stat_my_confint(type = "line")
ggplot(d1, aes(x = x, y = y)) + geom_line() + stat_my_confint(type = "polygon", alpha = 0.8)
ggplot(d1, aes(x = x, y = y)) + geom_line() + stat_my_confint(type = "line", linetype = 4, colour = "red")
However, the solution still fails if you want additionally, e.g., set the fill colour of the polygon by an external grouping variable:
d2 <- data.frame(
x = rep(seq(1, 5), 2),
y = rep(seq(1, 5), 2),
z = factor(c(rep(1, 5), rep(2, 5)))
)
ggplot(d2, aes(x = x, y = y)) + geom_line() + geom_my_confint() + facet_wrap(.~z)
# no error
ggplot(d2, aes(x = x, y = y, fill = z)) + geom_line() + geom_my_confint() + facet_wrap(.~z)
# Error in grid.Call.graphics(C_setviewport, vp, TRUE) :
# non-finite location and/or size for viewport
So still no perfect answer. Help/extensions appreciated!
EDIT:
The error no longer occurs if the size argument is set to 0.5 within GeomMyConfint$default_aes():
Not clear to me why - anyone?!
Here, this works as I don't change the default size for GeomPolygon or GeomPath, but would be problematic otherwise.
I do not find any more errors (for now).
The adapted code:
GeomMyConfint <- ggplot2::ggproto("GeomMyConfint", ggplot2::Geom,
## Setting up all defaults needed for `GeomPolygon` and `GeomPath`
default_aes = ggplot2::aes(
colour = NA,
fill = NA,
size = 0.5,
linetype = NA,
alpha = NA,
subgroup = NULL
),
draw_panel = function(data, panel_params, coord,
rule = "evenodd", # polygon arguments
lineend = "butt", linejoin = "round", # line arguments
linemitre = 10, na.rm = FALSE, arrow = NULL, # line arguments
type = c("polygon", "line")) {
type <- match.arg(type)
## Swap NAs in `default_aes` with own defaults
data <- my_modify_list(data, my_default_aesthetics(type), force = FALSE)
if (type == "polygon") {
GeomPolygon$draw_panel(data, panel_params, coord, rule)
} else {
GeomPath$draw_panel(data, panel_params, coord,
arrow, lineend, linejoin, linemitre, na.rm)
}
},
draw_key = function(data, params, size) {
## Swap NAs in `default_aes` with own defaults
data <- my_modify_list(data, my_default_aesthetics(params$type), force = FALSE)
if (params$type == "polygon") {
draw_key_polygon(data, params, size)
} else {
draw_key_path(data, params, size)
}
}
)
The plot:
ggplot(d2, aes(x = x, y = y, fill = z)) + geom_line() + geom_my_confint() + facet_wrap(.~z)