forked from davidgohel/ggiraph
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathgeom_polygon_interactive.R
48 lines (39 loc) · 1.52 KB
/
geom_polygon_interactive.R
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
library(ggplot2)
library(ggiraph)
# create data
ids <- factor(c("1.1", "2.1", "1.2", "2.2", "1.3", "2.3"))
values <- data.frame(
id = ids,
value = c(3, 3.1, 3.1, 3.2, 3.15, 3.5) )
positions <- data.frame(
id = rep(ids, each = 4),
x = c(2, 1, 1.1, 2.2, 1, 0, 0.3, 1.1, 2.2, 1.1, 1.2, 2.5, 1.1, 0.3,
0.5, 1.2, 2.5, 1.2, 1.3, 2.7, 1.2, 0.5, 0.6, 1.3),
y = c(-0.5, 0, 1, 0.5, 0, 0.5, 1.5, 1, 0.5, 1, 2.1, 1.7, 1, 1.5,
2.2, 2.1, 1.7, 2.1, 3.2, 2.8, 2.1, 2.2, 3.3, 3.2) )
datapoly <- merge(values, positions, by=c("id"))
datapoly$oc = "alert(this.getAttribute(\"data-id\"))"
# create a ggplot -----
gg_poly_1 <- ggplot(datapoly, aes( x = x, y = y ) ) +
geom_polygon_interactive(aes(fill = value, group = id,
tooltip = value, data_id = value, onclick = oc))
# display ------
x <- girafe(ggobj = gg_poly_1)
if( interactive() ) print(x)
if (packageVersion("grid") >= "3.6") {
# As of R version 3.6 geom_polygon() supports polygons with holes
# Use the subgroup aesthetic to differentiate holes from the main polygon
holes <- do.call(rbind, lapply(split(datapoly, datapoly$id), function(df) {
df$x <- df$x + 0.5 * (mean(df$x) - df$x)
df$y <- df$y + 0.5 * (mean(df$y) - df$y)
df
}))
datapoly$subid <- 1L
holes$subid <- 2L
datapoly <- rbind(datapoly, holes)
p <- ggplot(datapoly, aes(x = x, y = y)) +
geom_polygon_interactive(aes(fill = value, group = id, subgroup = subid,
tooltip = value, data_id = value, onclick = oc))
x <- girafe(ggobj = p)
if( interactive() ) print(x)
}