Открывать гиперссылку при нажатии на график ggplot/plotly

Это дополнительный вопрос к ответу, предоставленному для Добавить событие открытия гиперссылки по клику в html-виджет, созданный в R. Рассмотрим следующий пример:

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 больше не содержит абсолютный индекс всех точек, а индекс внутри (цветовой) группы.

Любые идеи о том, как адаптировать пример, чтобы он работал для общих случаев использования также с группами цвета/заливки?


r ggplot2 plotly htmlwidgets
person lukeA    schedule 07.04.2018    source источник

Ответы (1)


arrow_upward
5
arrow_downward

  • Событие 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)))
person Maximilian Peters    schedule 09.04.2018
comment
Работает как шарм - спасибо за вашу помощь и за объяснение! - person lukeA; 10.04.2018
comment
У меня при клике ничего не происходит. Вы уверены, что это решение все еще актуально? - person geotheory; 18.10.2020
comment
@geotheory: Plotly удалил elementID из ggplotly, см. cran.r -project.org/web/packages/plotly/news/news.html . Пример был обновлен, надеюсь, он работает и для вас с последней версией. - person Maximilian Peters; 18.10.2020
comment
Исправлена! Спасибо Макс - person geotheory; 18.10.2020