1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
|
#' @export
#' @rdname geom_tile
geom_rect <- function(mapping = NULL, data = NULL,
stat = "identity", position = "identity",
...,
linejoin = "mitre",
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 = list2(
linejoin = linejoin,
na.rm = na.rm,
...
)
)
}
#' @rdname ggplot2-ggproto
#' @format NULL
#' @usage NULL
#' @export
GeomRect <- ggproto("GeomRect", Geom,
default_aes = aes(colour = NA, fill = "grey35", linewidth = 0.5, linetype = 1,
alpha = NA),
required_aes = c("xmin", "xmax", "ymin", "ymax"),
draw_panel = function(self, data, panel_params, coord, lineend = "butt", linejoin = "mitre") {
data <- check_linewidth(data, snake_class(self))
if (!coord$is_linear()) {
aesthetics <- setdiff(
names(data), c("x", "y", "xmin", "xmax", "ymin", "ymax")
)
polys <- lapply(split(data, seq_len(nrow(data))), function(row) {
poly <- rect_to_poly(row$xmin, row$xmax, row$ymin, row$ymax)
aes <- row[rep(1,5), aesthetics]
GeomPolygon$draw_panel(vec_cbind(poly, aes), panel_params, coord, lineend = lineend, linejoin = linejoin)
})
ggname("geom_rect", inject(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$linewidth * .pt,
lty = coords$linetype,
linejoin = linejoin,
lineend = lineend
)
))
}
},
draw_key = draw_key_polygon,
rename_size = TRUE
)
# 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. Note that, though
# `polygonGrob()` expects an open form, closed form is needed for correct
# munching (c.f. https://github.com/tidyverse/ggplot2/issues/3037#issuecomment-458406857).
#
# @keyword internal
rect_to_poly <- function(xmin, xmax, ymin, ymax) {
data_frame0(
y = c(ymax, ymax, ymin, ymin, ymax),
x = c(xmin, xmax, xmax, xmin, xmin)
)
}
|
