Permalink
Fetching contributors…
Cannot retrieve contributors at this time
82 lines (72 sloc) 2.16 KB
#' @export
#' @rdname geom_tile
geom_rect <- 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 = GeomRect,
position = position,
show.legend = show.legend,
inherit.aes = inherit.aes,
params = list(
na.rm = na.rm,
...
)
)
}
#' @rdname ggplot2-ggproto
#' @format NULL
#' @usage NULL
#' @export
GeomRect <- ggproto("GeomRect", Geom,
default_aes = aes(colour = NA, fill = "grey35", size = 0.5, linetype = 1,
alpha = NA),
required_aes = c("xmin", "xmax", "ymin", "ymax"),
draw_panel = function(self, data, panel_params, coord) {
if (!coord$is_linear()) {
aesthetics <- setdiff(
names(data), c("x", "y", "xmin", "xmax", "ymin", "ymax")
)
polys <- plyr::alply(data, 1, function(row) {
poly <- rect_to_poly(row$xmin, row$xmax, row$ymin, row$ymax)
aes <- as.data.frame(row[aesthetics],
stringsAsFactors = FALSE)[rep(1,5), ]
GeomPolygon$draw_panel(cbind(poly, aes), panel_params, coord)
})
ggname("bar", do.call("grobTree", polys))
} else {
coords <- coord$transform(data, panel_params)
ggname("geom_rect", rectGrob(
coords$xmin, coords$ymax,
width = coords$xmax - coords$xmin,
height = coords$ymax - coords$ymin,
default.units = "native",
just = c("left", "top"),
gp = gpar(
col = coords$colour,
fill = alpha(coords$fill, coords$alpha),
lwd = coords$size * .pt,
lty = coords$linetype,
lineend = "butt"
)
))
}
},
draw_key = draw_key_polygon
)
# Convert rectangle to polygon
# Useful for non-Cartesian coordinate systems where it's easy to work purely in terms of locations, rather than locations and dimensions.
#
# @keyword internal
rect_to_poly <- function(xmin, xmax, ymin, ymax) {
data.frame(
y = c(ymax, ymax, ymin, ymin, ymax),
x = c(xmin, xmax, xmax, xmin, xmin)
)
}