Skip to content

Navigation Menu

Sign in
Appearance settings

Search code, repositories, users, issues, pull requests...

Provide feedback

We read every piece of feedback, and take your input very seriously.

Saved searches

Use saved searches to filter your results more quickly
Sign up
Appearance settings

Commit 44499f2

Browse files
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

Lines changed: 2 additions & 1 deletion
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

Lines changed: 5 additions & 0 deletions
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

Lines changed: 4 additions & 0 deletions
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

Lines changed: 272 additions & 0 deletions
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

Lines changed: 19 additions & 0 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎man/prepare_ridge_chart.Rd

Lines changed: 23 additions & 0 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

0 commit comments

Comments
(0)

AltStyle によって変換されたページ (->オリジナル) /