I have made a new geom based on geom_point() and geom_jitter() to allow me to circle individual points based on a boolean column in my data. It is effectively drawing two sets of points but has the benefit of the points jitter in the same direction. However I seem to have lost the ability to specify the colour based on a character column.
With geom_point() and geom_jitter() you can set colour = to be a column of character strings and they are translated into different colours. In this situation I have had to split the colours aesthetic into two in order to control inner and outer points separately and in the process have lost the ability to specify colours with a character column.
Hopefully my reprex below illustrates this as I get the error:
Error in grDevices::col2rgb(colour, TRUE): invalid color name 'A'
Also if anyone can shed any light on why the legends disappeared it would be most appreciated.
library(tidyverse)
# New grob
GeomPointEn <- ggproto("GeomPoint", Geom,
required_aes = c("x", "y"),
non_missing_aes = c("size", "shape", "colour_inner", "colour_outer", "encirc"),
default_aes = aes(
shape = 19, colour_inner = "black", colour_outer = "red",
size = 1.5, fill = NA, alpha = NA, stroke = 0.5, encric = NA
),
draw_key = draw_key_point,
draw_panel = function(data, panel_params, coord, na.rm = FALSE) {
if(length(data$encirc) > 1){
checkmate::assert_logical(data$encirc, .var.name = "encirc")
}
coords <- coord$transform(data, panel_params)
inner_points <- ggplot2:::ggname("geom_point",
grid::pointsGrob(
coords$x, coords$y,
pch = coords$shape,
gp = grid::gpar(
col = alpha(coords$colour_inner, coords$alpha),
fill = alpha(coords$fill, coords$alpha),
# Stroke is added around the outside of the point
fontsize = coords$size * .pt + coords$stroke * .stroke / 2,
lwd = coords$stroke * .stroke / 2
)
)
)
if(length(data$encirc) > 1){
coords_sub <- dplyr::filter(coords, encirc == T)
outer_points <- ggplot2:::ggname("geom_point",
grid::pointsGrob(
coords_sub$x, coords_sub$y,
pch = 21,
gp = grid::gpar(
col = alpha(coords_sub$colour_outer, coords_sub$alpha),
fill = alpha(coords_sub$fill, coords_sub$alpha),
# Stroke is added around the outside of the point
fontsize = 2.5 * coords_sub$size * .pt + coords_sub$stroke * .stroke / 2,
lwd = coords_sub$stroke * .stroke
)
)
)
grid::gTree(children = grid::gList(inner_points, outer_points))
}
else{
return(inner_points)
}
}
)
# New geom
geom_point_en <- function(mapping = NULL, data = NULL,
stat = "identity", position = "identity",
...,
na.rm = FALSE,
show.legend = NA,
inherit.aes = TRUE) {
layer(
data = data,
mapping = mapping,
stat = stat,
geom = GeomPointEn,
position = position,
show.legend = show.legend,
inherit.aes = inherit.aes,
params = list(
na.rm = na.rm,
...
)
)
}
# New geom
geom_jitter_en <- function(mapping = NULL, data = NULL,
stat = "identity", position = "jitter",
...,
width = NULL,
height = NULL,
na.rm = FALSE,
show.legend = NA,
inherit.aes = TRUE) {
if (!missing(width) || !missing(height)) {
if (!missing(position)) {
stop("Specify either `position` or `width`/`height`", call. = FALSE)
}
position <- position_jitter(width = width, height = height)
}
layer(
data = data,
mapping = mapping,
stat = stat,
geom = GeomPointEn,
position = position,
show.legend = show.legend,
inherit.aes = inherit.aes,
params = list(
na.rm = na.rm,
...
)
)
}
# Example of geom use
mtcars %>%
mutate(intrest = if_else(carb <= 2, T, F)) %>%
ggplot(aes(wt, mpg, encirc = intrest)) +
geom_jitter_en()
# works when colour column is numeric
ggplot(mtcars, aes(wt, mpg, colour_inner = carb)) +
geom_jitter_en()
# does not work when colour column is a character
testcars <- dplyr::mutate(mtcars, a = c(LETTERS, LETTERS[1:6]))
ggplot(testcars, aes(wt, mpg, colour_inner = a)) +
geom_jitter_en()
#> Error in grDevices::col2rgb(colour, TRUE): invalid color name 'A'
# does work with geom_jitter()
ggplot(testcars, aes(wt, mpg, colour = a)) +
geom_jitter()
Created on 2018-04-01 by the reprex package (v0.2.0).
