|
@ -1,5 +1,6 @@ |
|
|
geom_rrect <- function(mapping = NULL, data = NULL, |
|
|
geom_rrect <- function(mapping = NULL, data = NULL, |
|
|
stat = "identity", position = "identity", |
|
|
stat = "identity", position = "identity", |
|
|
|
|
|
radius = grid::unit(6, "pt"), |
|
|
..., |
|
|
..., |
|
|
na.rm = FALSE, |
|
|
na.rm = FALSE, |
|
|
show.legend = NA, |
|
|
show.legend = NA, |
|
@ -13,6 +14,7 @@ geom_rrect <- function(mapping = NULL, data = NULL, |
|
|
show.legend = show.legend, |
|
|
show.legend = show.legend, |
|
|
inherit.aes = inherit.aes, |
|
|
inherit.aes = inherit.aes, |
|
|
params = list( |
|
|
params = list( |
|
|
|
|
|
radius = radius, |
|
|
na.rm = na.rm, |
|
|
na.rm = na.rm, |
|
|
... |
|
|
... |
|
|
) |
|
|
) |
|
@ -20,33 +22,44 @@ geom_rrect <- function(mapping = NULL, data = NULL, |
|
|
} |
|
|
} |
|
|
|
|
|
|
|
|
GeomRrect <- ggplot2::ggproto("GeomRrect", ggplot2::Geom, |
|
|
GeomRrect <- ggplot2::ggproto("GeomRrect", ggplot2::Geom, |
|
|
default_aes = aes(colour = NA, fill = "grey35", size = 0.5, linetype = 1, |
|
|
|
|
|
alpha = NA), |
|
|
default_aes = ggplot2::aes( |
|
|
|
|
|
colour = NA, fill = "grey35", size = 0.5, linetype = 1, alpha = NA |
|
|
|
|
|
), |
|
|
|
|
|
|
|
|
required_aes = c("xmin", "xmax", "ymin", "ymax"), |
|
|
required_aes = c("xmin", "xmax", "ymin", "ymax"), |
|
|
|
|
|
|
|
|
draw_panel = function(self, data, panel_params, coord) { |
|
|
draw_panel = function(self, data, panel_params, coord, |
|
|
coords <- coord$transform(data, panel_params) |
|
|
radius = grid::unit(6, "pt")) { |
|
|
lapply(1:length(coords$xmin), function(i) { |
|
|
|
|
|
ggname("geom_rrect", grid::roundrectGrob( |
|
|
coords <- coord$transform(data, panel_params) |
|
|
coords$xmin[i], coords$ymax[i], |
|
|
|
|
|
width = (coords$xmax[i] - coords$xmin[i]), |
|
|
lapply(1:length(coords$xmin), function(i) { |
|
|
height = (coords$ymax[i] - coords$ymin)[i], |
|
|
|
|
|
r=grid::unit(0.3, "snpc"), |
|
|
grid::roundrectGrob( |
|
|
default.units = "native", |
|
|
coords$xmin[i], coords$ymax[i], |
|
|
just = c("left", "top"), |
|
|
width = (coords$xmax[i] - coords$xmin[i]), |
|
|
gp = grid::gpar( |
|
|
height = (coords$ymax[i] - coords$ymin)[i], |
|
|
col = coords$colour[i], |
|
|
r = radius, |
|
|
fill = alpha(coords$fill[i], coords$alpha[i]), |
|
|
default.units = "native", |
|
|
lwd = coords$size[i] * .pt, |
|
|
just = c("left", "top"), |
|
|
lty = coords$linetype[i], |
|
|
gp = grid::gpar( |
|
|
lineend = "butt" |
|
|
col = coords$colour[i], |
|
|
) |
|
|
fill = alpha(coords$fill[i], coords$alpha[i]), |
|
|
)) |
|
|
lwd = coords$size[i] * .pt, |
|
|
}) -> gl |
|
|
lty = coords$linetype[i], |
|
|
|
|
|
lineend = "butt" |
|
|
do.call(grid::gList, gl) |
|
|
) |
|
|
|
|
|
) |
|
|
|
|
|
|
|
|
|
|
|
}) -> gl |
|
|
|
|
|
|
|
|
|
|
|
grobs <- do.call(grid::gList, gl) |
|
|
|
|
|
|
|
|
|
|
|
ggname("geom_rrect", grid::grobTree(children = grobs)) |
|
|
|
|
|
|
|
|
}, |
|
|
}, |
|
|
|
|
|
|
|
|
draw_key = ggplot2::draw_key_polygon |
|
|
draw_key = ggplot2::draw_key_polygon |
|
|
|
|
|
|
|
|
) |
|
|
) |