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
|
#' @export
#' @rdname geom_linerange
geom_pointrange <- function(mapping = NULL, data = NULL,
stat = "identity", position = "identity",
...,
fatten = 4,
na.rm = FALSE,
orientation = NA,
show.legend = NA,
inherit.aes = TRUE) {
layer(
data = data,
mapping = mapping,
stat = stat,
geom = GeomPointrange,
position = position,
show.legend = show.legend,
inherit.aes = inherit.aes,
params = list2(
fatten = fatten,
na.rm = na.rm,
orientation = orientation,
...
)
)
}
#' @rdname ggplot2-ggproto
#' @format NULL
#' @usage NULL
#' @export
GeomPointrange <- ggproto("GeomPointrange", Geom,
default_aes = aes(colour = "black", size = 0.5, linewidth = 0.5, linetype = 1,
shape = 19, fill = NA, alpha = NA, stroke = 1),
draw_key = draw_key_pointrange,
required_aes = c("x", "y", "ymin|xmin", "ymax|xmax"),
setup_params = function(data, params) {
GeomLinerange$setup_params(data, params)
},
extra_params = c("na.rm", "orientation"),
setup_data = function(data, params) {
GeomLinerange$setup_data(data, params)
},
draw_panel = function(data, panel_params, coord, lineend = "butt", fatten = 4,
flipped_aes = FALSE, na.rm = FALSE) {
line_grob <- GeomLinerange$draw_panel(
data, panel_params, coord, lineend = lineend, flipped_aes = flipped_aes,
na.rm = na.rm
)
if (is.null(data[[flipped_names(flipped_aes)$y]]))
return(line_grob)
ggname("geom_pointrange",
gTree(children = gList(
line_grob,
GeomPoint$draw_panel(
transform(data, size = size * fatten),
panel_params, coord, na.rm = na.rm
)
))
)
}
)
|
