Browse Source

improvements to geom_encircle (fix guides etc.)

pull/19/head
Ben Bolker 8 years ago
parent
commit
ae6fe9e1d3
  1. 31
      R/geom_encircle.r

31
R/geom_encircle.r

@ -1,3 +1,13 @@
draw_key_hack <- function(data, params, size) {
data$fill <- alpha(data$fill, data$alpha)
data$alpha <- 1
grobTree(
if (!is.na(data$fill)) grid::rectGrob(gp = gpar(col = NA, fill = data$fill)),
draw_key_path(data, params)
)
}
#' @rdname ggalt-ggproto #' @rdname ggalt-ggproto
#' @format NULL #' @format NULL
#' @usage NULL #' @usage NULL
@ -5,15 +15,18 @@
GeomEncircle <- ggproto("GeomEncircle", Geom, GeomEncircle <- ggproto("GeomEncircle", Geom,
required_aes = c("x", "y"), required_aes = c("x", "y"),
default_aes = aes(colour = "black", default_aes = aes(colour = "black",
fill = NA, ## ???
alpha = 1,
linetype=1, linetype=1,
size=1, size=1,
s_shape=0.5, ## corresponds to default shape in xspline of -0.5 s_shape=0.5, ## corresponds to default shape in xspline of -0.5
s_open=FALSE, s_open=FALSE,
expand=0.05, expand=0.05,
spread=0.1), spread=0.1),
draw_key = draw_key_point, draw_key = draw_key_hack, ## ???
draw_group = function(data, panel_scales, coord) { draw_group = function(data, panel_scales, coord) {
## browser()
coords <- coord$transform(data, panel_scales) coords <- coord$transform(data, panel_scales)
first_row <- coords[1, , drop = FALSE] first_row <- coords[1, , drop = FALSE]
rownames(first_row) <- NULL ## prevent warning later rownames(first_row) <- NULL ## prevent warning later
@ -78,6 +91,12 @@ GeomEncircle <- ggproto("GeomEncircle", Geom,
disp <- normFun(coords,m) disp <- normFun(coords,m)
## browser()
gp <- grid::get.gpar()
pars1 <- c("colour","linetype","alpha","fill","size")
pars2 <- c("col","lty","alpha","fill","lwd")
gp[pars2] <- first_row[pars1]
grid::xsplineGrob( grid::xsplineGrob(
with(coords,unit(x,"npc")+disp$x*unit(expand,"snpc")), with(coords,unit(x,"npc")+disp$x*unit(expand,"snpc")),
with(coords,unit(y,"npc")+disp$y*unit(expand,"snpc")), with(coords,unit(y,"npc")+disp$y*unit(expand,"snpc")),
@ -85,9 +104,7 @@ GeomEncircle <- ggproto("GeomEncircle", Geom,
## coords$y, ## coords$y,
shape = coords$s_shape-1, ## kluge! shape = coords$s_shape-1, ## kluge!
open = first_row$s_open, open = first_row$s_open,
gp = with(first_row, gp = gp)
grid::gpar(col = colour, lty=linetype))
)
} }
) )
@ -189,6 +206,11 @@ if (FALSE) {
#' #'
#' gg <- ggplot(mpg, aes(displ, hwy)) #' gg <- ggplot(mpg, aes(displ, hwy))
#' gg + geom_encircle(data=subset(mpg, hwy>40)) + geom_point() #' gg + geom_encircle(data=subset(mpg, hwy>40)) + geom_point()
#' gg + geom_encircle(aes(group=manufacturer)) + geom_point()
#' gg + geom_encircle(aes(group=manufacturer,fill=manufacturer),alpha=0.4)+
#' geom_point()
#' gg + geom_encircle(aes(group=manufacturer,colour=manufacturer))+
#' geom_point()
#' #'
#' ss <- subset(mpg,hwy>31 & displ<2) #' ss <- subset(mpg,hwy>31 & displ<2)
#' #'
@ -203,3 +225,4 @@ geom_encircle <- function(mapping = NULL, data = NULL, stat = "identity",
params = list(na.rm = na.rm, ...) params = list(na.rm = na.rm, ...)
) )
} }

Loading…
Cancel
Save