Skip to content

Commit 44499f2

Browse files
AdroMineAdroMine
authored
Add support for ggridges (#2314)
* add support for ggridges + associated tests * ggridges: formatting + remove commented code * ggridges: remove unnecessary test, put seed for jittered points * fix higlight working + formatting * ggridges support: update news.md
1 parent dc6455f commit 44499f2

34 files changed

+665
-1
lines changed

‎DESCRIPTION

+2-1
Original file line numberDiff line numberDiff line change
@@ -75,7 +75,8 @@ Suggests:
7575
palmerpenguins,
7676
rversions,
7777
reticulate,
78-
rsvg
78+
rsvg,
79+
ggridges
7980
LazyData: true
8081
RoxygenNote: 7.2.3
8182
Encoding: UTF-8

‎NAMESPACE

+5
Original file line numberDiff line numberDiff line change
@@ -13,6 +13,7 @@ S3method(geom2trace,GeomErrorbarh)
1313
S3method(geom2trace,GeomPath)
1414
S3method(geom2trace,GeomPoint)
1515
S3method(geom2trace,GeomPolygon)
16+
S3method(geom2trace,GeomRidgelineGradient)
1617
S3method(geom2trace,GeomText)
1718
S3method(geom2trace,GeomTile)
1819
S3method(geom2trace,default)
@@ -49,6 +50,9 @@ S3method(to_basic,GeomContour)
4950
S3method(to_basic,GeomCrossbar)
5051
S3method(to_basic,GeomDensity)
5152
S3method(to_basic,GeomDensity2d)
53+
S3method(to_basic,GeomDensityLine)
54+
S3method(to_basic,GeomDensityRidges)
55+
S3method(to_basic,GeomDensityRidges2)
5256
S3method(to_basic,GeomDotplot)
5357
S3method(to_basic,GeomErrorbar)
5458
S3method(to_basic,GeomErrorbarh)
@@ -65,6 +69,7 @@ S3method(to_basic,GeomRaster)
6569
S3method(to_basic,GeomRasterAnn)
6670
S3method(to_basic,GeomRect)
6771
S3method(to_basic,GeomRibbon)
72+
S3method(to_basic,GeomRidgeline)
6873
S3method(to_basic,GeomRug)
6974
S3method(to_basic,GeomSegment)
7075
S3method(to_basic,GeomSf)

‎NEWS.md

+4
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,9 @@
11
# plotly (development version)
22

3+
## New features
4+
5+
* `ggplotly()` now supports the `{ggridges}` package. (#2314)
6+
37
## Bug fixes
48

59
* Closed #2337: Creating a new `event_data()` handler no longer causes a spurious reactive update of existing `event_data()`s. (#2339)

‎R/ggridges.R

+272
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,272 @@
1+
#' Get data for ridge plots
2+
#'
3+
#' @param data dataframe, the data returned by `ggplot2::ggplot_build()`.
4+
#' @param na.rm boolean, from params
5+
#'
6+
#' @return dataframe containing plotting data
7+
#'
8+
get_ridge_data <- function(data, na.rm) {
9+
if (isTRUE(na.rm)) {
10+
data <- data[stats::complete.cases(data[c("x", "ymin", "ymax")]), ]
11+
}
12+
13+
#if dataframe is empty there's nothing to draw
14+
if (nrow(data) == 0) return(list())
15+
16+
# remove all points that fall below the minimum height
17+
data$ymax[data$height < data$min_height] <- NA
18+
19+
# order data
20+
data <- data[order(data$ymin, data$x), ]
21+
22+
# remove missing points
23+
missing_pos <- !stats::complete.cases(data[c("x", "ymin", "ymax")])
24+
ids <- cumsum(missing_pos) + 1
25+
data$group <- paste0(data$group, "-", ids)
26+
data[!missing_pos, ]
27+
}
28+
29+
30+
#' Prepare plotting data for ggridges
31+
#' @param closed boolean, should the polygon be closed at bottom (TRUE for
32+
#' geom_density_ridges2, FALSE for geom_density_ridges)
33+
prepare_ridge_chart <- function(data, prestats_data, layout, params, p, closed = FALSE, ...) {
34+
d <- get_ridge_data(data, params$na.rm)
35+
36+
# split data into separate groups
37+
groups <- split(d, factor(d$group))
38+
39+
# sort list so lowest ymin values are in the front (opposite of ggridges)
40+
o <- order(
41+
unlist(
42+
lapply(
43+
groups,
44+
function(data) data$ymin[1]
45+
)
46+
),
47+
decreasing = FALSE
48+
)
49+
groups <- groups[o]
50+
51+
# for each group create a density + vline + point as applicable
52+
res <- lapply(
53+
rev(groups),
54+
function(x) {
55+
draw_stuff <- split(x, x$datatype)
56+
57+
# first draw the basic density ridge part
58+
stopifnot(!is.null(draw_stuff$ridgeline))
59+
60+
d2 <- d1 <- draw_stuff$ridgeline
61+
if (!closed) d2$colour <- NA # no colour for density bottom line
62+
63+
d1$y <- d1$ymax
64+
d1$alpha <- 1 # don't use fill alpha for line alpha
65+
66+
ridges <- list(
67+
to_basic(prefix_class(d2, "GeomDensity")),
68+
to_basic(prefix_class(d1, "GeomLine"))
69+
)
70+
# attach the crosstalk group/set
71+
ridges[[1]] <- structure(ridges[[1]], set = attr(d2, 'set')) # Density
72+
ridges[[2]] <- structure(ridges[[2]], set = attr(d1, 'set')) # Line
73+
74+
if ('vline' %in% names(draw_stuff)) {
75+
draw_stuff$vline$xend <- draw_stuff$vline$x
76+
draw_stuff$vline$yend <- draw_stuff$vline$ymax
77+
draw_stuff$vline$y <- draw_stuff$vline$ymin
78+
draw_stuff$vline$colour <- draw_stuff$vline$vline_colour
79+
draw_stuff$vline$size <- draw_stuff$vline$vline_size
80+
81+
vlines <- to_basic(
82+
prefix_class(draw_stuff$vline, 'GeomSegment'),
83+
prestats_data, layout, params, p, ...
84+
)
85+
# attach the crosstalk group/set
86+
vlines <- structure(vlines, set = attr(draw_stuff$vline, 'set'))
87+
ridges <- c(ridges, list(vlines))
88+
}
89+
90+
# points
91+
if ('point' %in% names(draw_stuff)) {
92+
draw_stuff$point$y <- draw_stuff$point$ymin
93+
94+
# use point aesthetics
95+
draw_stuff$point$shape <- draw_stuff$point$point_shape
96+
draw_stuff$point$fill <- draw_stuff$point$point_fill
97+
draw_stuff$point$stroke <- draw_stuff$point$point_stroke
98+
draw_stuff$point$alpha <- draw_stuff$point$point_alpha
99+
draw_stuff$point$colour <- draw_stuff$point$point_colour
100+
draw_stuff$point$size <- draw_stuff$point$point_size
101+
102+
points <- to_basic(
103+
prefix_class(as.data.frame(draw_stuff$point), # remove ridge classes
104+
'GeomPoint'),
105+
prestats_data, layout, params, p, ...
106+
)
107+
# attach the crosstalk group/set
108+
points <- structure(points, set = attr(draw_stuff$point, 'set'))
109+
ridges <- c(ridges, list(points))
110+
}
111+
112+
ridges
113+
}
114+
)
115+
res
116+
}
117+
118+
119+
#' @export
120+
to_basic.GeomDensityRidgesGradient <- function(data, prestats_data, layout, params, p, ...) {
121+
res <- prepare_ridge_chart(data, prestats_data, layout, params, p, FALSE, ...)
122+
# set list depth to 1
123+
unlist(res, recursive = FALSE)
124+
}
125+
126+
127+
#' @export
128+
to_basic.GeomDensityRidges <- function(data, prestats_data, layout, params, p, ...) {
129+
to_basic(
130+
prefix_class(data, 'GeomDensityRidgesGradient'),
131+
prestats_data, layout, params, p,
132+
closed = FALSE,
133+
...
134+
)
135+
}
136+
137+
138+
#' @export
139+
to_basic.GeomDensityRidges2 <- function(data, prestats_data, layout, params, p, ...) {
140+
to_basic(
141+
prefix_class(data, 'GeomDensityRidgesGradient'),
142+
prestats_data, layout, params, p,
143+
closed = TRUE,
144+
...
145+
)
146+
}
147+
148+
149+
150+
#' @export
151+
to_basic.GeomDensityLine <- function(data, prestats_data, layout, params, p, ...) {
152+
to_basic(prefix_class(data, 'GeomDensity'))
153+
}
154+
155+
156+
157+
#' @export
158+
to_basic.GeomRidgeline <- function(data, prestats_data, layout, params, p, ...) {
159+
to_basic(
160+
prefix_class(data, 'GeomDensityRidgesGradient'),
161+
prestats_data, layout, params, p, ...
162+
)
163+
}
164+
165+
166+
#' @export
167+
to_basic.GeomRidgelineGradient <- function(data, prestats_data, layout, params, p, ...) {
168+
d <- get_ridge_data(data, params$na.rm)
169+
170+
# split data into separate groups
171+
groups <- split(d, factor(d$group))
172+
173+
# sort list so lowest ymin values are in the front (opposite of ggridges)
174+
o <- order(
175+
unlist(
176+
lapply(
177+
groups,
178+
function(data) data$ymin[1]
179+
)
180+
),
181+
decreasing = FALSE
182+
)
183+
groups <- groups[o]
184+
185+
# for each group create a density + vline + point as applicable
186+
res <- lapply(
187+
rev(groups),
188+
function(x) {
189+
190+
draw_stuff <- split(x, x$datatype)
191+
192+
# first draw the basic density ridge part
193+
194+
stopifnot(!is.null(draw_stuff$ridgeline))
195+
d2 <- d1 <- draw_stuff$ridgeline
196+
d2$colour <- NA # no colour for density area
197+
d2$fill_plotlyDomain <- NA
198+
199+
d1$y <- d1$ymax
200+
d1$alpha <- 1 # don't use fill alpha for line alpha
201+
202+
# calculate all the positions where the fill type changes
203+
fillchange <- c(FALSE, d2$fill[2:nrow(d2)] != d2$fill[1:nrow(d2)-1])
204+
205+
# and where the id changes
206+
idchange <- c(TRUE, d2$group[2:nrow(d2)] != d2$group[1:nrow(d2)-1])
207+
208+
# make new ids from all changes in fill style or original id
209+
d2$ids <- cumsum(fillchange | idchange)
210+
211+
# get fill color for all ids
212+
fill <- d2$fill[fillchange | idchange]
213+
214+
# rows to be duplicated
215+
dupl_rows <- which(fillchange & !idchange)
216+
d2$y <- d2$ymax
217+
if (length(dupl_rows) > 0) {
218+
rows <- d2[dupl_rows, ]
219+
rows$ids <- d2$ids[dupl_rows-1]
220+
rows <- rows[rev(seq_len(nrow(rows))), , drop = FALSE]
221+
# combine original and duplicated d2
222+
d2 <- rbind(d2, rows)
223+
}
224+
225+
# split by group to make polygons
226+
d2 <- tibble::deframe(tidyr::nest(d2, .by = 'ids'))
227+
228+
ridges <- c(
229+
d2,
230+
list(
231+
to_basic(prefix_class(d1, "GeomLine"))
232+
)
233+
)
234+
235+
ridges
236+
}
237+
)
238+
# set list depth to 1
239+
unlist(res, recursive = FALSE)
240+
}
241+
242+
243+
244+
#' @export
245+
geom2trace.GeomRidgelineGradient <- function(data, params, p) {
246+
# munching for polygon
247+
positions <- data.frame(
248+
x = c(data$x , rev(data$x)),
249+
y = c(data$ymax, rev(data$ymin))
250+
)
251+
252+
L <- list(
253+
x = positions[["x"]],
254+
y = positions[["y"]],
255+
text = uniq(data[["hovertext"]]),
256+
key = data[["key"]],
257+
customdata = data[["customdata"]],
258+
frame = data[["frame"]],
259+
ids = positions[["ids"]],
260+
type = "scatter",
261+
mode = "lines",
262+
line = list(
263+
width = aes2plotly(data, params, linewidth_or_size(GeomPolygon)),
264+
color = toRGB('black'),
265+
dash = aes2plotly(data, params, "linetype")
266+
),
267+
fill = "toself",
268+
fillcolor = toRGB(unique(data$fill[1])),
269+
hoveron = hover_on(data)
270+
)
271+
compact(L)
272+
}

‎man/get_ridge_data.Rd

+19
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎man/prepare_ridge_chart.Rd

+23
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

0 commit comments

Comments
 (0)