@@ -30,8 +30,7 @@ get_ridge_data <- function(data, na.rm) {
30
30
# ' Prepare plotting data for ggridges
31
31
# ' @param closed boolean, should the polygon be closed at bottom (TRUE for
32
32
# ' geom_density_ridges2, FALSE for geom_density_ridges)
33
- prepare_ridge_chart <- function (data , prestats_data , layout , params , p , closed = FALSE , ... ){
34
-
33
+ prepare_ridge_chart <- function (data , prestats_data , layout , params , p , closed = FALSE , ... ) {
35
34
d <- get_ridge_data(data , params $ na.rm )
36
35
37
36
# split data into separate groups
@@ -52,25 +51,27 @@ prepare_ridge_chart <- function(data, prestats_data, layout, params, p, closed =
52
51
# for each group create a density + vline + point as applicable
53
52
res <- lapply(
54
53
rev(groups ),
55
- function (x ){
56
-
54
+ function (x ) {
57
55
draw_stuff <- split(x , x $ datatype )
58
56
59
57
# first draw the basic density ridge part
60
-
61
58
stopifnot(! is.null(draw_stuff $ ridgeline ))
59
+
62
60
d2 <- d1 <- draw_stuff $ ridgeline
63
- if (! closed ) d2 $ colour <- NA # no colour for density bottom line
61
+ if (! closed ) d2 $ colour <- NA # no colour for density bottom line
64
62
65
63
d1 $ y <- d1 $ ymax
66
64
d1 $ alpha <- 1 # don't use fill alpha for line alpha
65
+
67
66
ridges <- list (
68
67
to_basic(prefix_class(d2 , " GeomDensity" )),
69
68
to_basic(prefix_class(d1 , " GeomLine" ))
70
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
71
73
72
- if (' vline' %in% names(draw_stuff )){
73
-
74
+ if (' vline' %in% names(draw_stuff )) {
74
75
draw_stuff $ vline $ xend <- draw_stuff $ vline $ x
75
76
draw_stuff $ vline $ yend <- draw_stuff $ vline $ ymax
76
77
draw_stuff $ vline $ y <- draw_stuff $ vline $ ymin
@@ -81,12 +82,13 @@ prepare_ridge_chart <- function(data, prestats_data, layout, params, p, closed =
81
82
prefix_class(draw_stuff $ vline , ' GeomSegment' ),
82
83
prestats_data , layout , params , p , ...
83
84
)
85
+ # attach the crosstalk group/set
86
+ vlines <- structure(vlines , set = attr(draw_stuff $ vline , ' set' ))
84
87
ridges <- c(ridges , list (vlines ))
85
-
86
88
}
87
89
88
90
# points
89
- if (' point' %in% names(draw_stuff )){
91
+ if (' point' %in% names(draw_stuff )) {
90
92
draw_stuff $ point $ y <- draw_stuff $ point $ ymin
91
93
92
94
# use point aesthetics
@@ -102,6 +104,8 @@ prepare_ridge_chart <- function(data, prestats_data, layout, params, p, closed =
102
104
' GeomPoint' ),
103
105
prestats_data , layout , params , p , ...
104
106
)
107
+ # attach the crosstalk group/set
108
+ points <- structure(points , set = attr(draw_stuff $ point , ' set' ))
105
109
ridges <- c(ridges , list (points ))
106
110
}
107
111
@@ -113,8 +117,7 @@ prepare_ridge_chart <- function(data, prestats_data, layout, params, p, closed =
113
117
114
118
115
119
# ' @export
116
- to_basic.GeomDensityRidgesGradient <- function (data , prestats_data , layout , params , p , ... ){
117
-
120
+ to_basic.GeomDensityRidgesGradient <- function (data , prestats_data , layout , params , p , ... ) {
118
121
res <- prepare_ridge_chart(data , prestats_data , layout , params , p , FALSE , ... )
119
122
# set list depth to 1
120
123
unlist(res , recursive = FALSE )
@@ -182,7 +185,7 @@ to_basic.GeomRidgelineGradient <- function(data, prestats_data, layout, params,
182
185
# for each group create a density + vline + point as applicable
183
186
res <- lapply(
184
187
rev(groups ),
185
- function (x ){
188
+ function (x ) {
186
189
187
190
draw_stuff <- split(x , x $ datatype )
188
191
@@ -211,7 +214,7 @@ to_basic.GeomRidgelineGradient <- function(data, prestats_data, layout, params,
211
214
# rows to be duplicated
212
215
dupl_rows <- which(fillchange & ! idchange )
213
216
d2 $ y <- d2 $ ymax
214
- if (length(dupl_rows )> 0 ) {
217
+ if (length(dupl_rows ) > 0 ) {
215
218
rows <- d2 [dupl_rows , ]
216
219
rows $ ids <- d2 $ ids [dupl_rows - 1 ]
217
220
rows <- rows [rev(seq_len(nrow(rows ))), , drop = FALSE ]
@@ -240,12 +243,11 @@ to_basic.GeomRidgelineGradient <- function(data, prestats_data, layout, params,
240
243
241
244
# ' @export
242
245
geom2trace.GeomRidgelineGradient <- function (data , params , p ) {
243
-
244
246
# munching for polygon
245
- positions <- with( data , data.frame (
246
- x = c(x , rev(x )),
247
- y = c(ymax , rev(ymin ))
248
- ))
247
+ positions <- data.frame (
248
+ x = c(data $ x , rev(data $ x )),
249
+ y = c(data $ ymax , rev(data $ ymin ))
250
+ )
249
251
250
252
L <- list (
251
253
x = positions [[" x" ]],
0 commit comments