Skip to content

Commit c54ac8f

Browse files
authored
Merge pull request #1423 from ropensci/customdata
Relay customdata
2 parents c6311bd + 3ceb016 commit c54ac8f

File tree

5 files changed

+49
-3
lines changed

5 files changed

+49
-3
lines changed

R/layers2traces.R

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -637,6 +637,7 @@ geom2trace.GeomPath <- function(data, params, p) {
637637
y = data[["y"]],
638638
text = uniq(data[["hovertext"]]),
639639
key = data[["key"]],
640+
customdata = data[["customdata"]],
640641
frame = data[["frame"]],
641642
ids = data[["ids"]],
642643
type = "scatter",
@@ -667,6 +668,7 @@ geom2trace.GeomPoint <- function(data, params, p) {
667668
y = data[["y"]],
668669
text = if (isDotPlot) data[["key"]] else uniq(data[["hovertext"]]),
669670
key = data[["key"]],
671+
customdata = data[["customdata"]],
670672
frame = data[["frame"]],
671673
ids = data[["ids"]],
672674
type = "scatter",
@@ -720,6 +722,7 @@ geom2trace.GeomBar <- function(data, params, p) {
720722
y = y,
721723
text = uniq(data[["hovertext"]]),
722724
key = data[["key"]],
725+
customdata = data[["customdata"]],
723726
frame = data[["frame"]],
724727
ids = data[["ids"]],
725728
type = "bar",
@@ -747,6 +750,7 @@ geom2trace.GeomPolygon <- function(data, params, p) {
747750
y = data[["y"]],
748751
text = uniq(data[["hovertext"]]),
749752
key = data[["key"]],
753+
customdata = data[["customdata"]],
750754
frame = data[["frame"]],
751755
ids = data[["ids"]],
752756
type = "scatter",
@@ -778,6 +782,7 @@ geom2trace.GeomBoxplot <- function(data, params, p) {
778782
y = data[["y"]],
779783
hoverinfo = "y",
780784
key = data[["key"]],
785+
customdata = data[["customdata"]],
781786
frame = data[["frame"]],
782787
ids = data[["ids"]],
783788
type = "box",
@@ -812,6 +817,7 @@ geom2trace.GeomText <- function(data, params, p) {
812817
text = data[["label"]],
813818
hovertext = data[["hovertext"]],
814819
key = data[["key"]],
820+
customdata = data[["customdata"]],
815821
frame = data[["frame"]],
816822
ids = data[["ids"]],
817823
textfont = list(
@@ -850,6 +856,7 @@ geom2trace.GeomTile <- function(data, params, p) {
850856
z = matrix(g$fill_plotlyDomain, nrow = length(y), ncol = length(x), byrow = TRUE),
851857
text = matrix(g$hovertext, nrow = length(y), ncol = length(x), byrow = TRUE),
852858
key = data[["key"]],
859+
customdata = data[["customdata"]],
853860
frame = data[["frame"]],
854861
ids = data[["ids"]],
855862
colorscale = setNames(colScale, NULL),
@@ -945,6 +952,7 @@ make_error <- function(data, params, xy = "x") {
945952
y = data[["y"]],
946953
text = uniq(data[["hovertext"]]),
947954
key = data[["key"]],
955+
customdata = data[["customdata"]],
948956
frame = data[["frame"]],
949957
ids = data[["ids"]],
950958
type = "scatter",

R/plotly_build.R

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -190,6 +190,8 @@ plotly_build.plotly <- function(p, registerFrames = TRUE) {
190190
tr <- trace[names(trace) %in% allAttrs]
191191
# TODO: does it make sense to "train" matrices/2D-tables (e.g. z)?
192192
tr <- tr[vapply(tr, function(x) is.null(dim(x)) && is.atomic(x), logical(1))]
193+
# white-list customdata as this can be a non-atomic vector
194+
tr$customdata <- trace$customdata
193195
builtData <- tibble::as_tibble(tr)
194196
# avoid clobbering I() (i.e., variables that shouldn't be scaled)
195197
for (i in seq_along(tr)) {
@@ -266,7 +268,7 @@ plotly_build.plotly <- function(p, registerFrames = TRUE) {
266268

267269
# insert NAs to differentiate groups
268270
traces <- lapply(traces, function(x) {
269-
d <- data.frame(x[names(x) %in% x$.plotlyVariableMapping], stringsAsFactors = FALSE)
271+
d <- tibble::as_tibble(x[names(x) %in% x$.plotlyVariableMapping])
270272
d <- group2NA(
271273
d, if (has_group(x)) ".plotlyGroupIndex",
272274
ordered = if (inherits(x, "plotly_line")) "x",

inst/examples/shiny/event_data/app.R

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -15,10 +15,10 @@ server <- function(input, output, session) {
1515

1616
output$plot <- renderPlotly({
1717
if (identical(input$plotType, "ggplotly")) {
18-
p <- ggplot(mtcars, aes(x = mpg, y = wt, key = nms)) + geom_point()
18+
p <- ggplot(mtcars, aes(x = mpg, y = wt, customdata = nms)) + geom_point()
1919
ggplotly(p) %>% layout(dragmode = "select")
2020
} else {
21-
plot_ly(mtcars, x = ~mpg, y = ~wt, key = nms) %>%
21+
plot_ly(mtcars, x = ~mpg, y = ~wt, customdata = nms) %>%
2222
layout(dragmode = "select")
2323
}
2424
})

inst/htmlwidgets/plotly.js

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -236,6 +236,10 @@ HTMLWidgets.widget({
236236
obj.z = pt.z;
237237
}
238238

239+
if (pt.hasOwnProperty("customdata")) {
240+
obj.customdata = pt.customdata;
241+
}
242+
239243
/*
240244
TL;DR: (I think) we have to select the graph div (again) to attach keys...
241245
Lines changed: 32 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,32 @@
1+
context("customdata")
2+
3+
# TODO: use shinytest to make sure we can access the right value in shiny
4+
test_that("ggplotly relays customdata", {
5+
nms <- row.names(mtcars)
6+
p <- ggplot(mtcars, aes(x = mpg, y = wt, customdata = nms)) + geom_point()
7+
l <- plotly_build(p)
8+
trace <- l$x$data[[1]]
9+
expect_equivalent(trace$customdata, nms)
10+
})
11+
12+
13+
test_that("Can provide list-columns to customdata", {
14+
l <- txhousing %>%
15+
group_by(city) %>%
16+
highlight_key(~city) %>%
17+
plot_ly(x = ~date, y = ~median, hoverinfo = "name") %>%
18+
add_lines(customdata = ~purrr::map2(date, median, ~list(.x, .y))) %>%
19+
plotly_build()
20+
21+
trace <- l$x$data[[1]]
22+
expect_true(length(trace$customdata) == length(trace$x))
23+
24+
# make sure customdata have been arranged properly
25+
customx <- unlist(lapply(trace$customdata, function(x) x[1] %||% NA))
26+
expect_equivalent(customx, trace$x)
27+
28+
# check there is no customdata where x values are null
29+
nullcd <- trace$customdata[which(is.na(trace$x))]
30+
expect_true(unique(lengths(nullcd)) == 0)
31+
})
32+

0 commit comments

Comments
 (0)