单击 ggplot/plotly 图表打开超链接

Question

这是对为在 R 中创建的 html 小部件添加 onclick 打开超链接事件提供的答案的后续问题。考虑以下示例：

library(ggplot2)
library(plotly)
library(htmlwidgets)
library(htmltools)
myData <- data.frame(
  x=c(1,2,3), 
  y=c(3,2,1),
  label=c("Google", "Bing", "R"),
  category=c("search", "search", "other"),
  urls=c("http://google.de", "http://bing.com", "http://r-project.org")
)

f <- function(p) {
  ply <- ggplotly(p)
  javascript <- HTML(paste("
   var myPlot = document.getElementById('", ply$elementId, "');
   myPlot.on('plotly_click', function(data){
   var urls = ['", paste(myData$urls, collapse = "', '"), "'];
   window.open(urls[data.points[0].pointNumber],'_blank');
   });", sep=''))  
  prependContent(ply, onStaticRenderComplete(javascript))
}

这按预期工作 - 单击任意点可打开相应的 url：

f(ggplot(myData, aes(x=x, y=y)) + geom_point(aes(text=label)))

这不能按预期工作 - 索引不再匹配：

f(ggplot(myData, aes(x=x, y=y)) + geom_point(aes(text=label, color=category)))

情节对象不同，似乎pointNumber不再保存所有点的绝对索引，而是（颜色）分组内的索引。

关于如何调整示例以使其适用于带有颜色/填充分组的一般用例的任何想法？

Answer 1

• 该plotly_click事件提供数据跟踪的名称。
• data 是点击事件信息
• data.points[0].data.name 是跟踪/类别名称

我们可以将其拆分category（就像这样aes做）并传递到我们的 JavaScript 函数中，而不是传递扁平化的数据帧

var urls = ", toJSON(split(myData, myData$category)), ";
                       

这给了我们以下 JSON

{"other": [{"x":3,"y":1,"label":"R","category":"other","urls":"http://r-project.org"}],
 "search":[{"x":1,"y":3,"label":"Google","category":"search","urls":"http://google.de"},
           {"x":2,"y":2,"label":"Bing","category":"search","urls":"http://bing.com"}]
} 

然后通过以下方式检索该 URL

window.open(urls[data.points[0].data.name][data.points[0].pointNumber]['urls'],'_blank');
                       

即从提供的 JSON：我们从点击 ( data.points[0])的第一个（也是唯一一个）点获取跟踪名称 ( data.name) 及其pointNumber（即跟踪中的第 n 个点）。

完整代码

library(ggplot2)
library(plotly)
library(htmlwidgets)
library(htmltools)
library(jsonlite)

myData <- data.frame(
  x=c(1,2,3), 
  y=c(3,2,1),
  label=c("Google", "Bing", "R"),
  category=c("search", "search", "other"),
  urls=c("http://google.de", "http://bing.com", "http://r-project.org")
)

f <- function(p) {
  ply <- ggplotly(p)
  
  javascript <- HTML(paste("
                           var myPlot = document.getElementsByClassName('js-plotly-plot')[0];
                           myPlot.on('plotly_click', function(data){
                           var urls = ", toJSON(split(myData, myData$category)), ";
                           window.open(urls[data.points[0].data.name][data.points[0].pointNumber]['urls'],'_blank');
                           });", sep=''))  
  prependContent(ply, onStaticRenderComplete(javascript))
}

f(ggplot(myData, aes(x=x, y=y)) + geom_point(aes(text=label, color=category)))