Intro Thoughts
Status Quo
library(tidyverse)
GeomBarbell <- ggproto("GeomBarbell", Geom,
required_aes = c("x", "y", "xend", "yend"),
default_aes = aes(
colour = "black",
linewidth = .5,
size = 2,
linetype = 1,
shape = 19,
fill = NA,
alpha = NA,
stroke = 1
),
draw_panel = function(data, panel_params, coord, ...) {
# Transformed data for the points
point1 <- transform(data)
point2 <- transform(data, x = xend, y = yend)
# Return all three components
grid::gList(
GeomSegment$draw_panel(data, panel_params, coord, ...),
GeomPoint$draw_panel(point1, panel_params, coord, ...),
GeomPoint$draw_panel(point2, panel_params, coord, ...)
)
}
)
geom_barbell <- 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 = GeomBarbell,
position = position,
show.legend = show.legend,
inherit.aes = inherit.aes,
params = list(na.rm = na.rm, ...)
)
}
df <- data.frame(x = 1:10, xend = 0:9, y = 0, yend = 1:10)
base <- ggplot(df, aes(x, y, xend = xend, yend = yend))
base + geom_barbell()
base + geom_barbell(shape = 4, linetype = "dashed")
Experimental in-script ‘express’ variant (using lollipop instead of
barbell for variety)
GeomSegment$default_aes
## Aesthetic mapping:
## * `colour` -> "black"
## * `linewidth` -> 0.5
## * `linetype` -> 1
## * `alpha` -> NA
GeomPoint$default_aes
## Aesthetic mapping:
## * `shape` -> 19
## * `colour` -> "black"
## * `size` -> 1.5
## * `fill` -> NA
## * `alpha` -> NA
## * `stroke` -> 0.5
# Duplicated aesthetics after name standardisation: colour and alpha
aes(!!!GeomPoint$default_aes, !!!GeomSegment$default_aes)
## Warning: Duplicated aesthetics after name standardisation: colour and alpha
## Aesthetic mapping:
## * `shape` -> 19
## * `colour` -> "black"
## * `size` -> 1.5
## * `fill` -> NA
## * `alpha` -> NA
## * `stroke` -> 0.5
## * `colour` -> "black"
## * `linewidth` -> 0.5
## * `linetype` -> 1
## * `alpha` -> NA
aes(!!!GeomPoint$default_aes, !!!GeomSegment$default_aes)[c(-2,-5)] # warns even with removal
## Warning: Duplicated aesthetics after name standardisation: colour and alpha
## Aesthetic mapping:
## * `shape` -> 19
## * `size` -> 1.5
## * `fill` -> NA
## * `stroke` -> 0.5
## * `colour` -> "black"
## * `linewidth` -> 0.5
## * `linetype` -> 1
## * `alpha` -> NA
draw_panel_lollipop <- function(data, panel_params, coord, ...) {
# Transformed data for the points
segmentdata <- transform(data, xend = x, yend = 0)
point1data <- transform(data)
point2data <- transform(data, y = 0)
# Return all three components
grid::gList(
GeomSegment$draw_panel(segmentdata, panel_params, coord, ...),
GeomPoint$draw_panel(point1data, panel_params, coord, ...),
GeomPoint$draw_panel(point2data, panel_params, coord, ...)
)
}
# what can I put in here for panel_params....
# cars %>%
# select(x = speed, y = dist) %>%
# mutate(xend = x, yend = 0) %>%
# draw_panel_barbell(coord = CoordCartesian)
GeomLollipop <- ggproto(`_class` = "GeomLollipop",
`_inherit` = Geom,
## Warning: Duplicated aesthetics after name standardisation:
## colour and alpha
default_aes = aes(!!!GeomPoint$default_aes,
!!!GeomSegment$default_aes)[c(-2,-5)],
draw_panel = draw_panel_lollipop
)
## Warning: Duplicated aesthetics after name standardisation: colour and alpha
df <- data.frame(x = 1:10, y = 1:10)
base <- ggplot(df, aes(x, y))
base + stat_identity(geom = GeomLollipop)
# base + geom_barbell(shape = 4, linetype = "dashed")
geom_barbell <- function(...){
stat_identity(geom = GeomLollipop,...)
}
base +
geom_barbell()